#:g1: frontpage

 

Stanford MacLISP: utilの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の328日目です。

Stanford MacLISP: utilとはなにか

 Stanford MacLISP: utilは、Stanford大学のMacLISPのユーティリティです。恐らく作者は、Richard Gabriel氏だと思われます。

パッケージ情報

パッケージ名Stanford MacLISP: util
参考サイトUTIL.2[AID,LSP]-www.SailDart.org

インストール方法

 上記サイトからダウンロードして適当に動かします。

 Common Lispに移植してみたものがありますので良かったらどうぞ(動作確認できれば良いという程度の移植です)

試してみる

 日付は、1981-04-22なのでMacLISPにしては案外新しいようですが、上記のサイトのソースを眺めてもらうと分かるように、なんだか分からないLisp方言となっています。
異様な見た目の原因は、Richard Gabriel氏が使っていた俺構文なのですが、MacLISPにInterlisp的な構文を取り入れつつASCII以外の文字も使っていることに起因するようです。
例えばletはこう書きます。

(let x ← 42 do
  x)
;=>  42

 またパタンマッチを多用しているのも特徴でマクロもパタンマッチで書けるmatch-macroというものが沢山使われています。
match-macroの大まかな説明をすると、構文要素をパタン変数にマッチさせて、パタン変数以外をクォートするcodeという構文で包んだコードと合体させるという方式になっています。下記のifでは、

(match-macro (if) (*form1 then *form2)
  (cond ((%match '(*form2 else *form3) *form2)
         (code (cond (*form1 *form2)
                     (t *form3))))
        (t (code (cond (*form1 *form2))))))

(let *form1 ← '(pred) do (let *form2 ← '(con) do (let *form3 ← '(alt) do (CONS 'COND (CONS (APPEND *FORM1 (APPEND *FORM2 NIL)) (CONS (CONS 'T (APPEND *FORM3 NIL)) NIL)))))) ;=> (COND (PRED CON) (T ALT))

(let *form1 ← '(pred) do (let *form2 ← '(con) do (CONS 'COND (CONS (APPEND *FORM1 (APPEND *FORM2 NIL)) NIL)))) ;=> (COND (PRED CON))

マッチ具合によって展開が変わります。

 このmatch-macroで使われている%matchですが、ガードが使えるのが1980年当時としてはなかなか先進的な気がします。

(multiple-value-bind (?x *xs ?y) nil
  (%match '(?x *xs) '(1 2 3 4))
  (list ?x *xs))
;=>  (1 (2 3 4))

(multiple-value-bind (?x *xs ?y) nil (%match '(?x *xs ($r ?y evenp)) '(1 2 3 4)) (list ?x *xs ?y)) ;=> (1 (2 3) 4)

(multiple-value-bind (?x *xs ?y) nil (%match '(?x *xs ($r ?y oddp)) '(1 2 3 4)) (list ?x *xs ?y)) ;=> (NIL NIL NIL)

ということで種類ごとに適当に眺めてみます。

制御構文

 ifはthenとelseをキーワードを使います。

(if (zerop (random 2)) then 42 else 32)
;=>  42

 その他、Interlispのselectに影響を受けたselect、select=、select-matchがあります。

(select "foo"
  ("bar" "bar")
  ("foo" "foo")
  "baz")
;=>  "foo"

(select= 42 (42 "bar") (97 "foo") "else") ;=> "bar"

(let ?x ← nil do (let ?y ← nil do (let ?z ← nil do (select-match '(1 2 3) ((?x ?y ?z) (list ?x ?y ?z)) "else")))) ;=> (1 2 3)

繰り返し

 繰り返し構文も大体定番な感じですが、キーワードのdoが特徴的です。単純な繰り返しのrepeat/while/untilの他にInterlispのforに影響を受けた汎用的なforがあります。for x in xsをfor x ∈ xsと書けます。

(repeat 10 do (princ "."))
;>>  ..........
;=>  NIL
              

(until (zerop (random 3)) do (print "foo") return (print "1") (print "2") 10) ;>> ;>> "foo" ;>> "foo" ;>> "foo" ;>> "foo" ;>> "foo" ;>> "1" ;>> "2" ;=> 10 (while (zerop (random 3)) do (print 'foo))

;>> ;>> FOO ;>> FOO ;=> NIL

(let list ← '(1 2 3 4) do (for x ∈ list collect (list x))) ;=> ((1) (2) (3) (4))

(for x from 1 to 5 by 2 do (print x)) ;==> (DO ((X 1 (+ X 2))) ((< 5 X)) (PRINT X)) ;>> ;>> 1 ;>> 3 ;>> 5 ;=> NIL

(for x ∈ '(1 2 3 4) select (oddp x)) ;==> (MAPCAN (LAMBDA (X) (AND (PROGN (ODDP X)) (LIST X))) '(1 2 3 4)) ;=> (1 3)

(for x ∈ '(1 2 3 4) scan (print x)) ;>> ;>> 1 ;>> 2 ;>> 3 ;>> 4 ;=> NIL

(for x ∈ '(1 2 3 4) do (print x)) ;>> ;>> 1 ;>> 2 ;>> 3 ;>> 4 ;=> (1 2 3 4)

末尾再帰を最適化するdefun

 Clojureのloop/recurと似た感じですが、式を分析してgotoに変換します。
Clojureのrecurに相当するのは、tail-recurキーワードです。
実行していることは、Let Over Lambdaのnamed-letとほぼ同じですが、1980年に既にあったというのは面白いですね。

(tail-recursive-defun fib (n a1 a2)
  (cond ((zerop n) a2)
        ((= 1 n) a1)
        (t (tail-recur (1- n) (+ a1 a2) a1))))

(fib 100 1 0) ;=> 354224848179261915075

まとめ

 今回は、Stanford MacLISP: utilを紹介してみました。
現状はコードの断片が残っているのみで、使い方の説明も構文の使われ方の説明もないので、基本的にさっぱり分かりませんが、コードは大体復元して動かして確認してみたので上記の説明で大体合ってるんじゃないかなと思います。

local-time-durationの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の327日目です。

local-time-durationとはなにか

 local-time-durationは、Webcheckout, Inc.作のlocal-timeと親和性の高く、timestamp形式が利用可能な期間を扱うライブラリです。

パッケージ情報

パッケージ名local-time-duration
Quicklisp
CLiKiCLiki: Article not found
Quickdocslocal-time-duration | Quickdocs

インストール方法

(ql:quickload :local-time-duration)

試してみる

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

 定義されている関数は下記の通りですが、大体名前から使い方が想像できます。

  • duration/=
  • duration/
  • duration-
  • duration
  • duration<=
  • duration-minimum
  • timestamp-difference
  • parse-iso8601-duration
  • duration>=
  • duration>
  • duration<
  • duration-maximum
  • duration+
  • duration-as
  • duration*
  • duration=
  • human-readable-duration
  • timestamp-duration+
  • timestamp-duration-

 2015年の1月1日から現時刻の期間を求めて、その期間分過去に戻ったtimestampを得るとするとこんな感じになります。

(let* ((now (local-time:now))
       (d (ltd:timestamp-difference (local-time:encode-timestamp 0 0 0 0 1 1 2015)
                                    now)))
  (ltd:timestamp-duration- now d))
;=>  @2016-10-14T00:00:00.000000+09:00

三週間後のタイムスタンプは、

(ltd:timestamp-duration+ (local-time:now)
                         (ltd:duration :week 3))
;=>  @2015-12-14T00:00:00.000000+09:00

等、シンプルです。

まとめ

 今回は、local-time-durationを紹介してみました。
local-timeと組み合せて手軽に期間が扱えて便利ですね。

srfi 86の紹介

Posted 2014-11-21 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の326日目です。

srfi 86とはなにか

 srfi 86は、Joo ChurlSoo氏による究極の束縛構文の提案です。

パッケージ情報

パッケージ名srfi 86
SRFISRFI 86: MU and NU simulating VALUES & CALL-WITH-VALUES, and their related LET-syntax

インストール方法

 SagittariusとRacketでは標準で使えます。

;;; Sagittarius
(import (srfi 86))

;;; Racket (require srfi/86)

試してみる

の記事の使い回しなのですが、コード例をSchemeで動くように書き換えるとこんな感じになります。

多値 & 分配束縛

 muが多値でnuがリストという感じです。

(alet (a (mu 1 2)
        ((b c) (mu 3 4)))
  (list a b c))
;=> ((1 2) 3 4)

(alet (((a . b) (nu '(1 2 3 4)))) (list a b)) ;=> (1 (2 3 4))

(alet (((values a b) (values 3 4))) (list a b)) ;=> (3 4)

名前付きLET

 ノーマルなnamed-letの形式に加え、束縛部のリストの終端に名前を持ってくるという斬新な手法により複数の関数を扱えるようにしてあります。さらに謎のネストも可能

(alet* tag ((a 1)
            (a b b c (mu (+ a 2) 4 5 6))
            ((d e e) b 5 (+ a b c)))
  (if (< a 10)
      (tag a 10 b c c d e d)
      (list a b c d e)))
;=> (10 6 6 5 5)

(alet fact ((n 10) (a 1))
  (if (zero? n)
      a
      (fact (- n 1) (* a n))))
;=> 3628800

;; 名前が後ろにある形式の名前付きLET

(alet (((n 10) (a 1) . fact))
      (if (zero? n)
          a
          (fact (- n 1) (* a n))))
;=> 3628800

;; intagとtagで入れ子
(alet* ((a 1)
        ((b 2)
         (b c c (mu 3 4 5))
         ((d e d (mu a b c)) . intag)
         . tag)
        (f 6))
  (if (< d 10)
      (intag d e 10)
      (if (< c 10)
          (tag b 11 c 12 a b d intag)
          (list a b c d e f))))
;=> (1 11 12 10 3 6)

継続関係

 call/ccの糖衣構文であるlet/cc的なものもサポート。

; 脱出(継続)
(alet lp ((win)
          (list '(1 2 3 4 5 6 7)))
  (cond ((= 3 (car list))
         (win (car list)))
        (else (print (car list))
              (lp win (cdr list)))))
;->
;   1
;   2
;=> 3

and-let*

 and-let*も貪欲に取り込み

;; and-let*
(alet* ((alist '((a . 1) (b . 2) (c . 3)))
        (and (a (assoc 'b alist))))
  (cdr a))
;=> 2

Common Lispのlambda-list的なものをサポート

 Common Lispでいう&rest、&optional、&keyを越えるものをサポート。キーワードのキーとして文字列も使えます。

;; キーワードで分配
(alet ((key '(b 20 a 10 c 30)
            (a :init)
            (b :init)
            (c :init)
            (d :init)))
  (list a b c d))
;=> (10 20 30 :init)

;; Common Lispのdestructuring-bindとの比較 (destructuring-bind (&key ((a a) :init) ((b b) :init) ((c c) :init) ((d d) :init)) '(b 20 a 10 c 30) (list a b c d)) ;=> (10 20 30 :INIT)

;; もっとエグい (alet ((key '(:a 10 :cc 30 40 b 20) ((a :a) 1) ((b :b) 2) ((c :cc) 3) . d)) (list a b c d)) ;=> (10 2 30 (40 b 20))

;; 文字もキーにできる (alet ((key '("a" 10 "cc" 30 40 b 20) ((a "a") 1) ((b "b") 2) ((c "cc") 3) . d)) (list a b c d)) ;=> (10 2 30 (40 B 20))

letrec系

 letrec形式も勿論サポート

(alet ((rec (fact (lambda (n)
                    (if (zero? n)
                        1
                        (* n (fact (- n 1))))))))
  (fact 10))
;=> 3628800

その他

(let ((a #f) (b #f))
  (alet ((a :a)
         (b :b)
         (() (set! a 100)
             (set! b 200)))
    (list a b)))
;=> (:a :b)
(let (a b) (set! a 100) (set! b 200)
        (alet ((a :a) (b :b))
              (list a b)))
;=> (:a :b)

(let ((a #f) (b #f))
  (alet* ((a :a)
          (b :b)
          (() (set! a 100)
              (set! b 200)))
    (list a b)))
;=> (100 200)
(let (a b)
     (alet* ((a :a) (b :b))
            (set! a 100)
            (set! b 200)
            (list a b)))
;=> (100 200)

(alet ((cat '(1 -2 3) (a 0 (positive? a)) (b 0 (positive? b)) (c 0 (positive? c)) . d)) (list a b c d)) ;=> (1 3 0 (-2))

色々複合した例

(let ((m #f) (n #f))
  (alet* ((a (begin (display "1st") 1))
          ((b c) 2 (begin (display "2nd") 3))
          (() (set! m #f) (set! n (list 8)))
          ((d (begin (display "3rd") 4))
           (key '(e 5 tmp 6) (e 0) ((f 'tmp) 55)) . p)
          g (nu (begin (display "4th") 7) n)
          ((values . h) (apply values 7 (begin (display "5th") n)))
          ((m 11) (n n) . q)
          (rec (i (lambda () (- (j) 1)))
               (j (lambda ()  10)))
          (and (k (begin (display "6th") m))
               (l (begin (display "end") (newline) 12)))
          (o))
    (if (< d 10)
        (p 40 50 60)
        (if (< m 100)
            (q 111 n)
            (begin (display (list a b c d e f g h
                                  (i)
                                  (j)
                                k l m n))
                   (newline))))
    (o (list 'o p q))
    (display "This is not displayed")))
;-> 1st2nd3rd4th5th6thend
;-> 4th5th6thend
;-> 6thend
;-> (1 2 3 40 50 60 (7 8) (7 8) 9 10 111 12 111 (8))
;=> (o #<closure #<identifier p#user>> #<closure #<identifier q#user>>)

まとめ

 今回は、srfi 86を紹介してみました。
Joo ChurlSoo氏のSRFIは面白いものが多いのですが、紹介するのもなかなか大変です。

1amの紹介

Posted 2014-11-20 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の325日目です。

1amとはなにか

 1amは、James M. Lawrence氏作のシンプルなfiveam風のテストフレームワークです。

パッケージ情報

パッケージ名1am
Quicklisp
CLiKiCLiki: Article not found
Quickdocs1am | Quickdocs

インストール方法

(ql:quickload :1am)

試してみる

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

 1amは約60行程のコードとのことですが、マルチスレッドな大きめのプロジェクトでは、良く知られたテストフレームワークでは問題が起きていたとのことで、これを解消するためシンプルが一番という哲学で作られたもののようです。
特長として説明があるのは、

  • テストの失敗時点でテストが停止する(ブレイクポイントで中断)
  • テスト順に依存したバグを排除するためテストは都度シャッフルして実行される
  • テストケースはテスト名と同名の関数になる
  • 先にコンパイルしてから実行する
  • 速い(fiveamの約8倍)

とのことです。
書式はfiveamとほぼ同じなので、手元でfiveamで書いていて遅いと感じていたものを1amに置き換えてみましたが、かなり速くなりました。

ASDFとの連携

 1amの仕組みは、1am:*tests*にテストの関数を詰め込んで実行するという素朴なものです。
fiveamのようにテストをsuiteごとに管理するのではなく、基本的には大域的にこの一つのみです。管理しようと思えばできなくもない感じではありますが。
他のプロジェクトとの競合を予防する場合、テストファイルの中に、1am:*tests*を初期化するコードを入れるか、asdf:prepare-opで初期化したりすることになるのかなと思います。
テストの呼び出しはrunのみなのでASDFでの記述はシンプルです。

(cl:in-package :asdf)

(defsystem :foo :serial t :depends-on (:1am ...) :components (...) :in-order-to ((test-op (load-op ...))) :perform (prepare-op :before (o c) (set (find-symbol* :*tests* :1am) '() )) :perform (test-op (o c) (let ((*package* (find-package ...))) (symbol-call :1am :run))))

*package*を書いているのは、テスト関数は、通常の関数なので大域変数に影響を受けることになるためです。
パッケージやリードテーブルに影響を受ける印字系のプログラムではテスト関数内で影響を受けないように書くか、このようにtest-opで保護するかになるかと思います。

まとめ

 今回は、1amを紹介してみました。
なかなかシンプルで良いかもしれません。

MIT Lisp Machine: Hierarchical Packagesの紹介

Posted 2014-11-19 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の324日目です。

MIT Lisp Machine: Hierarchical Packagesとはなにか

 MIT Lisp Machine: Hierarchical Packagesは、MIT Lisp Machineのパッケージシステムです。

パッケージ情報

パッケージ名MIT Lisp Machine: Hierarchical Packages
LispマシンマニュアルLisp Machine Manual 6th ed.: Packages

試してみる

 それまでのoblistでのシンボルの管理をパッケージにまとめて大規模な開発を可能にしたのがLispマシンのパッケージかと思います。
仕組みが固定し初めたのは大体1978年位でしょうか。
Common Lispのパッケージの関数と並べると下記のようになります。

  • package-declare / defpackage
  • pkg-create-package / make-package
  • pkg-name / package-name
  • symbol-package / symbol-package
  • pkg-find-package / find-package
  • kill-package / delete-package
  • pkg-goto / in-package
  • pkg-bind / (let ((*package* pkg)) ...)

階層パッケージ

 一見してCommon Lispと比較して違うところは、階層を成しているということです。
初期状態の階層は下記の通り

                           global                     keyword
                             |                          
       /-----------------------------------          fonts
       |     |          |          |       |
     user  zwei      system      format  (etc)        cli
                        |
                /----------------------------------
                |          |     |     |    |      |
         system-internals  eh  chaos  cadr  fs  compiler

 下記のように書くことで階層分けが可能です。

(package-declare aaa global 100 nil) 
(package-declare bbb aaa 100 nil)
(package-declare ccc bbb 100 nil)

こうすると、aaaの下にbbb、bbbの下にcccが作られるので、cccのシンボルdは、aaa:bbb:ccc:dということになります。
ちなみに、Common Lispのようにエクスポートしないとpkg::symと記述しなければいけないということはありません。
シンボルの継承は、上から下に勝手に継承してきます。つまり、

(intern "X" "AAA")
(eq 'aaa:x 'aaa:bbb:ccc:x)
;=> T

みたいなことになります。
これを防ぐのがCommon Lispと同じくshadowで

(shadow "X" 'aaa:bbb:ccc)

(eq 'aaa:x 'aaa:bbb:ccc:x) ;=> NIL

とできます。しかし、

(eq 'aaa:z 'aaa:bbb:ccc:z)
;=> T

でも

(eq 'aaa:bbb:ccc:q 'aaa:q)
;=> NIL

だったりして、評価順が関係してきてややこしいです。

keywordパッケージはuser

 パッケージシステムができた当初(というかCommon Lisp登場まで)はkeywordパッケージというものはなく、:fooと書けば、user:fooのことでした。
更に、自己評価オブジェクトでもなかったのでクォートを付ける必要がありました。
昔のコードで ':foo と書いてあることがあるのは、このためです。
この為、userパッケージはサブパッケージが作れない等の制限をつけていたようなのですが、Common Lispが出てくるあたりでkeywordパッケージもできたようです。

パッケージの指定は、-*- Packge: -*-で行なう

 上記の一覧では、pkg-gotoというものがありますが、基本的にパッケージの宣言は、ファイル最上部の属性リストで宣言していました。

階層パッケージの活用され具合

 Lispマシンのソースを眺める限りでは、特に階層分けを活かしたコードというのは無かったようです。
上部のパッケージから無条件でシンボルを継承してくるというのが良くなかったのか、何が悪かったのかは不明ですが、そんな為か、Common Lispをサポートする辺りになってくると、'aaa:bbb:ccc:xも'ccc:xも同じ意味になったりしていて、これだと実質パッケージ名はグローバルに唯一のものしか付けられなくなってきます。

面白い機能

 Common Lispには無い機能として、relative-names/relative-names-for-me、invisibleがあります。
relative-namesは、SBCLのlocal-nicknamesと同じで他のパッケージをパッケージローカルで別名で参照できます。
relative-names-for-meはその逆みたいですが詳細は不明です。
invisibleは、(list-all-packages)には登録されないということで、シンボルでいうuninterned symbolみたいな感じです。名前は付くもののfind-packageでは見付けられません。

まとめ

 今回は、MIT Lisp Machine: Hierarchical Packagesを紹介してみました。
不特定多数の人がバラバラに開発をしつつも統一しようとすれば、Perl/CPANのような名前の階層化が便利なのかなと思いますが、どうなのでしょう。
Common Lispの場合は、パッケージ名の衝突を回避する方法が面倒なのが厄介ですね。

Allegro CL: Hackable LAP codeの紹介

Posted 2014-11-18 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の323日目です。

Allegro CL: Hackable LAP codeとはなにか

 Allegro CL: Hackable LAP codeは、Allegro CLでコンパイラの出力をいじる仕組みです。Hackable LAP codeというかどうかは分かりませんが、Erik Naggum氏の話の中でこういう表現があるので、とりあえずこう呼ぶことにしてみます。

パッケージ情報

パッケージ名Allegro CL: Hackable LAP code

インストール方法

 Allegro CLに標準の機能です。Allegro CL 4.3でも使えるのでかなり古くから(遅くとも1997年位から)あるようです。

試してみる

 件のHackable LAP codeという呼び方ですが、

に出てくるものです。

 この機能については正式なドキュメントがないようなのですが、ILC 2007のDuane Rettig氏のチュートリアルで解説があったようです。

コンパイラの出力を編集する

 編集の仕方が黒魔術的なのですが、下記の手順で行ないます。
とりあえず、手短なところで与えられた引数をそのまま返すidという関数を定義してみます。

(defun id (obj) obj)

Common Lispのidentityと機能は同じものですが、コンパイル時にフックが掛ってLAPを編集するのでコンパイルはしないで置きます。

 何もしない場合のdisassembleの結果は下記のようになります。

(disassemble #'id)
;>>  ;; disassembly of #<Function ID>
;>>  ;; formals: OBJ
;>>  
;>>  ;; code start: #x1001229d68:
;>>     0: 48 83 f8 01    cmp	rax,$1
;>>     4: 74 01          jz	7
;>>     6: 06             (push es)       ; SYS::TRAP-ARGERR
;>>     7: 41 80 7f a7 00 cmpb	[r15-89],$0 ; SYS::C_INTERRUPT-PENDING
;>>    12: 74 01          jz	15
;>>    14: 17             (pop ss)        ; SYS::TRAP-SIGNAL-HIT
;>>    15: f8             clc
;>>    16: 4c 8b 74 24 10 movq	r14,[rsp+16]
;>>    21: c3             ret
;>>  
;=>  <no values>

 次にコンパイル時にLAPを編集する関数を指定します。

(setq comp::*hack-compiler-output* '(id))

 そしてコンパイルすると、hackit.sができるので、これをエディタで編集します。

(let ((*default-pathname-defaults* #P"/tmp/"))
  (compile 'id))
;>> type :cont when you're done editing "hackit.s"
;>>    [Condition of type SIMPLE-BREAK]
;>> 
;>> Restarts:
;>>  0: [CONTINUE] return from break.
;>>  1: [RETRY] Retry SLIME interactive evaluation request.
;>>  2: [*ABORT] Return to SLIME's top level.
;>>  3: [ABORT] Abort entirely from this (lisp) process.

hackit.sは、こんな感じの内容になっています。

(LABEL GARBAGE::L2)
(CMP.Q (IM 1) (:REG 0 :RAX :EAX :AX :AL))
(BCC :EQ GARBAGE::L3)
(TRAP.WNAERR)
(LABEL GARBAGE::L3)
(LABEL GARBAGE::L1)
(CMP.B (IM 0) (D -89 (:REG 15 :R15 :R15D :R15W :R15B)))
(BCC.S :EQ GARBAGE::L4)
(TRAP.SIGNAL-HIT)
(LABEL GARBAGE::L4)
(CLC)
(MOVE.Q (D 16 (:REG 4 :RSP :ESP :SP :SPL))
        (:REG 14 :R14 :R14D :R14W :R14B))
(RETURN)

大体上のアセンブリの出力と対応しているのが分かります。
これを適当に編集しますが、Allegro CLでは、RAXにアリティが入るようで、これが1個かどうかをチェックしているようです。
試しにこれを削除してみます。

(CLC)
(MOVE.Q (D 16 (:REG 4 :RSP))
        (:REG 14 :R14))
(RETURN)

 これだと何もしてないように見えますが、返り値が置かれるレジスタが第一引数が置かれるレジスタと同じなのでOKです。
なお、レジスタの指定は、番号が重要で、レジスタの名前はコメントのようなので上のように書いても大丈夫みたいです。
編集し終わったら継続してコンパイル完了です。

(id 42 1 38 8)
;=> 42

(disassemble #'id) ;>> ;; disassembly of #<Function ID> ;>> ;; formals: OBJ ;>> ;>> ;; code start: #x1003749a98: ;>> 0: f8 clc ;>> 1: 4c 8b 74 24 10 movq r14,[rsp+16] ;>> 6: c3 ret ;>> 7: 90 nop ;>> ;=> <no values>

引数をチェックしていない関数になりました。

コンパイル時に用意したLAPを結合させる

 これで編集できることは分かったのですが、これを毎度やるのは現実的ではない、ということで、ファイルを読み込ませる方法もあります。

(setq comp::*assemble-function-body* '((id . #P"/tmp/id.s")))

(compile ...)

(setq comp::*assemble-function-body* nil)

LAPを直接編集して高速化した関数の速度計測

 さてidが、identityより速いのか計測してみましょう。

(time
 (dotimes (i 1000000000)
   (id 1)))
; cpu time (non-gc) 4.784000 sec user, 0.000000 sec system
; cpu time (gc)     0.000000 sec user, 0.000000 sec system
; cpu time (total)  4.784000 sec user, 0.000000 sec system
; real time  4.784323 sec
; space allocation:
;  54 cons cells, 5,232 other bytes, 0 static bytes

(time (dotimes (i 1000000000) (identity 1))) ; cpu time (non-gc) 1.276000 sec user, 0.000000 sec system ; cpu time (gc) 0.000000 sec user, 0.000000 sec system ; cpu time (total) 1.276000 sec user, 0.000000 sec system ; real time 1.276108 sec ; space allocation: ; 0 cons cells, 0 other bytes, 0 static bytes

3倍位遅いwwwww
identityより遅い理由ですが、identityにはコンパイラマクロが定義してあって、identity自体がいなくなるので、上記のコードのような場合、identityとしては最速の実装ということになります。
さすがになかなか賢いですね。

 ちなみに、idを(speed 3)(safety 0)で最適化すると引数チェックが消えて上記のLAPコードと同じものになるので、引数チェックを無くすためであれば、わざわざLAPコードを編集する必要はありません。

まとめ

 今回は、Allegro CL: Hackable LAP codeを紹介してみました。
なかなか黒魔術的な機能で良いですね。Allegro CLにはこういうのが他にも沢山あるようです。

Allegro CL Examples and Utilities: English-Word-Stemmerの紹介

Posted 2014-11-17 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の322日目です。

Allegro CL Examples and Utilities: English-Word-Stemmerとはなにか

 Allegro CL Examples and Utilities: English-Word-Stemmerは、Steven M. Haflich氏作の英語単語のステマーです。

パッケージ情報

パッケージ名Allegro CL Examples and Utilities: English-Word-Stemmer
Quicklisp×
配布サイト(archive.org)Allegro CL Examples and Utilities

インストール方法

 Franzのサイトからダウンロードできたりするのですが、しばらく落ちたままなので、archive.orgを紹介しておきます。

試してみる

  単語から接辞語を取り除く処理をステミングというみたいですが、利用されているアルゴリズムは、Porter Stemming Algorithmとのことで定番のもののようです。
stemを使えば、こんな感じに処理してくれます。

(mapcar #'stem
        (*:split-sequence #\Space "seven steps to heaven"))
;=>  ("seven" "step" "to" "heaven")

まとめ

 今回は、Allegro CL Examples and Utilities: English-Word-Stemmerを紹介してみました。
作者のSteven M. Haflich(smh)氏は、LMIからFranzと渡り歩きANSI Common Lispの仕様策定でも活躍したLispハッカーです。
ステマーのコード中で、

(block nil
  (case (char str (1- (length str)))
    (#\e (when (ends str "icate") (r str "ic" sfp) (return))
     (when (ends str "ative") (r str "" sfp)   (return)) ; huh?
     (when (ends str "alize") (r str "al" sfp) (return)))
    (#\i (when (ends str "iciti") (r str "ic" sfp) (return)))
    (#\l (when (ends str "ical")  (r str "ic" sfp) (return))
     (when (ends str "ful")   (r str "" sfp)   (return))) ; huh?
    (#\s (when (ends str "ness")  (r str "" sfp)   (return))) ; huh?
    ))

のようなコードに遭遇し、「流石熟練Lispハッカーはやることが違う!」と思いましたが、コメントを良く読んだらCから手作業で機械的に移植したとのことでした。

QITAB: strict-functionsの紹介

Posted 2014-11-16 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の321日目です。

QITAB: strict-functionsとはなにか

 QITAB: strict-functionsは、ITAで利用されている引数や返り値の型、発生するコンディションのチェック機能付きの関数/メソッドを定義するためのライブラリです。

パッケージ情報

パッケージ名QITAB: strict-functions
Quicklisp×
プロジェクトサイトQITAB - a collection of free Lisp code

インストール方法

 common-lisp.netからITAで利用されているユーティリティのスナップショットが入手できるので、これをダウンロードします。

目的のファイルは、quux/lisp/quux/strict-functions.lisp あたりのファイルです(結構色々なファイルに散らばっています。)

試してみる

 関数のドキュメンテーションが詳細なので掲載してみます。

DEFINE-STRICT-FUNCTION names a macro:
  Lambda-list: (NAME
                (&KEY INPUTS (OUTPUTS NIL ANY-OUTPUTS) CONDITIONS
                 COUNT-P)
                &BODY BODY)
  Documentation:
    Define a function (like defun) with strict input, output and signal typing.

'name' - symbol naming the function

'inputs' - a "strict lambda list". Similar to a regular defun lambda-list, however every atom/expression PARAM which describes a parameter value is now a list (PARAM TYPE &optional DOC), where TYPE is a type expression which constrains the type of that parameter and DOC is an optional DOCSTRING describing the parameter. For &rest arguments, TYPE is a type expression that constrains the type of all following parameters.

'outputs' - a list of type expressions which constrain the types of values returned by the function, one type per value, as would be seen by the caller. The function is not allowed to return more values those described by this list. If there is no outputs argument, then any returned values are OK; use this when the function is called only for side effect and the returned value should be ignored.

'conditions' - a list of the conditions which this function is allowed to signal. If 't' is in this list, any condition is allowed.

'count-p' - true or nil: if true, result counts are maintained. Specifically, when function exits with a condition of type not listed in :CONDITIONS argument it is counted as an error, and otherwise as an success. This is for reporting by the /stat/request monitor facility, intended to be used by operators. By convention, count-p is specified true for QRes functional entry points, i.e., by define-qres-functional-entry-point, otherwise nil.

'body' - the body of the function (as in DEFUN, the first form may be a documentation string).

Type declarations are automatically prepended to the function body for each of the input parameters. Violations of input type declarations are signalled as a STRICT-FUNCTION-INPUT-TYPE-ERROR via #'ERROR.

If the function attempts to return a more values than declared by :outputs, then a STRICT-FUNCTION-OUTPUT-COUNT-ERROR is signalled via #'ERROR. Likewise, If the function attempts to return a value with a type incompatible with that declared by :outputs, then a STRICT-FUNCTION-OUTPUT-TYPE-ERROR is signalled via #'ERROR.

The strict-function wrapping will catch any signals which are not declared by :conditions and signal the STRICT-FUNCTION-CONDITION-ERROR via #'ERROR if it matches *strict-function-condition-signal-typespec* (which defaults to NIL).

Example:

(define-strict-function foo (:inputs ((x keyword) &optional ((y 57) integer)) :outputs (integer string) :conditions (bad-foo-error)) (case x (:ANIMAL (values y "elephants")) (:MINERAL (values (* 2 y) "rocks")) (t (error (make-condition 'bad-foo-error)))))

(define-strict-function bar (:inputs ((x t)) :outputs (string) :conditions ()) (format nil "bar sez: ~A" x))

 オプションのうちcount-pというのがQResシステムに密着気味ですが、他は汎用的かなと思います。
とりあえず、define-strict-functionの方は、

(define-strict-function fib (:inputs ((n (integer 0 *)))
                             :outputs (integer))
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))
(fib :z)
;!> The value of argument N to FIB was :Z but it was expected to be of type (UNSIGNED-BYTE
;!>                                                                          62)
;!>    [Condition of type STRICT-FUNCTION-INPUT-TYPE-ERROR] 

という感じです。
コンディションを指定する場合は、

(setq *strict-function-condition-signal-typespec* T)

(define-condition morlis () ())

(define-strict-function latumapic (:inputs () :outputs (null) :conditions (morlis)) (warn "大丈夫か日本"))

(latumapic) ;!> The condition #1# was erroneously signalled in LATUMAPIC: ;!> #1=大丈夫か日本 ;!> [Condition of type STRICT-FUNCTION-CONDITION-ERROR]

という感じで、指定したコンディション以外が発生するとSTRICT-FUNCTION-CONDITION-ERRORになります。

 define-strict-methodの方は、


(define-strict-generic fib (:inputs ((n integer))
                           :outputs ((integer 0 *))))

(define-strict-method fib (:inputs ((n (eql 0))) :outputs ((integer 0 *))) 0)

(define-strict-method fib (:inputs ((n (eql 1))) :outputs ((integer 0 *))) 1)

(define-strict-method fib (:inputs ((n integer)) :outputs ((integer 0 *))) (+ (fib (1- n)) (fib (- n 2))))

(fib -1) ;!> The condition #1# was erroneously signalled in FIB: ;!> #1=Control stack exhausted (no more space for function call frames). ;!> This is probably due to heavily nested or infinitely recursive function ;!> calls, or a tail call that SBCL cannot or has not optimized away. ;!> ;!> PROCEED WITH CAUTION. ;!> [Condition of type STRICT-FUNCTION-CONDITION-ERROR]

という感じです。
ちょっと判りづらいですが、メソッドの方は、スタックが溢れてエラーになっているので、STRICT-FUNCTION-CONDITION-ERRORになっています。

まとめ

 今回は、QITAB: strict-functionsを紹介してみました。
QITAB: strict-functionsのことを初めて識ったのは、 Steve Yegge氏のブログエントリーにDan Weinreb氏が寄せたコメントでした(ちなみにブログのコメントにしては恐しく長文)。

どんなものか適当に想像して作ってみたりしたこともありました(#:g1: CLでのDylan風定義とCLOS系言語での型指定書法の比較)が、実物はかなりゴツい感じですね。

split-sequenceの紹介

Posted 2014-11-15 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の320日目です。

split-sequenceとはなにか

 split-sequenceは、Sharp Lispers作のシークエンスをデリミタで分割するライブラリです。

パッケージ情報

パッケージ名split-sequence
Quicklisp
CLiKiCLiki: SPLIT-SEQUENCE
Quickdocssplit-sequence | Quickdocs
CL Test Grid: ビルド状況split-sequence | CL Test Grid

インストール方法

(ql:quickload :split-sequence)

試してみる

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

 1998年頃のcomp.lang.lispで初心者の質問でsplitの話題が出たらしいのですが、色々な実装がレスの中であるうちArthur Lemmens氏の実装がsplit-sequenceの元になったみたいです。
仕様と動作は、Common Lispの流儀に則ったものになっています。

(split-sequence:split-sequence #\, "foo,bar,baz")
;=>  ("foo" "bar" "baz")
;    11

(split-sequence:split-sequence-if (lambda (c) (char= #\, c)) "foo,bar,baz") ;=> ("foo" "bar" "baz") ; 11

(split-sequence:split-sequence-if-not #'alphanumericp "foo,bar,baz") ;=> ("foo" "bar" "baz") ; 11

まとめ

 今回は、split-sequenceを紹介してみました。
初心者の質問に答える形で誕生したという経緯のためか、ソースコードも非常に教育的です。
コードは短かいですが、Common Lispの流儀が学べる教材としても有用ではないでしょうか。

com.informatimago.common-lisp.lisp-reader.readerの紹介

Posted 2014-11-13 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の318日目です。

com.informatimago.common-lisp.lisp-reader.readerとはなにか

 com.informatimago.common-lisp.lisp-reader.readerは、Pascal Bourguignon氏作のANSI Common Lisp標準に準拠したリーダーの実装です。

パッケージ情報

パッケージ名com.informatimago.common-lisp.lisp-reader.reader
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.lisp-reader.reader)

試してみる

 Common Lispのリーダーを丸ごと実装しているのですが、動作はカスタマイズも可能で、リーダーと密に連携するためかCommon Lispのパッケージの実装も付属してきます。
カスタマイズは色んな方法が考えられるかと思いますが、リードテーブルにトークンの解釈をする関数が設定されているので、これをいじるだけでも結構色々なことができそうです。

 例として、標準のリーダーでは扱いが面倒臭いパッケージマーカー(:)を単なる文字として扱うようなリーダーを作成してみます。

(defun parse-token* (token)
  "
RETURN:  okp ; the parsed lisp object if okp, or an error message if (not okp)
"
  (let ((message nil))
    (macrolet
        ((rom (&body body)
           "Result Or Message"
           (if (null body)
               'nil
               (let ((vals (gensym)))
                 `(let ((,vals (multiple-value-list ,(car body))))
                    ;; (format *trace-output* "~S --> ~S~%" ',(car body) ,vals)
                    (if (first ,vals)
                        (values-list ,vals)
                        (progn
                          (when (second ,vals)
                            (setf message  (third ,vals)))
                          (rom ,@(cdr body)))))))))
      ;; (format *trace-output* "token: ~S~%" token)
      (multiple-value-bind (ok type object)
          (rom (parse-decimal-integer-token token)
               (parse-integer-token         token)
               (parse-ratio-token           token)
               (parse-float-1-token         token)
               (parse-float-2-token         token)
               ;; (parse-consing-dot-token     token)
               (parse-symbol-token*          token))
        (declare (ignorable type))
        ;; (format *trace-output* "ok = ~S ; type = ~S ; object = ~S~%"
        ;; ok type object )
        (values ok (if ok object message))))))

(defparser parse-symbol-token* (token) (accept 'symbol (intern (token-text token) *package*)))

(setf (readtable-parse-token *readtable*) #'parse-token*) ;=> #<FUNCTION PARSE-TOKEN*>

(with-input-from-string (in "(a:a:a:a b:b:b c \"a\" #'a:a:a)") (read in)) ;=> (|A:A:A:A| |B:B:B| C "a" #'|A:A:A|)

(with-input-from-string (in "(|a:a:a| :a::b::c:: ::)") (read in)) ;=> (|a:a:a| |:A::B::C::| |::|)

(readtable-parse-token *readtable*)でリードテーブルに付属のトークンを解釈する関数を読み書き可能なのでパッケージマーカーについては特に何もせず文字列をシンボルに変換するだけの関数に差し替えています。

まとめ

 今回は、com.informatimago.common-lisp.lisp-reader.readerを紹介してみました。
ほとんど標準のリーダーと同じ動作だけれど、ちょっとだけカスタマイズして使いたい、ということがありますが、パッケージマーカー等が微妙に邪魔だったりします。
この辺りを迂回できるだけでも結構便利に使えますね。

Older entries (1842 remaining)