letter: 2008/01

2008/01/30

2008/01/28

Factor 日本語入力の調査 -- 動いた！？

昨日、挫折した件ですが、LC_CTYPE "" setlocale を LC_ALL "" setlocale にしたら動きました。
詳細はまだ調査が必要ですが、これで一応 Factor の UI で日本語入力できるようになりました。
また後でまとめます。
ありがとうございました。

2008/01/27

Linux 環境の Factor の UI で日本語入力ができないものか調査しました。
結果、何故かしらできません。
とりあえずの、調査報告です。

まず、Factor のソースを眺めてみると XOpenIM 等はやってあるようです。
さらに調べると setlocale, XSupportsLocale, XSetLocaleModifiers を呼び出していないことが分かりました。

次のようなコードを xlib.factor に追加し、同じく xlib.factor にある initialize-x の最初で追加した init-locale を呼びだすようにしてみました。

: LC_ALL      0 ; inline
: LC_COLLATE  1 ; inline
: LC_CTYPE    2 ; inline
: LC_MONETARY 3 ; inline
: LC_NUMERIC  4 ; inline
: LC_TIME     5 ; inline
FUNCTION: char* setlocale ( int category, char* name ) ;
FUNCTION: Bool XSupportsLocale ( ) ;
FUNCTION: char* XSetLocaleModifiers ( char* modifier_list ) ;
: init-locale ( -- )
    USE: prettyprint
    LC_CTYPE "" setlocale [ "setlocale() failed" throw ] unless* .
    XSupportsLocale [ "XSupportsLocale() failed" throw ] unless* .
    "" XSetLocaleModifiers [ "XSetLocaleModifiers() failed" throw ] unless* . ;

しかし、XOpenIM で NULL が返ってくるようになりました。

次に C と Factor でそれぞれ最低限のコードでどうなるか調べてみました。
次のようなコードですが、C の方は XOpenIM が成功しますが、Factor の方はだめです。何故？
Factor のコード(実行は factor -script min.factor)

USING: kernel alien alien.c-types alien.syntax
       prettyprint compiler sequences ;

LIBRARY: xlib

: LC_CTYPE 2 ; inline
FUNCTION: char* setlocale ( int category, char* name ) ;
FUNCTION: Bool XSupportsLocale ( ) ;
FUNCTION: char* XSetLocaleModifiers ( char* modifier_list ) ;
FUNCTION: Display* XOpenDisplay ( void* display_name ) ;
FUNCTION: XIM XOpenIM ( Display* dpy, void* rdb, char* res_name, char* res_class ) ;
{ setlocale XSupportsLocale XSetLocaleModifiers XOpenDisplay XOpenIM }
[ compile ] each

LC_CTYPE "" setlocale [ "setlocale() failed" throw ] unless* .
XSupportsLocale [ "XSupportsLocale() failed" throw ] unless* .
"" XSetLocaleModifiers [ "XSetLocaleModifiers() failed" throw ] unless* .
f XOpenDisplay [ "XOpenDisplay() failed" throw ] unless* dup .
f f f XOpenIM .

C のコード

#include <X11/Xlib.h>
#include <X11/Xlocale.h>
#include <stdio.h>

int main( int argc, char** argv )
{
    Display* dpy;
    XIM im;
    char* p;
    p = setlocale( LC_CTYPE, "" );
    if ( p == NULL ) {
        printf( "setlocale() failed\n" );
        return -1;
    }
    printf("setlocale: %s\n", p);

    if ( ! XSupportsLocale() ) {
        printf( "XSupportsLocale() failed\n" );
        return -1;
    }

    p = XSetLocaleModifiers( "" );
    if ( p == NULL ) {
        printf( "XSetLocaleModifiers() failed\n" );
        return -1;
    }
    printf("XSetLocaleModifiers: %s\n", p);


    dpy = XOpenDisplay( NULL );
    if (dpy == NULL) {
        printf("XOpenDisplay() failed\n");
    }
    printf("XOpenDisplay: %p\n", dpy);

    if ( ( im = XOpenIM( dpy, NULL, NULL, NULL ) ) == NULL ) {
        printf( "XOpenIM failed\n" );
        return -1;
    }
    printf("XOpenIM: %p\n", im);


    return 0;
}

インプットメソッドに uim を使っていましたが、試しに SCIM をインストールして試してみました。
すると、Factor でも XOpenIM が成功するではありませんか。
しかし、喜んだのもつかのま、SCIM が「英語/ヨーロッパ言語」になったまま「SKK」に切り替えられません。
それなら、と SCIM の設定で SKK のみ有効にしてみたら、また XOpenIM が NULL を返すようになってしまいました。

ここで力つきました。何が悪いんでしょう？
もし分かる方がいらっしゃるなら教えてください。お願いします。

2008/01/26

Factor : UI の日本語フォントその2

Linux でもとりあえずフォントファイルを置き換える方向で試してみました。
sazanami, kochi, mona はだめだったけど vlgothic だと日本語が表示されました。
ただし、IME がオンにならず日本語を入力することができません。
IME を有効にするにはどうすればいいのでしょう？
とりあえず、こんなふうにフォントファイルを置き換えました。

MONO=/usr/share/fonts/truetype/vlgothic/VL-Gothic-Regular.ttf
PRO=/usr/share/fonts/truetype/vlgothic/VL-PGothic-Regular.ttf

all :
        ln -fs $(PRO) Vera.ttf
        ln -fs $(PRO) VeraBI.ttf
        ln -fs $(PRO) VeraBd.ttf
        ln -fs $(PRO) VeraIt.ttf
        ln -fs $(MONO) VeraMoBI.ttf
        ln -fs $(MONO) VeraMoBd.ttf
        ln -fs $(MONO) VeraMoIt.ttf
        ln -fs $(MONO) VeraMono.ttf
        ln -fs $(PRO) VeraSe.ttf
        ln -fs $(PRO) VeraSeBd.ttf
        ls -l

2008/01/25

Factor : UI の日本語フォント

Factor は UI(GUI) が最初からついているのですが、日本語フォントが出ません。
./fonts/ ディレクトリの下にあるフォント(Vera.ttf)などが日本語フォントを含んでいないためではないかと思い、ちょっと試してみました。
結論は HGRSMP.TTF を Vera.ttf 等に上書きしたら日本語も表示できました。Windows 環境でした試していませんが。
IPA フォントもいけるかなと思いためしてみましたが、これは英文フォントもまともに表示されませんでした。
P" resource:extra/ui/freetype/freetype.factor" を追求していけば、もっとまともな対応ができるかと思います。たぶんイメージの再作成も必要になるかな。
とりあえず、日本語が表示されるようになったので、"あいう" を revere して "ういあ" になり length が3になるのを確認しました。
時間があるときに Linux でもちょっと調べてみましょう。

2008/01/23

Factor : Web アプリケーション

Writing Web Applications in Factor を参考に Factor で Web アプリを書いてみました。とりあえずは Hello World レベルですが。

まず、Web サーバ自体は httpd ワードで起動します。USE: http.server 8883 httpd で 8883 番ポートで Web サーバが動きます。
単に httpd だとリスナに戻ってこないので、[ 8883 httpd ] in-thread として別プロセスで起動します。

Factor の Web フレームワークは Furnace というのがあるようです。
extra/webapps の下に pastebin や [ planet-factor ] のソースがあります。

Furnace で注意しなければならないのが、URL、ボキャブラリ名、Web アプリケーション名の関係です。
URL は http://localhost:8883/responder/Webアプリケーション名/アクション名という形式になります。
ボキャブラリ名は webapps.ボキャブラリ名というように webapps の下の階層にしなければなりません（ソースファイルの場所は関係ありません）。
Web アプリケーション名は web-app ワードでデフォルトアクション名、テンプレートパス名と一緒に指定します。

http://localhost:8883/responder/hello-furnace/
IN: webapps.hello-furnace
"hello-furnace" "hello" "." web-app

それともう一つテンプレートパスも注意が必要です。
デフォルトでは Furnace の内部で resource-path が使われているので、Factor のソースコードロケーションからの相対パスになってしまいます。
アクションワードの中で resource-path を実際のテンプレートファイルがあるパスに設定しなおす必要があります（もっといい方法があるかもしれませんが）。
Factor の変数はダイナミックスコープです。そのためアクションの外で resource-path を設定すると、その設定がグローバルに影響をおよぼして、他のものが動かなくなってしいます。
Common Lisp っぽいですね。

アクションの定義はふつうにワードを定義した後、そのワードシンボルで define-action するだけです。
ほんのさわりだけですが Factor らしくシンプルで好きです。
hello-furnace.factor

USING: io furnace http.server.responders html
    http.server io.files threads namespaces ;

! Furnace は webapps 以下のボキャブラリでなければならない。
! hello の部分は web-app で指定する name と一致しなければらなない。
IN: webapps.hello-furnace

[ 8883 httpd ] in-thread

! テンプレートファイルのあるパスを resource-path に設定する。
: res-path ( -- )
    home "letter/factor/try/webapp" path+ \ resource-path set ;

! text/plain でレスポンスするアクション
: text ( -- )
    serving-text "Text action." print ;

! これでアクションを定義
\ text { } define-action

! テンプレートファイルを読み取って text/html でレスポンスするアクション
: hello ( -- )
    res-path                    ! resource-path を設定する
    serving-html
    [ "hello-furnace" render-template ] ! hello-furnace.furnace という
    with-html-stream ;                  ! テンプレートファイルでレスポンスする。

! これでアクションを定義
\ hello { } define-action


! Web アプリケーション名, デフォルトアクション, テンプレートファイルの
! あるパス を指定して responder を作成する。
"hello-furnace" "hello" "." web-app

hello-furnace.furnace

<% USING: furnace namespaces io ; %>
<html>
  <head>
    <title>Hello Furnace</title>
  </head>

  <body>
    <h1>Hello Furnace</h1>

    <% "Factor で遊ぼう♪" write %>

    <hr>
    <a href="text">Text アクション</a>
  </body>
</html>

雪が降りました

嬉しい。

2008/01/20

Factor : C ライブラリインターフェイス(FFI)で鬼車を使ってみる

Factor の FFI がよくできているらしい（The fun factor in programming）ので、練習として鬼車を Factor の FFI で使ってみました。

まずは前準備ですが ~/.factor-rc でボキャブラリのパスを追加します。
今回の鬼車ボキャブラリは ~/letter/factor/lib/oniguruma 以下に作成します。

! -*- mode: factor ; -*-
USING: io.files vocabs.loader namespaces sequences
;

! Emacs を使う
USE: editors.emacs

! ~/letter/factor/lib を vocab-roots に追加する。
home "letter/factor/lib" path+
vocab-roots get push-new

libonig.so のインターフェイスを定義していきます。
add-library でシェアードライブラリを読み込みます。
TYPEDEF: で C の型と Factor の型を対応付けます。
定数定義は通常のワード定義(: ;)を inline で。
構造体は C-STRUCT:
で、おもしろいのが LIBRARY: に続く FUNCTION: です。
ほとんど C の関数定義のまま書くことができます。
./libonig/lobonig.factor

USING: alien alien.syntax alien.c-types
;

IN: oniguruma.libonig

: load-oniguruma-library ( -- )
    "oniguruma" "libonig.so" "cdetl" add-library ; parsing

load-oniguruma-library

TYPEDEF: void* regex_t*
TYPEDEF: void** regex_t**
TYPEDEF: uchar* UChar*
TYPEDEF: uchar* OnigUChar*
TYPEDEF: uint OnigOptionType
TYPEDEF: void* OnigEncoding
TYPEDEF: void* OnigSyntaxType*
TYPEDEF: void* OnigRegion*

! regex_t state
: ONIG_STATE_NORMAL                  0 ; inline
: ONIG_STATE_SEARCHING               1 ; inline
: ONIG_STATE_COMPILING              -1 ; inline
: ONIG_STATE_MODIFY                 -2 ; inline

! options
: ONIG_OPTION_NONE                   0 ; inline
: ONIG_OPTION_IGNORECASE             1 ; inline
: ONIG_OPTION_EXTEND                 2 ; inline
: ONIG_OPTION_MULTILINE              4 ; inline
: ONIG_OPTION_SINGLELINE             8 ; inline
: ONIG_OPTION_FIND_LONGEST          16 ; inline
: ONIG_OPTION_FIND_NOT_EMPTY        32 ; inline
: ONIG_OPTION_NEGATE_SINGLELINE     64 ; inline
: ONIG_OPTION_DONT_CAPTURE_GROUP   128 ; inline
: ONIG_OPTION_CAPTURE_GROUP        256 ; inline
! options (search time)
: ONIG_OPTION_NOTBOL               512 ; inline
: ONIG_OPTION_NOTEOL              1024 ; inline
: ONIG_OPTION_POSIX_REGION        2048 ; inline
: ONIG_OPTION_MAXBIT              4096 ; inline
! defualt option
: ONIG_OPTION_DEFAULT ONIG_OPTION_NONE ; inline

! normal return
: ONIG_NORMAL                        0 ; inline
: ONIG_MISMATCH                     -1 ; inline
: ONIG_NO_SUPPORT_CONFIG            -2 ; inline

C-STRUCT: OnigCaptureTreeNode
  { "int" "group" }
  { "int" "beg" }
  { "int" "end" }
  { "int" "allocated" }
  { "int" "num_childs" }
  { "OnigCaptureTreeNode**" "childs" } ;


C-STRUCT: OnigRegion
  { "int" "allocated" }
  { "int" "num_regs" }
  { "int*" "beg" }
  { "int*" "end" }
  { "OnigCaptureTreeNode*" "history_root" } ;

C-STRUCT: OnigErrorInfo
    { "OnigEncoding" "enc" }
    { "OnigUChar*" "par" }
    { "OnigUChar*" "par_end" } ;

: onig-sym ( name -- alien )
  "oniguruma" load-library dlsym ; inline

: ONIG_ENCODING_ASCII "OnigEncodingASCII" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_1 "OnigEncodingISO_8859_1" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_2 "OnigEncodingISO_8859_2" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_3 "OnigEncodingISO_8859_3" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_4 "OnigEncodingISO_8859_4" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_5 "OnigEncodingISO_8859_5" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_6 "OnigEncodingISO_8859_6" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_7 "OnigEncodingISO_8859_7" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_8 "OnigEncodingISO_8859_8" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_9 "OnigEncodingISO_8859_9" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_10 "OnigEncodingISO_8859_10" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_11 "OnigEncodingISO_8859_11" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_13 "OnigEncodingISO_8859_13" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_14 "OnigEncodingISO_8859_14" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_15 "OnigEncodingISO_8859_15" onig-sym ; inline
: ONIG_ENCODING_ISO_8859_16 "OnigEncodingISO_8859_16" onig-sym ; inline
: ONIG_ENCODING_UTF8 "OnigEncodingUTF8" onig-sym ; inline
: ONIG_ENCODING_UTF16_BE "OnigEncodingUTF16_BE" onig-sym ; inline
: ONIG_ENCODING_UTF16_LE "OnigEncodingUTF16_LE" onig-sym ; inline
: ONIG_ENCODING_UTF32_BE "OnigEncodingUTF32_BE" onig-sym ; inline
: ONIG_ENCODING_UTF32_LE "OnigEncodingUTF32_LE" onig-sym ; inline
: ONIG_ENCODING_EUC_JP "OnigEncodingEUC_JP" onig-sym ; inline
: ONIG_ENCODING_EUC_TW "OnigEncodingEUC_TW" onig-sym ; inline
: ONIG_ENCODING_EUC_KR "OnigEncodingEUC_KR" onig-sym ; inline
: ONIG_ENCODING_EUC_CN "OnigEncodingEUC_CN" onig-sym ; inline
: ONIG_ENCODING_SJIS "OnigEncodingSJIS" onig-sym ; inline
: ONIG_ENCODING_KOI8 "OnigEncodingKOI8" onig-sym ; inline
: ONIG_ENCODING_KOI8_R "OnigEncodingKOI8_R" onig-sym ; inline
: ONIG_ENCODING_CP1251 "OnigEncodingCP1251" onig-sym ; inline
: ONIG_ENCODING_BIG5 "OnigEncodingBIG5" onig-sym ; inline
: ONIG_ENCODING_GB18030 "OnigEncodingGB18030" onig-sym ; inline


: ONIG_SYNTAX_ASIS "OnigSyntaxASIS" onig-sym ; inline
: ONIG_SYNTAX_POSIX_BASIC "OnigSyntaxPosixBasic" onig-sym ; inline
: ONIG_SYNTAX_POSIX_EXTENDED "OnigSyntaxPosixExtended" onig-sym ; inline
: ONIG_SYNTAX_EMACS "OnigSyntaxEmacs" onig-sym ; inline
: ONIG_SYNTAX_GREP "OnigSyntaxGrep" onig-sym ; inline
: ONIG_SYNTAX_GNU_REGEX "OnigSyntaxGnuRegex" onig-sym ; inline
: ONIG_SYNTAX_JAVA "OnigSyntaxJava" onig-sym ; inline
: ONIG_SYNTAX_PERL "OnigSyntaxPerl" onig-sym ; inline
: ONIG_SYNTAX_PERL_NG "OnigSyntaxPerl_NG" onig-sym ; inline
: ONIG_SYNTAX_RUBY "OnigSyntaxRuby" onig-sym ; inline
: ONIG_SYNTAX_DEFAULT "OnigDefaultSyntax" onig-sym 0 alien-cell ; inline



LIBRARY: oniguruma

FUNCTION: int onig_new ( regex_t** reg, UChar* pattern, UChar* pattern_end, OnigOptionType option, OnigEncoding enc, OnigSyntaxType* syntax, OnigErrorInfo* err_info ) ;

FUNCTION: OnigRegion* onig_region_new (  ) ;

FUNCTION: int onig_search ( regex_t** reg, UChar* str, UChar* end, UChar* start, UChar* range, OnigRegion* region, OnigOptionType option ) ;

FUNCTION: void onig_region_free ( OnigRegion* region, int free_self ) ;

FUNCTION: void onig_free ( regex_t* reg ) ;

FUNCTION: int onig_end (  ) ;

次に libonig.factor で定義したワードを使って Factor から使いやすいワードを定義します。
./oniguruma.factor

USING: kernel io math sequences continuations prettyprint syntax
       libc destructors
       alien alien.c-types
       oniguruma.libonig
;
IN: oniguruma

<PRIVATE

: string>uchar* ( string -- uchar* )
  malloc-char-string
  dup free-always
  ;

: (str-end-uchar*) ( uchar* length -- uchar* uchar* )
  over alien-address + <alien> ;

: str-end-uchar* ( str -- uchar* uchar* )
  dup string>uchar*
  swap length
  (str-end-uchar*) ;

: check-ret ( num -- )
  ONIG_STATE_NORMAL = [ "エラーです。" throw ] unless ;

: onig-new ( str -- reg )
  [ "regex_t**" <c-object> dup
    rot str-end-uchar*
    ONIG_OPTION_DEFAULT
    ONIG_ENCODING_ASCII
    ONIG_SYNTAX_DEFAULT
    "OnigErrorInfo" <c-object>
    onig_new
    check-ret
    0 alien-cell ] with-destructors ;

: (onig-region>str) ( index region -- number )
    swap 4 * alien-signed-4 ;

: (onig-region-beg>str) ( region index -- number )
    swap OnigRegion-beg (onig-region>str) ;

: (onig-region-end>str) ( region index -- number )
    swap OnigRegion-end (onig-region>str) ;

: onig-region>str ( index string region -- substr )
    rot
    2dup
    (onig-region-beg>str)
    -rot
    (onig-region-end>str)
    rot subseq ;

: onig-region>str-seq ( string region -- seq )
    dup OnigRegion-num_regs -rot
    [ onig-region>str ] 2curry map
    ;

: onig-search ( reg str -- f/seq )
  [ dup >r str-end-uchar* 2dup
    onig_region_new dup >r
    ONIG_OPTION_NONE
    onig_search
    r> r> rot
    ONIG_NORMAL >=
      [ over onig-region>str-seq ]
      [ drop f ] if
    swap 1 onig_region_free
  ] with-destructors ;

PRIVATE>

: onig ( reg str -- num )
    >r onig-new dup r>
    onig-search
    swap
    onig_free ;

最後にテストも書いておきます。ファイル名はテスト対象のボキャブラリ名 + -tests.factor にします。
./oniguruma-tests.factor

USING: oniguruma
       tools.test ;
IN: temporary

[ { "affffffffb" "ffffffff" } ]
[ "a(.*)b|[e-f]+" "zzzzaffffffffb" onig ] unit-test

[ f ] [ "x" "a" onig ] unit-test

[ { "abcde" "b" "d" } ]
[ "a(.)c(.)e" "abeeeabcdea" onig ] unit-test

これでリスナから USE: oniguruma "oniguruma" test でテストが実行されます。

FUNCTION: で C の関数定義にとても近いイメージで書けるのはいいですね。
S-STRUCT: では Common Lisp の defstruct みたいにアクセス関数が自動的に作成されるのも便利です。
しかし、スタック操作にはまだ慣れません ;-)

2008/01/17

私は新しいおもちゃを手にいれたこども

新しい言語をいじりだした私って、新しいおもちゃを手にいれたこどもと同じだ。
楽しくってしょうがない♪

2008/01/16

Factor : 「: a "Hello" : b "World!" print ; print ; a b」

やっぱりこういう word 定義のネストもできるのですね。
; がくるまでは単にスタックに積んでいるだけなので、できて当たり前といえばそうなのですが、
concatenative programming language って感じ。

( scratchpad ) : a "Hello" : b "World!" print ; print ; a b
Hello
World!

Factor : FTP でファイルをアップロードする

以前やった、Common Lisp FTP でファイルをアップロードするを Factor でやってみました。
FTP のモジュールはなさそうだったので、ソケットモジュールを使って実装しました。
ftp-put のあたりぐちゃぐちゃですがなんとか動きました。

#! /usr/bin/env factor

USING: arrays assocs kernel math math.parser namespaces sequences
io io.sockets io.streams.string io.streams.lines io.files strings splitting
continuations system
prettyprint
;
IN: ftp.client


: ftp-check-res* ( line-stream code -- line-stream line )
    over stream-readln
    dup print                   ! for debug
    swap over
    start 0 = [ "error" throw ] unless ;

: ftp-check-res ( line-stream code -- line-stream )
    ftp-check-res*
    drop ;

: ftp-crlf ( line-stream -- line-stream )
    dup "\r\n" swap stream-write
    dup stream-flush ;

: ftp-snd0 ( line-stream cmd -- line-stream )
    over stream-write
    ftp-crlf ;

: ftp-snd1 ( line-stream arg1 cmd -- line-stream )
    pick stream-write
    over stream-write
    ftp-crlf ;

: ftp-connect ( host -- stream )
    21 <inet> <client> <line-reader>
    "220" ftp-check-res ;

: ftp-user ( line-stream user -- line-stream )
    "USER " ftp-snd1
    "331" ftp-check-res ;

: ftp-pass ( line-stream pass -- line-stream )
    "PASS " ftp-snd1
    "230" ftp-check-res ;

: ftp-quit ( line-stream -- line-stream )
    "QUIT" ftp-snd0
    "221" ftp-check-res
    stream-close ;

: ftp-cwd ( line-stream dir -- line-stream )
    "CWD " ftp-snd1
    "250" ftp-check-res ;

: ftp-type ( line-stream type -- line-stream )
    "TYPE " ftp-snd1
    "200" ftp-check-res ;

: ftp-ascii ( line-stream -- line-stream )
    "A" ftp-type ;

: ftp-binary ( line-stream -- line-stream )
    "I" ftp-type ;

: ftp-pasv-parse ( str -- ip port )
    "()," split
    dup 5 swap nth 10 string>integer
    256 *
    over 6 swap nth 10 string>integer
    +
    swap 1 5 rot subseq
    "." join
    swap
    ;

: ftp-pasv ( line-stream -- line-stream inet )
    "PASV" ftp-snd0
    "227" ftp-check-res*
    ftp-pasv-parse
    <inet>
    ;

: ftp-stor ( line-stream file -- line-stream )
    "STOR " ftp-snd1 ;

: ftp-put ( line-stream file -- line-stream )
    swap ftp-pasv               ! file line-stream inet
    -rot over ftp-stor          ! inet file line-stream
    swap <file-reader>          ! inet line-stream file-reader
    rot <client>                ! line-stream file-reader client
    rot "150" ftp-check-res -rot ! line-stream file-reader client
    stream-copy                 ! line-stream
    "226" ftp-check-res         ! line-stream
    ;


cwd cd
"ftp.example.com" ftp-connect
"user" ftp-user
"password" ftp-pass
ftp-binary
"/public_html/factor" ftp-cwd
"cookbook.html" ftp-put
"cookbook.css" ftp-put
ftp-quit

0 exit

あとシェルから起動するために次ようなファイルを factor というファイル名でパスのとおったところに置いておきます。

#!/bin/sh

~/letter/factor/factor/factor -i=$HOME/letter/factor/factor/factor.image $*

これで ./upload.factor でファイルのアップロードができました。

2008/01/14

Factor クエックブック

Factor クエックブックはじめました。

Common Lisp : cl-win32ole 結局は

cl-win32ole で Ruby がメソッドミッシングで実現していることを、どう実装しようと悩んでいました。
よくよく考えると、そんなことより ie.document.all.Item("q").value = "aaa" 相当が簡単にできればいい、と思い関数を2つほど実装しました。
これで (setf (ole ie :document :all :item "q" :value) "aaa") と書けるようになりました。

(let ((ie (create-object "InternetExplorer.Application")))
  (setf (ole ie :visible) t)
  (ole ie :navigate "http://www.google.co.jp/")
  (loop while (ole ie :busy) do (sleep 0.5))
  (setf (ole ie :document :all :item "q" :value) "Common Lisp")
  (ole ie :document :all :item "btnG" :click)
  (sleep 3)
  (ole ie :quit))

2008/01/13

www.yahoo.co.jp の charset が utf-8 になっている

(drakma:http-request "http://www.yahoo.co.jp") していま気づいた。

Factor だと
USING: http.client ; "http://www.yahoo.co.jp" http-get write

2008/01/12

今年の言語 : Factor

FAQ によると Factor は関数型で、動的型付けで、オブジェクト指向で、スタックベースのプログラミング言語であり、Forth と Lisp を組合せたような言語だそうです。
設計者は Slava Pestov さん。
UI 系や Web 系のライブラリも充実しているようです。

公式サイト : Factor programming language
http://factorcode.org/

planet-factor
http://planet.factorcode.org/

まずはセットアップから

ダウンロードは http://factorcode.org/download.fhtml から。
Windows と Mac OS X はバイナリがあります。
Linux はソースからビルドする必要があります。

ソース Factor-0.91.tar.gz とブートイメージ boot.x86.64.image をダウンロードします。
tar zxvf Factor-0.91.tar.gz
cd factor
make linux-x86-64
cp ../boot.x86.64.image .
./factor -i=boot.x86.64.image

しばらく待つと factor.image ができあがります。
このあたり Lisp っぽいですね。

いじってみる

./factor でいきなり GUI が起動します。
Windows でも factor-nt.exe をダブルクリックすると同じ GUI が起動します。
ただし、パス名に日本語含まれていると起動できないので注意してください。

Output のパネルに「Factor cookbook」から始めるようにとあるのでそれをクリックします。

「.s」でスタックの中身を表示する。
「.」でスタックの一番上のオブジェクトを表示する。
vacabularies のロードには「require」を使う。
「Vocabulary index」を見てみること（一覧が表示された。たくさんある）。
「"tetris" run」でテトリスが動く（うん、動いた）。
ソースファイルのロードには「run-file」を使う。
この UI の使い方は「UI development tools」を見る。
あとはクックブックのリストです。

次は Input のパネルに入力してみましょう。
! 以降はコメントです。入力しないでくださいね。
1 2 3 ! これで 1 2 3 がスタックにつまれます。
.s ! スタックの内容 1 2 3 が表示されます。でもスタックから取り除かれはしません。
. ! スタックの一番上にある 3 が表示されます。3 はスタックからなくなります。
.s ! スタックの内容 1 2 が表示されます。
1 2 + . ! 足し算。1 と 2 がスタックにつまれ + がスタックから 1 と 2 を取り出して 3 をスタックに詰む。. で 3 をスタックから取り出す。

数値や文字列などのリテラルは入力するとスタックにつまれます。
Read Eval Print に慣れ親しんだ身としては不思議な感じです。
word と言われるのは、他の言語で言うところの関数に相当するものです。
となると vocabulary はモジュールですね。

なじみのある quatation というのもあります。
quatation は [ と ] で囲みます。
Lisp と同じで評価されることはありません。評価されずにスタックにつまれます。
call でスタックから取り出されて評価されます。
[ 1 2 + . ]
call ! 3 が表示される。

quatation があれば if が可能となる。
ということで if は次のようになります。
1 2 = [ "then!" ] [ "else!" ] if . ! "else!" が返る。

word の定義は : で始まり ; で終ります。
Hello World を作ってみますかね。
: hello-world "Hello World!" print ;
hello-world ! "Hello World!" と表示される。

fib を定義してみると次のようになります。もっとエレガントな方法があるかもしれませんが。

: fib
  dup 3 <
  [ drop 1 ]
  [ dup 1 - fib swap 2 - fib + ]
  if ;

10 fib .                        ! 55 が返る。

あと UI の Input では TAB で word の補完が可能です。
Inspector もありソースコードにもすぐアクセスできるようになってます。
Lisp と同じ apropos word もありますね。

Emacs からの利用は ~/.emacs に次を追加します。

;;;;Factor
(add-path "~/letter/factor/factor/misc")
(setq factor-binary (expand-file-name "~/letter/factor/factor/factor")
      factor-image (expand-file-name "~/letter/factor/factor/factor.image"))
(autoload 'factor-mode "factor" "Factor mode" t)
(autoload 'run-factor "factor" "Start a Factor listener inside Emacs" t)
(add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))

ということで、なかなか面白い言語だと思います。
触っていて楽しいです。
基本がシンプルなところが好きです。
そして、去年の言語 Erlang にプロセスという新しい思考概念があったように、Factor にはスタックという新しい思考概念があります（新しいというのは私のとってのことですが）。
去年の言語は Erlang でしたが、今年の言語は Factor にしましょう。

Common Lisp : cl-win32ole を Google Code に登録

作りかけている cl-win32ole を Google Code に登録しました。
http://code.google.com/p/cl-win32ole/
最新ソースの取得は次のとおりです。
svn checkout http://cl-win32ole.googlecode.com/svn/trunk/ cl-win32ole-read-only

まだまだな感じですが、以下のコードくらいは動きます。
対象の処理系は SBCL です。
ちゃんとできあがってきたら common-lisp.net に登録したいな。

(defun ie-example ()
  (let ((ie (create-object "InternetExplorer.Application")))
    (with-slots (visible busy document) ie
      (setf visible t)
      (invoke ie :navigate "http://www.google.co.jp/")
      (loop while busy do (sleep 0.5))
      (with-slots (all) document
        (let ((q (invoke all :item "q")))
          (setf (slot-value q 'value) "Common Lisp"))
        (let ((btnG (invoke all :item "btnG")))
          (invoke btnG :click))))
    (sleep 3)
    (invoke ie :quit)))

2008/01/10

Common Lisp : funcallable-standard-class

Common Lisp の MOP の世界に funcallable-standard-class というものがあります。
その名のとおり関数として呼び出すことのできるオブジェクトを作るメタクラスです。
:metaclass で funcallable-standard-class を指定します。
set-funcallable-instance-function で実行する関数を指定します。
関数としての呼び出しは funcall と apply が使用可能ですが、(setf symbol-function) で任意のシンボルの関数にしてしまうこともできます。

(use-package :sb-mop)

(defclass adder ()
  ((n :initarg :n :initform 1))
  (:metaclass funcallable-standard-class))

(defmethod initialize-instance :after ((adder adder) &rest args)
  (declare (ignore args))
  (set-funcallable-instance-function
   adder
   #'(lambda (n)
       (+ n (slot-value adder 'n)))))

(defun add (n)
  n)

(defparameter adder (make-instance 'adder))

(setf (symbol-function 'add) adder)

(add 1)                                 ; => 2
(funcall adder 1)                       ; => 2
(setf (slot-value adder 'n) 10)
(add 1)                                 ; => 11
(apply adder (list 1))                  ; => 11

これを使えば（with-ole-object (ie "InternetExplorer.Application") (ie :visible t) (ie :navigate "http://...") なんてことができるかなと思ったのですが、(setf symbol-function) は影響がグローバルなので使うのがためらわれます。

2008/01/04

Lisp 生誕50周年

Happy New Year and Happy 50th Birthday to Lisp!
今年は Lisp が生まれて50年ですか。
私なんかまだまだ青二才ですね。精進しましょう。

Common Lisp : slot-missing と undefined-function

slot-missing は存在しないスロットにアクセスした場合に呼ばれるジェネリックファンクションで、error を投げるように定義されています。
これを使ってスロットがない場合の振舞いをプログラムできます。
1番目の引数がクラス。
2番目の引数がインスタンス（オブジェクト）。
3番目の引数がスロット名。
4番目の引数は参照の場合は slot-value、設定の場合は setf。
5番目の引数は setf の場合の設定値です。

次のコードでは、クラス a の slot-value は *value* の値を返し、クラス b の (setf slot-value) は *value* に値を設定しています。

(defvar *value* nil)

(defclass a ()
  ())

(defclass b (a)
  ())

(defmethod slot-missing ((class (eql (find-class 'a))) instance slot-name
                         (operation (eql 'slot-value)) &optional new-value)
  *value*)

(defmethod slot-missing ((class (eql (find-class 'b))) instance slot-name
                         (operation (eql 'setf)) &optional new-value)
  (setf *value* new-value))

(let ((a (make-instance 'a))
      (b (make-instance 'b)))
  (print *value*)                       ;nil
  (print (setf (slot-value b 'スロット名) "値いち")) ;"値いち"
  (print *value*)                       ;"値いち"
  (print (slot-value a 'なまえ))         ;"値いち"
  (print (ignore-errors (slot-value 'b 'なまえ))) ;nil
  (print (ignore-errors (setf (slot-value a 'スロット名) "値に")))) ;nil

さて、スロットがない場合はこれでいいのですが、関数がない場合はどうすればいいのでしょう？
関数がない場合は undefined-function コンディションが error 関数により通知されるようです（SBCLでは）。
この undefined-function を補足することはできるのですが、それが通知された場所からリスタートする方法が分かりませんでした。
restart-bind と handler-bind でなんとかなるかなぁ、と思って次のようなコードでごにょごにょしてみたのですがうまくいきません。
foo が定義されていない状態で "a", "b", "c" と print したいのです。
error ではなく ceeror で undefined-function を通知してくれないものでしょうか。

(restart-bind ((ole-dispatch
                #'(lambda (&optional x)
                    (p 'restart x)
                    (setf (symbol-function x) #'print)
                    (p (symbol-function x))
                    (symbol-function x))))
  (handler-bind ((undefined-function
                  #'(lambda (c)
                      (p 'handler c (cell-error-name c))
                      (invoke-restart 'ole-dispatch (cell-error-name c)))))
    (print "a")
    (foo "b")
    (print "c")))

うまくいけば OLE の invoke を隠蔽できるのにな。

登録: 投稿 (Atom)

2008/01/30

2008/01/28

2008/01/27

2008/01/26

2008/01/25

2008/01/23

2008/01/20

2008/01/17

2008/01/16

2008/01/14

2008/01/13

2008/01/12

2008/01/10

2008/01/04

link

自己紹介

ブログ アーカイブ

ラベル

フォロワー

grip css

gtag.js

ブログアーカイブ