#:g1: frontpage

 

defrecの紹介

Posted 2014-08-19 06:20:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の231日目です。

defrecとはなにか

 defrecは、Robert Smith氏作の再帰する関数を定義するためのユーティリティです。

パッケージ情報

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

インストール方法

(ql:quickload :defrec)

試してみる

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

 といっても定義はdefrec一つのみです。
主に相互呼び出しの再帰関数の定義に用いることを意図しているようですが、defrecマクロがしていることは、ローカル関数を作って、それを大域関数の補助関数とする、というものです。
一度labelsで定義したものをfletで包み、それをまたdefunで大域定義としていますが、fletは何のためなのでしょう。

(defrec:defrec
  (fib (n)
    (fib1 n 1 0))
  (fib1 (n a1 a2)
    (cond ((zerop n) a2)
          ((= 1 n) a1)
          (T (fib1 (1- n) (+ a1 a2) a1)))))
;==>
(LABELS ((FIB (N)
           (FIB1 N 1 0))
         (FIB1 (N A1 A2)
           (COND ((ZEROP N) A2) ((= 1 N) A1) (T (FIB1 (1- N) (+ A1 A2) A1)))))
  (FLET ((#:FIB1221 (N)
           (FIB N))
         (#:FIB11222 (N A1 A2)
           (FIB1 N A1 A2)))
    (DECLARE (INLINE #:FIB1221 #:FIB11222))
    (DEFUN FIB (N) (#:FIB1221 N))
    (DEFUN FIB1 (N A1 A2) (#:FIB11222 N A1 A2)))
  '(FIB FIB1))


(fib 100)
;=>  354224848179261915075

 ドキュメントにあるコード例をみて思いましたが、多分

(labels ((even (x)
           (declare (type unsigned-byte x))
           (if (zerop x)
               t
               (odd (1- x))))
         (odd (x)
           (declare (type unsigned-byte x))
           (if (zerop x)
               nil
               (even (1- x)))))
  (setf (values (fdefinition 'even)
                (fdefinition 'odd))
        (values #'even #'odd)))

 のようなものを、

(defrec:defrec
  (even (x)
    (declare (type unsigned-byte x))
    (if (zerop x) t (odd (1- x))))
  (odd (x)
    (declare (type unsigned-byte x))
    (if (zerop x) nil (even (1- x)))))

のように、すっきり書くことを意図しているのかなと思いました。

まとめ

 今回は、defrecを紹介してみました。
今回も一発物でした。even/oddのような関係の関数の定義は殆どないと思いますが、ローカル関数を定義しつつ大域でも呼び出したいような場合には便利かもしれません。

#lang algol60の紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の230日目です。

#lang algol60とはなにか

 #lang algol60は、Racketに標準で用意されているコードをAlgol 60の文法で書ける仕組みです。

パッケージ情報

パッケージ名#lang algol60
ドキュメントRacket: Algol 60

試してみる

 ソースコードに

#lang algol60

と指定するのみで以降がAlgol 60の文法として解釈されます。

#!/usr/bin/env racket

#lang algol60

begin
  procedure fib (n);
  integer n;
  begin
   if n < 2 then
     fib := n
   else
     fib := fib(n - 1) + fib(n - 2);
  end;

  prints(`fib(10) => ');
  printnln(fib(10));
end

のようなスクリプトを書いて実行属性を付ければ、Algol 60をシェルスクリプトとして利用するようなこともできます。

$ /tmp/algol-fib.rkt
fib(10) => 55

 また、literal-algol式の中に文字列としてAlgol 60を記述することも可能です。その場合は、

(require algol60/algol60)

が必要です。

#lang racket

(require algol60/algol60)

(literal-algol "begin
  procedure fib (n);
  integer n;
  begin
   if n < 2 then
     fib := n
   else
     fib := fib(n - 1) + fib(n - 2);
  end;

  prints(`fib(10) => ');
  printnln(fib(10));
end")
;>> fib(10) => 55

まとめ

 今回は、#lang algol60を紹介してみました。
やはりRacketの#langは羨しいですね。

typedvarの紹介

Posted 2014-08-17 04:45:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の229日目です。

typedvarとはなにか

 typedvarは、CLISPの開発者で知られるBruno Haible氏作のCommon Lispの型宣言を楽に記述できるようにするCommon Lispの拡張です。

パッケージ情報

パッケージ名typedvar
プロジェクトサイト CLOCC - Common Lisp Open Code Collection / Hg / [e6b24a] /src/syntax/typedecl/typedvar.lisp

インストール方法

 CLOCCのプロジェクトサイトからダウンロードしてきて適当に導入します。

$ hg clone http://hg.code.sf.net/p/clocc/hg clocc-hg

で全体のソースも取得できます。
src/syntax/typedecl/typedvar.lisp が目的のソースです。
リードテーブルの[、]、#'を再定義するので予めリードテーブルを自前で定義しておいた方が良いかと思います。

試してみる

 letが一番分かり易いかと思いますが、

(LET ((X 42))
  (DECLARE (TYPE INTEGER X))
  X)

のようなものを

(let (([x integer] 42))
  x)

と書けるようにしようというものです。
再定義されている構文は、

  • with-slots
  • with-output-to-string
  • with-open-stream
  • with-open-file
  • with-input-from-string
  • with-accessors
  • prog*
  • prog
  • multiple-value-bind
  • let*
  • let
  • lambda
  • labels
  • function
  • flet
  • dotimes
  • dolist
  • do-symbols
  • do-external-symbols
  • do-all-symbols
  • do*
  • do
  • defvar
  • defun
  • defparameter
  • defmethod
  • defgeneric
  • defconstant

あたりです。
記述例としては下記のような感じです。

(defmethod matu ([x integer])
  x)
;==>
(CL:DEFMETHOD MATU ((X INTEGER)) (DECLARE (TYPE INTEGER X)) X)


(matu 'a)
;!> There is no applicable method for the generic function


(loop for [n integer] from 0 to 9)


(defun dialma ([n number] [s symbol] [a atom]) [list]
  (list n s a))
;==>
(PROGN
 (DECLAIM (FTYPE (CL:FUNCTION (NUMBER SYMBOL ATOM) LIST) DIALMA))
 (CL:DEFUN DIALMA (N S A)
   (DECLARE (TYPE NUMBER N)
            (TYPE SYMBOL S)
            (TYPE ATOM A))
   (LIST N S A)))


(funcall (lambda ([x symbol]) x) 42)
;==>
(FUNCALL
 (THE (CL:FUNCTION (SYMBOL) T) #'(CL:LAMBDA (X) (DECLARE (TYPE SYMBOL X)) X))
 42)


(do* (([n fixnum] 0 (1+ n))
      ([ans list] (list nil))
      ([tem list] ans))
     ((= 10 n) (cdr ans))
  (setf (cdr tem) (setq tem (list n))))
;=>  (0 1 2 3 4 5 6 7 8 9)


(dolist ([e integer] '(1 2 3 a))
  e)
;!> The value A is not of type INTEGER.


(defun fib ([n fixnum]) [fixnum]
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (labels ((fib ([n fixnum]) [fixnum]
             (if (< n 2)
                 n
                 (the fixnum
                      (+ (fib (1- n))
                         (fib (- n 2)))))))
    (declare (inline fib))
    (fib n)))

 defun等関数の定義構文では、返り値の型も可能です。
また、こういう構文拡張にありがちな問題ですが、lambdaは、cl:lamdbaではないため

((lambda (x) x) 42)

とは書けず、funcallが必要になります。
さらに、説明では、loopでも

(loop :for [n integer] :in '(1 2 ...) ...)

のように書けるようなことが書いてありますが、ソースのコメントには #| TODO: (defmacro loop ...) |# とあるので未実装のようです。

まとめ

 今回は、typedvarを紹介してみました。
Common Lispの構文にDylanのような型指定の構文を導入しようという試みは割合にありますね。

stringの紹介

Posted 2014-08-15 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の228日目です。

stringとはなにか

 stringは、MacLISPの文字列ライブラリです。

パッケージ情報

パッケージ名string

インストール方法

 MacLISPで

(load '((lisp) string)))

で使えます。

試してみる

 ソースのヘッダをみるに

;;;  STRING    				-*-Mode:Lisp;Package:SI;Lowercase:T-*-
;;;  *************************************************************************
;;;  *** NIL ***** Functions for STRINGs and CHARACTERs **********************
;;;  *************************************************************************
;;;  ** (c) Copyright 1981 Massachusetts Institute of Technology *************
;;;  *************************************************************************

;;; Provides support for NIL string operations under maclisp, with
;;;   most LISPM STRING functions added for compatibility.
;;; To read this file in on LISPM, do (PACKAGE-DECLARE * SYSTEM 100)

という風にNIL風の動作を実現するもののようです。
1980年頃は、MacLISPの後継としてNILが開発されていて、同じMIT系でLispマシンとMacLISPとNILとでソースコードを共有しようという動きもあったようですが、どうもLispマシンの人達は、それにはあまり関心はなかったようです。
それはさておき、ライブラリの内容ですが、Lispマシンで実現された機能を持ってきたというものが多い様子。
そもそもMacLISPでは文字列はなかったと思っていたのですが、どうも後期のMacLISPではHUNKというデータ構造を利用して文字列を実現していたようです。

このライブラリでもLispマシン風とNILで実装しようとしている機能とが、ごちゃまぜになって割合にカオスな状態になっています。
Lispマシンでは、Cのように文字は数値ですが、このライブラリでは、その方式とは別に~/aという文字リテラルの表現が定義されています。
これとは別にLispマシン風の文字は、Lispマシンと同じく#/aと記述できますが、これらを使い分ける必要があったりします。
大まかな使い分けですが、charなんとかという名前の場合は、#/aの方を使うようです。
定義されている関数は以下のものです。

  • characterp
  • *:character-to-fixnum
  • *:fixnum-to-character
  • to-character
  • to-character-n
  • digitp
  • digit-weight
  • character
  • char-equal
  • char-lessp
  • |+internal-tilde-macro/||
  • useratoms-hook->character-class
  • flatsize->character-class
  • stringp
  • char
  • rplachar
  • string-length
  • string-searchq
  • string-bsearchq
  • set-string-length
  • string-remq
  • make-string
  • string-subseq
  • string-mismatchq
  • string-hash
  • char-n
  • rplachar-n
  • string-fill
  • string-fill-n
  • string-replace
  • string-posq
  • string-bposq
  • string-posq-n
  • string-bposq-n
  • string-skipq
  • string-bskipq
  • string-skipq-n
  • string-bskipq-n
  • string-equal
  • string-lessp
  • string-search
  • string-reverse-search
  • string-downcase
  • string-upcase
  • get-pname
  • substring
  • string-append
  • string-reverse
  • string-nreverse
  • string-trim
  • string-left-trim
  • string-right-trim
  • char-downcase
  • char-upcase
  • string-search-char
  • string-search-not-char
  • string-search-set
  • string-search-not-set
  • string-reverse-search-char
  • string-reverse-search-not-char
  • string-reverse-search-set
  • string-reverse-search-not-set
  • string-pnget
  • string-pnput
  • |+internal-doublequote-macro/||
  • useratoms-hook->string-class
  • equal->string-class
  • flatsize->string-class
  • purcopy->string-class
  • namestring->string-class
  • sxhash->string-class
  • explode->string-class
  • samepnamep->string-class
  • alphalessp->string-class
  • lessp->string-class
  • greaterp->string-class
  • +internal-char-n
  • +internal-rplachar-n
  • +internal-string-word-n
  • str:clear-words
  • str/:compare-words
  • str/:grab-purseg

使い方は

(characterp 'a)
;=> NIL 


(characterp ~/a)
;=> T 

(*:character-to-fixnum ~/a)
;=> 97

(*:fixnum-to-character 97)
;=> ~/a

(mapcar #'to-character '(97 |a| "a"))
;=> (~/a ~/a ~/a)

(mapcar #'to-character-n '(97 |a| "a"))
;=> (97 97 97)


(to-character-n? ~/f () )
;=> 102

(to-string ~/a)
;=> "a"


(digitp ~/0)
;=> T


(digit-weight ~/0)
;=> 0 


(character "a")
;=> 97


(char-equal ~/a ~/a)
;!> ~/a NON-FIXNUM VALUE


(char-equal #/a #/a)
;=> T


(char-lessp #/a #/b)
;=> T


(get-pname 'foo)
;=> "FOO"


(string-remq ~/a "abc")
;=> "bc"


(string-remq #/a "abc")
;=> "bc"


(make-string 8 ~/a)
;=> "aaaaaaaa"


(string-searchq "ar" "foo bar baz")
;=> 5


string-bsearchq ;; ???


(string-mismatchq "foo" "foo bar baz")
;=> 3


(string-posq ~/d "madi")
;=> 2


(string-bposq ~/d "ddddd")
;=> 4 

(string-posq ~/d "ddddd")
;=> 0


(string-bposq-N #/d "ddddd")
;=> 4

(string-skipq ~/d "ddddd")
;=> NIL 


(string-skipq ~/d "ddddda")
;=> 5 


(string-bskipq ~/d "ddaddd")
;=> 6


(string-equal "foo" "foo")
;=> T 


(string-lessp "foo" "bar")
;=> NIL


(string-search "halito" "lahalito")
;=> 2


(string-reverse-search "halito" "lahalito")
;=> 2


(string-downcase 'foo)
;!> FOO must be a STRING for function STRING-DOWNCASE


(string-downcase (to-string 'foo))
;=> "foo"


(string-upcase "foo")
;=> "FOO"


(char-downcase #/A)
;=> 97


(char-upcase #/a)
;=> 65

(string-reverse "zilwan")
;=> "nawliz"

(substring "masopic" 4 5)
;=> "p" 

(substring "masopic" 4)
;=> "pic"


(string-append "dialma" "kandi")
;=> "dialmakandi"


(string-search-char #/t "dilto")
;=> 3


(string-search-not-char #/t "dilto")
;=> 0 


(string-search-set '(#/d #/i) "makanito")
;=> 5 


(string-search-not-set '(#/m #/a) "makanito")
;=> 2


(string-search-char #/a "manifo")
;=> 1


(string-reverse-search-char #/s "sos")
;=> 2 


(string-replace "dilto" "xxx" 0)
;=> "xxxto"

(string-trim '(#/z #/f)  "foo bar baz")
;=> "oo bar baz"


(string-pnget "foo" 7)
;=> (-13489438720)

みたいな感じです。
string-なんとかがシンボルに使えなかったり、substringというのがあるのにstring-subseqというのが定義されていたりと不思議なところもあります。
また、NILでは関数は総称的なものになりつつありましたが、to-string等にその辺りが反映されています。defstructが若干拡張されたようなdefclassとdefmethod*というもので定義されているところもあります。

まとめ

 今回は、MacLISPのstringを紹介してみました。
MacLISPの最終形態は1980年代前半位のものかなと思いますが、NILやLispマシンの成果を取り入れようとしていて、なかなか面白いところがあります。

lisp-magickの紹介

Posted 2014-08-15 01:45:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の227日目です。

lisp-magickとはなにか

 lisp-magickは、Hans Bulfone氏作のImageMagick (MagickWand)をCommon Lispから使うためのライブラリです。

パッケージ情報

パッケージ名lisp-magick
Quicklisp
プロジェクトサイトnil.at:lisp-magick
Quickdocslisp-magick | Quickdocs
CL Test Grid: ビルド状況lisp-magick | CL Test Grid

インストール方法

(ql:quickload :lisp-magick)
The alien function "GetMagickOptions" is undefined.

とビルド時にエラーになるのですが、imagemagick側のAPIの変更によるもののようです。
上記のCL Test Gridでも真っ赤。

のパッチを適用するとビルドできるようになります。

試してみる

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

MagickWandの機能は一通り使えるようではありますが、SBCLだとfloating-point-invalid-operationが飛んだりするので、sb-int:with-float-traps-maskedで囲ってやったりする必要があるみたいです。

(lisp-magick:with-magick-wand (w :create 256 150 :comp (0 0 0))
  (lisp-magick:magick-write-image w "/tmp/foo.png"))


(sb-int:with-float-traps-masked (:invalid)
  (lisp-magick:with-magick-wand (w :load "/tmp/foo.png")
    (lisp-magick:magick-identify-image w)))
;=>  "Image: /tmp/foo.png
;      Format: PNG (Portable Network Graphics)
;      Class: PseudoClass
;      Geometry: 256x150+0+0
;      Resolution: 72x72
;      Print size: 3.55556x2.08333
;      Units: Undefined
;      Type: Bilevel
;      Base type: Bilevel
;      Endianess: Undefined
;      Colorspace: Gray
;      Depth: 8/1-bit
;      Channel depth:
;        gray: 1-bit
;      Channel statistics:
;        Gray:
;          min: 0 (0)
;          max: 0 (0)
;          mean: 0 (0)
;          standard deviation: 0 (0)
;          kurtosis: 0
;          skewness: 0
;      Colors: 1
;      Histogram:
;         38400: (  0,  0,  0) #000000 gray(0,0,0)
;      Colormap: 2
;             0: (  0,  0,  0) #000000 gray(0,0,0)
;             1: (255,255,255) #FFFFFF gray(255,255,255)
;      Rendering intent: Perceptual
;      Gamma: 0.45455
;      Chromaticity:
;        red primary: (0.64,0.33)
;        green primary: (0.3,0.6)
;        blue primary: (0.15,0.06)
;        white point: (0.3127,0.329)
;      Interlace: None
;      Background color: gray(255,255,255)
;      Border color: gray(223,223,223)
;      Matte color: gray(189,189,189)
;      Transparent color: gray(0,0,0)
;      Compose: Over
;      Page geometry: 256x150+0+0
;      Dispose: Undefined
;      Iterations: 0
;      Compression: Zip
;      Orientation: Undefined
;      Properties:
;        date:create: 2014-08-15T09:56:26+09:00
;        date:modify: 2014-08-15T09:56:26+09:00
;        png:bKGD                 : chunk was found (see Background color, above)
;        png:cHRM                 : chunk was found (see Chromaticity, above)
;        png:gAMA                 : gamma=0.45454544 (See Gamma, above)
;        png:IHDR.bit_depth       : 1
;        png:IHDR.color_type      : 0 (Grayscale)
;        png:IHDR.interlace_method: 0 (Not interlaced)
;        png:IHDR.width,height    : 256, 150
;        png:pHYs                 : x_res=72, y_res=72, units=0
;        png:sRGB                 : intent=0 (See Rendering intent)
;        signature: d8b443032200e143b1c49820b6d78c32d519553a3f63a38f48e8bc31da084f0a
;      Tainted: False
;      Filesize: 193B
;      Number pixels: 38.4K
;      Pixels per second: 0B
;      User time: 0.000u
;      Elapsed time: 0:01.000
;      Version: ImageMagick 6.7.7-10 2014-06-29 Q16 http://www.imagemagick.org
;    "           

インストール時に適用した問題が既に2012年の問題だったことからして、このライブラリはメンテナンスされなくなって久しいようです。

まとめ

 今回は、lisp-magickを紹介してみました。
cl-imagemagick等、類似のものがあるのでこちらも試してみたいところ。

cl-procの紹介

Posted 2014-08-14 07:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の226日目です。

cl-procとはなにか

 cl-procは、Reinout Stevens氏によるlibprocをCommon Lispから使うライブラリです。

パッケージ情報

パッケージ名cl-proc
Quicklisp
Quickdocscl-proc | Quickdocs
common-lisp.netCL-Proc project
CL Test Grid: ビルド状況cl-proc | CL Test Grid

インストール方法

(ql:quickload :proc)

 Debianの場合、事前に

$ sudo apt-get install libprocps3-dev

等でlibprocpsの開発環境をインストールしておきます。

試してみる

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

 Debianの場合、libprocが無く、libprocspなので、定義に若干の追加をします。

(define-foreign-library libproc
  (:unix (:or "libproc-3.2.8.so" "libproc-3.2.7.so" "libproc.so" "libprocps.so.3"))
  (t (:default "libproc-dev")))

 用意されているのは下記のような関数と定数ですが、libprocの仕様変更によりget_proc_statsがプライベートなシンボルになってしまったため、get_proc_statsを使っている箇所はコードを修正しないと動きません。

  • +nr-of-cpus+
  • boottime
  • get-elapsed-time
  • get-pid-info
  • get-pids
  • get-pids-info
  • get-start-time
  • kill
  • signal-name-to-number
  • signal-number-to-name
  • uptime
proc:+nr-of-cpus+
;=>  8


(proc:boottime)
;=>  1407816324


(proc:get-pids)
;=>  (1 2 3 5 7 8 9 10 11 12 13 15 16 17 18 20 21 22 23 25 26 27 28 30 31 32 33 35
;     36 37 38 40 41 42 43 45 46 47 48 49 50 51 52 53 54 55 57 58 59 64 66 68 112
;     115 117 118 119 120 121 122 123 124 125 126 133 134 135 137 138 146 147 148
;     153 154 158 159 175 176 177 179 180 181 182 202 209 210 226 301 313 314 315
;     320 396 400 418 463 464 466 467 471 511 517 570 571 574 579 580 600 789 798
;     803 812 823 828 833 837 884 891 893 928 931 936 938 940 955 956 967 968 969
;     972 973 974 975 976 977 978 979 984 1012 1032 1239 1258 1292 1311 1370 1372
;     1373 1375 1376 1378 1379 1643 1716 1901 1951 1952 2193 2194 2211 2212 2217
;     2283 2284 2293 2296 2297 2319 2320 2330 2338 2342 2345 2349 2353 2367 2375
;     2376 2383 2384 2385 2386 2387 2388 2389 2394 2399 2400 2404 2420 2423 2424
;     2425 2426 2464 2485 2508 2540 2560 2574 2653 2654 2665 2759 2760 2761 2784
;     2880 3050 3051 3054 3055 3056 3060 3081 3089 3092 3126 3245 3263 3313 3369
;     3389 4207 4208 4209 4210 5657 5678 5690 5695 5723 5799 5879 5934 5974 6124
;     6129 6133 6137 6142 6145 6151 6195 6232 6514 6579 6580 6926 6934 6935 6947
;     7031 7032 7033 7058 7232 7233 7523 7589 7604 7611 7616 8019 8023 8037 8174
;     8363 8365 8399 8479 8671 8798 8817 8914 9005 9061 19330 19534 19549 19636
;     19813 20318 20576 20728 20871 20994 24111 24112 24113 30520 31836)


(proc:get-pids-info 'proc::tid)
;=>  ((1) (2) (3) (5) (7) (8) (9) (10) (11) (12) (13) (15) (16) (17) (18) (20) (21)
;     (22) (23) (25) (26) (27) (28) (30) (31) (32) (33) (35) (36) (37) (38) (40)
;     (41) (42) (43) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (57)
;     (58) (59) (64) (66) (68) (112) (115) (117) (118) (119) (120) (121) (122) (123)
;     (124) (125) (126) (133) (134) (135) (137) (138) (146) (147) (148) (153) (154)
;     (158) (159) (175) (176) (177) (179) (180) (181) (182) (202) (209) (210) (226)
;     (301) (313) (314) (315) (320) (396) (400) (418) (463) (464) (466) (467) (471)
;     (511) (517) (570) (571) (574) (579) (580) (600) (789) (798) (803) (812) (823)
;     (828) (833) (837) (884) (891) (893) (928) (931) (936) (938) (940) (955) (956)
;     (967) (968) (969) (972) (973) (974) (975) (976) (977) (978) (979) (984) (1012)
;     (1032) (1239) (1258) (1292) (1311) (1370) (1372) (1373) (1375) (1376) (1378)
;     (1379) (1643) (1716) (1901) (1951) (1952) (2193) (2194) (2211) (2212) (2217)
;     (2283) (2284) (2293) (2296) (2297) (2319) (2320) (2330) (2338) (2342) (2345)
;     (2349) (2353) (2367) (2375) (2376) (2383) (2384) (2385) (2386) (2387) (2388)
;     (2389) (2394) (2399) (2400) (2404) (2420) (2423) (2424) (2425) (2426) (2464)
;     (2485) (2508) (2540) (2560) (2574) (2653) (2654) (2665) (2759) (2760) (2761)
;     (2784) (2880) (3050) (3051) (3054) (3055) (3056) (3060) (3081) (3089) (3092)
;     (3126) (3245) (3263) (3313) (3369) (3389) (4207) (4208) (4209) (4210) (5657)
;     (5678) (5690) (5695) (5723) (5799) (5879) (5934) (5974) (6124) (6129) (6133)
;     (6137) (6142) (6145) (6151) (6195) (6232) (6514) (6579) (6580) (6926) (6934)
;     (6935) (6947) (7031) (7032) (7033) (7058) (7232) (7233) (7523) (7589) (7604)
;     (7611) (7616) (8019) (8023) (8037) (8174) (8363) (8365) (8399) (8479) (8671)
;     (8798) (8817) (8914) (9005) (9061) (9141) (19330) (19534) (19549) (19636)
;     (19813) (20318) (20576) (20728) (20871) (20994) (24111) (24112) (24113)
;     (30520) (31836))


(proc:kill pid 9)


(proc:signal-number-to-name 9)
;=>  "KILL"


(proc:signal-name-to-number "kill")
;=>  9


(time:print-interval-or-never (proc:uptime))
;>>  2 days 3 hours 22 minutes 30 seconds
;=>  NIL

まとめ

 今回は、cl-procを紹介してみました。
当然のことではありますが、FFI系のライブラリは元のライブラリが変更になって動かないというパタンが非常に多いですね。

check-errorsの紹介

Posted 2014-08-13 03:50:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の225日目です。

check-errorsとはなにか

 check-errorsは、Kon Lovett氏作のChickenで関数の引数チェックをするユーティリティです。

パッケージ情報

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

インストール方法

$ sudo chicken-install check-errors

すれば、

(use check-errors)

で使えます。

試してみる

 ドキュメントを眺めて最初に思うのは、型一つにつき対応する手続きがずらっとあるのか、というところです。
type-errors系と、type-checks系に分かれますが、

  • check-defined-value
  • check-bound-value
  • check-fixnum
  • check-positive-fixnum
  • check-natural-fixnum
  • check-flonum
  • check-integer
  • check-positive-integer
  • check-natural-integer
  • check-number
  • check-positive-number
  • check-natural-number
  • check-procedure
  • check-input-port
  • check-output-port
  • check-list
  • check-pair
  • check-blob
  • check-vector
  • check-structure
  • check-symbol
  • check-keyword
  • check-string
  • check-char
  • check-boolean
  • check-alist
  • check-minimum-argument-count
  • check-argument-count
  • check-open-interval
  • check-closed-interval
  • check-half-open-interval
  • check-half-closed-interval
  • define-check-type
  • define-check+error-type
  • make-bad-argument-message
  • make-type-name-message
  • make-error-type-message
  • signal-type-error
  • error-argument-type
  • warning-argument-type
  • error-defined-value
  • error-bound-value
  • error-fixnum
  • error-positive-fixnum
  • error-natural-fixnum
  • error-flonum
  • error-integer
  • error-positive-integer
  • error-natural-integer
  • error-number
  • error-positive-number
  • error-natural-number
  • error-procedure
  • error-input-port
  • error-output-port
  • error-list
  • error-pair
  • error-blob
  • error-vector
  • error-structure
  • error-symbol
  • error-keyword
  • error-string
  • error-char
  • error-boolean
  • error-alist
  • error-minimum-argument-count
  • error-argument-count
  • error-open-interval
  • error-closed-interval
  • error-half-open-interval
  • error-half-closed-interval
  • error-interval
  • define-error-type

のような感じです。これに加えて、SRFI 4に定義されているものも同じように述語が用意されています。

 使い方はシンプルに

(define (foo x y)
  (check-integer 'foo x "foo: arg0")
  (check-integer 'foo y "foo: arg1")
  x)


(foo 1 2.3)
;!> Error: (foo) bad `foo: arg1' argument type - not an integer: 2.3


(define (bar n)
  (error-fixnum 'bar n 0)
  n)

(bar 4.2)
;!> Error: (bar) bad `0' argument type - not a fixnum: 4.2

というところ。error-とcheck-で殆ど変わりない気がしますが…。
define-error-type等で自前の定義もできます。

まとめ

 今回は、check-errorsを紹介してみました。
Schemeだと型ごとに対応する手続きが存在するというのは割合に見掛けますが、これもそんな感じですね。

filterの紹介

Posted 2014-08-12 05:45:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の224日目です。

filterとはなにか

 filterは、Scott McIntire氏作のリストでのツリー表現を扱うライブラリです。

パッケージ情報

パッケージ名filter
Quicklisp×
配布サイト(archive.org)Allegro CL Examples and Utilities

インストール方法

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

試してみる

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

  • filter
  • flatten
  • linearize
  • map-tree
  • prune-tree
  • tree-hom
  • tree-sig

といったところです。
動作は下記のような感じですが、filterの動作がSchemeのfilterの動作とは正反対で述語が真を返すものは取り除きます。
flattenは点対リストも処理できるので良いですね(割と対応してなかったりします。)
linearizeというのが謎ですが、flattenしてremove-duplicateするようなものです。

(fil:flatten '((0 . 100) (1 . 101) (2 . 102) (3 . 103) (4 . 104) (5 . 105) (6 . 106)
               (7 . 107) (8 . 108) (9 . 109)))
;=>  (0 100 1 101 2 102 3 103 4 104 5 105 6 106 7 107 8 108 9 109)


(fil:filter '(0 100 1 101 2 102 3 103 4 104 5 105 6 106 7 107 8 108 9 109)
            #'evenp)
;=>  (1 101 3 103 5 105 7 107 9 109)


(fil:linearize '((0 . 9) (1 . 8) (2 . 7) (3 . 6) (4 . 5) (5 . 4) (6 . 3) (7 . 2) (8 . 1)
                 (9 . 0)))
;=>  (5 4 6 3 7 2 8 1 9 0)


(fil:linearize '((0 . 9) (1 . 8) (2 . 7) (3 . 6) (4 . 5) (5 . 4) (6 . 3) (7 . 2) (8 . 1)
                 (9 . 0))
               :from-end T)
;=>  (0 9 1 8 2 7 3 6 4 5)


(fil:prune-tree '((0 9) (1 8) (2 7) (3 6) (4 5) (5 4) (6 3) (7 2) (8 1) (9 0))
                #'evenp)
;=>  ((9) (1) (7) (3) (5) (5) (3) (7) (1) (9))


(funcall (fil:tree-hom #'evenp (lambda (x) (+ 100 x)))
         '((0 9) (1 8) (2 7) (3 6) (4 5) (5 4) (6 3) (7 2) (8 1) (9 0)))
;=>  ((109) (101) (107) (103) (105) (105) (103) (107) (101) (109))


(fil:tree-sig '(-10
                (((((-8 9) ((-7 -5) 9)) ((-10 (2 2)) 3)) -2)
                 ((-2 (5 (((6 -8) (8 (-1 -8))) 2)))
                  (((((6 (3 9)) (9 6)) (1 0)) -3)
                   ((((-2 (-8 (7 0))) 0) (1 -7))
                    (((-6 (-2 -10)) -10) (-3 (1 ((-6 -2) -9))))))))))
;=>  (T
;     (((((T T) ((T T) T)) ((T (T T)) T)) T)
;      ((T (T (((T T) (T (T T))) T)))
;       (((((T (T T)) (T T)) (T T)) T)
;        ((((T (T (T T))) T) (T T)) (((T (T T)) T) (T (T ((T T) T)))))))))

まとめ

 今回は、filterを紹介してみました。
このライブラリもコンパイルを通すのに型宣言を結構調整しないといけませんでした。
まあちょっと直せば動くんですが、古いコードや処理系べったりのコードでコンパイルを通すには、まず型宣言を全部削る所からスタートすると楽だったりしますね。

bssqの紹介

Posted 2014-08-10 23:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の223日目です。

bssqとはなにか

 bssqは、MacLISPでGerald Jay Sussman(GJS)と、Guy L. Steele, Jr.(GLS)によって1977年に書かれた、assqの変種です。

パッケージ情報

パッケージ名bssq

インストール方法

 ITSのアーカイブの中にLIBDOC;BSSQ GL/JS5として埋もれています
MIDASのファイルなのでMIDASでアセンブルしてFASLを作ります。

ITSの場合

midas↑k
dsk:bssq > libdoc;
BUBBLING ASSQ
BUBBLING ASSQ
Run time = 0.65
1726 Symbols including initial ones (63% used)

:KILL

なお、SYS;.FASL DEFSがないとFASLは作れませんのでシステムに用意されているか確認しましょう。

ロード方法

 MIDASで作成したFASLは、ユーザーのホームディレクトリに作成されるので、

(load '((dsk user) bssq fasl))

等で読み込みましょう。

試してみる

 短いファイルなのでファイル丸ごと記載してみます。
コメントにあるように、動作はassq(Common Lispでいうassocの:testにeqを指定したもの)と同じですが、見付かったアイテムを手前に移動する、という物のようです。変更は破壊的に行ないます。

TITLE BUBBLING ASSQ

;;; BSSQ IS LIKE ASSQ, BUT IF IT FINDS A PAIR IT BUBBLES IT
;;; TOWARD THE FRONT OF THE A-LIST BY DOING TWO RPLACA'S.

.FASL
.INSRT SYS:.FASL DEFS

.ENTRY BSSQ SUBR 0003		;2 ARGS
BSSQ:	MOVS C,(B)		;WORKS FOR SECOND ARG = NIL!
	HLRZ T,(C)
	CAIN T,(A)
	 JRST BSSQ7
BSSQ0:	HLRZ C,C
	JUMPE C,BSSQ7
	MOVS AR1,(C)
	HLRZ T,(AR1)
	CAIN T,(A)
	 JRST BSSQ2
	HLRZ AR1,AR1
	JUMPE AR1,BSSQ8
	MOVS B,(AR1)
	HLRZ T,(B)
	CAIN T,(A)
	 JRST BSSQ4
	HLRZ B,B
	JUMPE B,BSSQ9
	MOVS C,(B)
	HLRZ T,(C)
	CAIE T,(A)
	 JRST BSSQ0
	HLRZ T,(AR1)
	HRLM C,(AR1)
	HRLM T,(B)
BSSQ7:	MOVEI A,(C)
	POPJ P,

BSSQ2:	HLRZ T,(B)
	HRLM AR1,(B)
	HRLM T,(C)
BSSQ8:	MOVEI A,(AR1)
	POPJ P,

BSSQ4:	HLRZ T,(C)
	HRLM B,(C)
	HRLM T,(AR1)
BSSQ9:	MOVEI A,(B)
	POPJ P,

FASEND

ということで実際に動かして確認してみましょう


(defvar *alist* (subst nil nil '((A . 0) (B . 1) (C . 2) (D . 3) (E . 4) (F . 5))))


*alist*
;=> ((A . 0) (B . 1) (C . 2) (D . 3) (E . 4) (F . 5)) 


(bssq 'c *alist*)
;=> (C . 2) 


*alist*
;=> ((A . 0) (C . 2) (B . 1) (D . 3) (E . 4) (F . 5)) 


(bssq 'c *alist*)
;=> (C . 2) 


*alist*
;=> ((C . 2) (A . 0) (B . 1) (D . 3) (E . 4) (F . 5)) 

どうやら一つ手前に持って来るということみたいです。
MacLISPで書くと

(defun bssq (item alist)
  (cond ((null alist) nil)
        ((and (pairp alist)
              (pairp (car alist))
              (eq item (caar alist)))
         (car alist))
        (T (prog ()
                 (map #'(lambda (p a)
                          (cond ((eq item (caar a))
                                 (let ((ans (car a)))
                                   (rplaca a (car p))
                                   (rplaca p ans)
                                   (return ans)))))
                      alist
                      (cdr alist))))))

位の感じかなと思いますが、わざわざアセンブリで書くからには効率が良かったり何か面白いアイデアだったりするのでしょう。
さっぱりMIDASは読めませんが、何か面白いことが書いてたら是非教えて下さい!

まとめ

 今回は、bssqを紹介してみました。
ITSでのMacLISPはUNIXでいうCのようなものでシステム周りもMacLISPで書かれたりすることはあったようです。
MIDASが高機能な為、これで記述されていることがかなり多いのでUNIXでのC程には利用されていなかったようですが、OSはMacLISPからコントロールできた様子。

defstructの紹介

Posted 2014-08-10 02:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の222日目です。

defstructとはなにか

 defstructは、Dorai Sitaram氏作のCommon LispのdefstructをScheme用に実現したものを、Felix Winkelmann氏がChickenに移植しPeter Bex氏が改良したものです。
元は、

パッケージ情報

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

インストール方法

$ sudo chicken-install defstruct

すれば、

(use defstruct)

(require-extension defstruct)

試してみる

Common Lisp互換ということですが、Common Lispのように使い方が分からない程のオプションはなく、判定用述語、アクセサ、セッタ、alistとの相互変換の関数が定義時にまとめて作られます。

(defstruct tree height girth age leaf-shape leaf-color)
(list tree?
      tree-height
      tree-girth
      tree-age
      tree-leaf-shape
      tree-leaf-color
      update-tree
      set-tree!
      tree->alist
      alist->tree)
;=> (#<procedure (tree? x)> #<procedure (tree-height x)> #<procedure (tree-girth x)> #<procedure (tree-age x)> #<procedure (tree-leaf-shape x)> #<procedure (tree-leaf-color x)>)

 Common Lispだとセッタはsetfで定義されるところと、copy-がないところ、alistに変換する関数があるところが違っています。

 set-foo!とupdate-fooがありますが、updateの末尾に「!」がないことから分かるようにupdateの方は破壊的変更はせず、新しく値をアップデートして作り直したものを返します。と書いていて気付きましたが、新しい値を何も指定しなければコピー関数になりますね。

(let* ((a '((height . 1000) (girth . 100) (age . 60) (leaf-shape . acicular:) (leaf-color . green:)))
       (t1 (alist->tree a))
       (t2 (update-tree t1)))
  (set-tree! t2 age: 100)
  (equal? (tree->alist t1)
          (tree->alist t2)))
;=> #f

まとめ

 今回は、defstructを紹介してみました。
ChickenでDrai Sitaram氏の「Teach Yourself Scheme in Fixnum Days」を実習するのに丁度良いかなと思いましたが、生成されるアクセサの形式が微妙に違ってました。
まあ、「-」と「.」だけの違いではありますが。

Older entries (1748 remaining)