Archive for 2012年3月|Monthly archive page
newLISP 組込関数の構文表示２．．．または、command-event を使って見る
コメントを残す 昨日の組込関数構文表示は如何でしょうか？
関数primitives と syntax を作ったのは、こちらのフォーラムの投稿を見たからです。
この問題は、以前から話題になっていて、すでに解決案が多数提案されてます。
とくに、こちらで紹介されている関数は、正規表現だけでエレガントに構文を取り出しています。
わざわざ作るまでもない？
そうとも言えますが、私が使うには、ちょっと足りない点があったからです。
一つは、関数primitives のように組込関数を表示する仕組みが無いこと。と言っても、探せば、あるかもしれません、、、（汗）
もう一つは、
> (syntax reverse) reverse ! syntax: (reverse list) syntax: (reverse string) > (syntax char) char utf8 syntax: (char str [int-index]) syntax: (char int)
こんな風に、破壊的関数や文字列単位操作の関数を表示をさせたかったこと。
それに、関数内容の一部も表示できるようにしたかったし、、、
まっ、正規表現の使い方が下手で、手続き処理的な関数を書いた結果とも言えますが（笑）。
ついで、マニュアルを日本語版にも簡単に変更できるようにしたのです、、、言い訳ですが。
さて、今回は、組込command-event を使って、インタラクティブ環境で使いやすくします。
内容は、組込関数を直接打ち込むと、構文を表示するというものです。
こんな感じ。
> push push ! utf8 syntax: (push exp list [int-index-1 [int-index-2 ... ]]) syntax: (push exp list [list-indexes]) syntax: (push str-1 str-2 [int-index]) >
どうでしょう。わざわざ関数syntax を呼び出す必要がありません。
さて、組込command-event を使う前に、syntax を少しばかり改良します。
(context 'MAIN:syntax)
(setq lst (MAIN:primitives)) ; 2012/4/3 added.
(define (set-manual (text (read-file (string (env "NEWLISPDIR" ) "/newlisp_manual.html"))))
(setq manual text))
(if-not manual (set-manual))
(define (set-flag flag)
(setq ex-flag flag))
(set-flag nil)
(define (syntax:syntax func (flag ex-flag) (html manual))
(if (primitive? func)
(letn (tmp ((parse (string func) "@") 0)
fname (or (lookup tmp
'(("-" "+") ("*" "+") ("/" "+") ("%" "+")
("<" "<") (">" "<") ("=" "<") ("<=" "<") (">=" "<") ("!=" "<")
(">>" "<<") ("<<" "<<")
("&" "&")))
tmp)
pre (find (string {} fname) html)
post (find (if flag "</p>" "</h4>") html 1 pre)
res (replace {<[^>]+>} (pre (- post pre) html) "" 1))
(replace "<" res "<")
(replace ">" res ">")
(replace "&" res "&")
(replace "—" res "-")
(replace " " res " ")
(println res) "")
"not primitive"
))
(context MAIN)
変更内容は、関数内容表示用flag の設定関数を用意したのと、関数syntax の出力から silent を外して、戻り値を "" に変更したことです。これならコマンドラインに出てきても、悪さをしませんからね。（2012/4/3 syntax:lst を追加。関数primitives はこちらあります。）
組込command-event の設定はこうなります。
(command-event
(fn (s)
(let (x (replace {\n|\r} s "" 0))
(if (find (sym x) syntax:lst)
(syntax (eval-string x))))))
（2012/4/3 判定方法と評価時期を変更。）
こうすれば、先ほどの例のように
> char char utf8 syntax: (char str [int-index]) syntax: (char int) > (syntax:set-flag true) true > char char utf8 syntax: (char str [int-index]) syntax: (char int) Given a string argument, extracts the character at int-index from str, returning either the ASCII value of that character or the Unicode value on UTF-8 enabled versions of newLISP. If int-index is omitted, 0 (zero) is assumed. The empty string returns nil. Both (char 0) and (char nil) will return "00". > (char 65) "A" >
こんな感じ。
以上、如何でしょうか？
newLISP 組込関数の構文を表示してみる．．．または、簡易マニュアル？
昨日の primitives で組込関数名が判ったら、次は構文を知りたくなるもの（笑）。
ということで、マニュアルから構文を抜き出す関数を作ってみました。
(context 'MAIN:syntax)
(if-not manual (setq manual (read-file (string (env "NEWLISPDIR" ) "/newlisp_manual.html"))))
(define (syntax:syntax func (html manual))
(if (primitive? func)
(letn (fname ((parse (string func) "@") 0)
pre (find (string {} fname) html)
post (find "</h4>" html 1 pre)
;post (find "</p>" html 1 pre)
res (replace {<[^>]+>} (pre (- post pre) html) "" 1))
(replace " " res " ")
(silent (print res)))
"not primitive"
))
(context MAIN)
マニュアルは newLISP のインストール・ディレクトリにあるものを参照しています。
使い方は、こんな感じ。
> (syntax find-all) find-all syntax: (find-all str-regex-pattern str-text [exp [int-regex-option]]) syntax: (find-all list-match-pattern list-lists [exp]) syntax: (find-all exp-key list exp func-compare)
関数名がわからない場合は、昨日の primitives をどうぞ（笑）。
また、silent を使って戻り値（文字列）表示を抑制していますので、表示後 return キー入力が必要です。
たいていは、これで十分ですが、
> (syntax >) ERR: value expected in function find : pre called from user defined function syntax >
あらら、、、特殊文字は苦手のようです。
何故？
> (syntax &) <, >, =, <=, >=, != syntax: (< exp-1 exp-2 [exp-3 ... ]) syntax: (> exp-1 exp-2 [exp-3 ... ]) syntax: (= exp-1 exp-2 [exp-3 ... ]) syntax: (<= exp-1 exp-2 [exp-3 ... ]) syntax: (>= exp-1 exp-2 [exp-3 ... ]) syntax: (!= exp-1 exp-2 [exp-3 ... ])
どうやら、HTML の特殊文字を考慮しなければならないようです。
その結果、完成形はこうなりました。
(context 'MAIN:syntax)
(define (set-manual (text (read-file (string (env "NEWLISPDIR" ) "/newlisp_manual.html"))))
(setq manual text))
(if-not manual (set-manual))
(define (syntax:syntax func flag (html manual))
(if (primitive? func)
(letn (tmp ((parse (string func) "@") 0)
fname (or (lookup tmp
'(("-" "+") ("*" "+") ("/" "+") ("%" "+")
("" "<") ("=" "<") ("=" "<") ("!=" "<")
(">>" "<<") ("<<" "<<")
("&" "&")))
tmp)
pre (find (string {} fname) html)
post (find (if flag "</p>" "</h4>") html 1 pre)
res (replace {<[^>]+>} (pre (- post pre) html) "" 1))
(replace "<" res "")
(replace "&" res "&")
(replace " " res " ")
(silent (print res)))
"not primitive"
))
(context MAIN)
これなら、
> (syntax &) & syntax: (& int-1 int-2 [int-3 ... ])
特殊記号を使った演算子も表示されます。
さて、オプションの flag は変数 post の検索文字 "</h4>" を "</p>" にします。
そうすることで、
> (syntax struct true) struct syntax: (struct symbol [str-data-type ... ]) The struct function can be used to define aggregate data types for usage with the extended syntax of import, pack and unpack. This allows importing functions which take C-language struct data types or pointers to these aggregate data types.
関数の内容の冒頭部分も表示されます。
参照マニュアルを
(syntax:set-manual (get-url "http://www.newlisp.org/newlisp_manual-jp.html"))
で日本語マニュアルに設定すれば、（要UTF-8版newLISP）
> (syntax struct true) struct syntax: (struct symbol [str-data-type ... ]) 関数 struct は、 import、pack、unpack の拡張構文で使用するためのデータ型の集合体を定義するのに使えます。 これは、C 言語の 構造体 データ型やデータ型の集合体のポインタを 取る関数の導入を可能にします。 The struct function can be used to define aggregate data types for usage with the extended syntax of import, pack and unpack. This allows importing functions which take C-language struct data types or pointers to these aggregate data types.
こんな感じに日本語の内容も出てきます。この場合、UTF-8版newLISP が必要です。お間違えなく。
これで、インタラクティブ環境の簡易マニュアル完成、、、なんてね（笑）。
以上、如何でしょうか？
newLISP の組込関数を表示してみる．．．または、find-all の filter 的使い方
newLISP の組込関数は 360個前後（OS によって若干違う）。
よく使う関数名は自然と打ち込めますが、たまにしか使わない関数だと打ち間違えたりします。
マニュアルを見れば良いのですが、関数名だけを知りたいならば、
> (filter (fn (x) (primitive? (eval x))) (symbols)) (! != $ % & * + ++ - -- / : < << >= >> NaN? ^ abs acos acosh add address amb ：（途中略） xml-type-tags zero? zerop | ~) >
として探すこともできます。
しかし、このままでは多すぎるので、更に絞り込む関数を作ってみました。
(define (primitives reg flag (predicate primitive?) (cnt MAIN))
(let (func (filter (letex (_p predicate) (fn (x) ('_p (eval x)))) (symbols cnt)))
(if-not reg
func
(let (pat (if flag reg (string "^" reg ".*")))
(map sym (find-all pat (map string func) $it (fn (x y) (regex x y 1))))))
))
使い方はこんな感じ、
> (primitives) (! != $ % & * + ++ - -- / : < << >= >> NaN? ^ abs acos acosh add address amb ：（途中略） xfer-event xml-error xml-parse xml-type-tags zero? zerop | ~) > (primitives "ap") (append append-file apply) >
引数に文字列を与えれば、その文字列から始まる組込関数を返します。
文字列には、正規表現も使えます。
> (primitives ".*file.*" true)
(append-file copy-file delete-file file-info file? read-file rename-file write-file)
> (primitives {.+\?$} true)
(NaN? array? atom? context? directory? empty? file? float? global? inf? integer?
lambda? legal? list? macro? nil? null? number? primitive? protected? quote? string?
symbol? true? zero?)
>
これで、おおかた絞り込めるでしょう（嬉）。
正規表現を使ったリストの絞り込みには、find-all と regex を組み合わせて、filter のように使っています。この使い方はマニュアルにある方法です。
関数primitives の中をを見れば分かる通り、primitive? も引数ですから、
> (primitives ".+" true lambda?) ($reader-event cadr car cdr consp evenp flat1 fourth gensym mapc maplist mappend module oddp primitives read-integer read-string remove second third) > (primitives ".+" true context?) (*gensym* Class MAIN Tree cnt decf defun hayashi incf include labels macro map-mv multi-let psetq reference-inversion rsetq type-of with-open-file) >
こんな風にも使えます。lambda? で $reader-event が出てきているのは、私の場合 macro.lsp を使っているからです。
> $reader-event
(lambda (macro:expr)
(if (list? macro:expr)
(dolist (macro:pattern macro:macro-list)
(if (match macro:pattern macro:expr)
(setf macro:expr (eval macro:expr))
(set-ref-all macro:pattern macro:expr (eval $it) match)))) macro:expr)
>
さて、もう一つのオプションはコンテキストの指定で、
> (symbols macro) (macro:body macro:callp macro:delete macro:expr macro:macro macro:macro-list macro:pattern macro:resume macro:rewrite macro:sname macro:suspend) > (primitives ".+" true lambda? macro) (macro:resume macro:rewrite macro:suspend) > (primitives ".+" true macro? macro) (macro:delete macro:macro) >
こんな感じ。
ここまでやると、primitives ではないような、、、（汗）
以上、如何でしょうか？
P.S.
ちなみ、symbols では fn、lambda、lambda-macro は出て来ません。
名無し（無名関数と無名マクロ）だからシンボルですら無い！
たぶん、、、
newLISP マニュアル・アップデート v.10.4.0 rev 2012-03-26
newLISP のマニュアルが変更され、現在、rev 2012-03-26 です。
主な変更は、sys-info の OSタイプが修正されました。実際にOSを調べる時は、ostype を使うでしょうから、実害無いですけどね。
newLISP マニュアル ＆ リファレンス の日本語訳、現在のバージョンは、v.10.4.0 です。
こちらから newlisp_manual-10400 をダウンロードして下さい。
目次も含め日本語併記にしてあります。
いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報下さい。
以上、如何でしょうか？
newLISP マニュアル・アップデート v.10.4.0 rev 2012-03-20
newLISP のマニュアルが変更され、現在、rev 2012-03-20 です。
主な変更は、エラーコードに拡張 FFI の項目が付け加わりました。
newLISP マニュアル ＆ リファレンス の日本語訳、現在のバージョンは、v.10.4.0 です。
こちらから newlisp_manual-10400 をダウンロードして下さい。
目次も含め日本語併記にしてあります。
いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報下さい。
以上、如何でしょうか？
newLISP の日付関数．．．または、local or UTC
newLISP の日付関数は、ローカル・タイム（local time）基準のものと、協定世界時 (UTC) 基準のものに分かれます。といっても、ローカル・タイム（local time）基準は date と time-of-date の二つだけで、残りの date-list、date-parse、date-value、now は協定世界時 (UTC) 基準です。
日付関数には time も入りますが、こちらはローカル・タイム（local time）も協定世界時 (UTC) も関係無いので、ちょっと外しておきます。
この通り、圧倒的に協定世界時 (UTC) 関数が多いのですが、覚えておかないと、ちょっとしたことで間違えます。だから、私は 日本用日付関数を定義して使っています。
といっても、だいぶ古い掲載で、newLISP の日付関数もかなり変更されているので、同じ機能を持つローカル・タイム（local time）日付関数を定義してみました。
(define local-date date)
(define (local-date-list (n (date-value)))
(let (lst (map (hayashi int 0 10) (parse (date n 0 "%Y %m %d %H %M %S %j %w") " ")))
(setf (lst -1) (if (= $it 0) 7 $it))
lst))
(if (> (sys-info -2) 10399)
(begin
(define (local-date-value y m d)
(if (for-all nil? (list y m d)) (date-value)
(- (apply date-value (flat (list y m d (args)))) (* 60 (now 0 -2)))))
(define (local-date-parse dateStr formatStr)
(- (date-parse dateStr formatStr) (* 60 (now 0 -2))))
(define (local-now (offset (now 0 -2)) index) (now offset index)))
(begin
(define (local-date-value y m d)
(if (for-all nil? (list y m d)) (date-value)
(+ (apply date-value (flat (list y m d (args)))) (* 60 (now 0 -2)))))
(define (local-date-parse dateStr formatStr)
(+ (date-parse dateStr formatStr) (* 60 (now 0 -2))))
(define (local-now (offset (- (now 0 -2))) index) (now offset index)))) local-date-list を定義するのにdate-list を使わず date を使ったのは訳があります。現在のバージョン（10.4.0）では、年間通しての日数が date-list と date とでは値が 1 だけ違います。しかし、次のバージョンから同じになる予定です。なので、バージョンが変わっても困らないようにしたのです。
また、曜日を表す数値が date-list では 月曜を 1 として 7 までなのに対して、date では 日曜を 0 として 6 まで。日曜が 0 か 7 の違いで、残りは一緒。実害無いで、多分仕様が変わることもないでしょう（笑）。
関数hayashi は newlisp-utility.lsp に定義してありますが、使うのが嫌であれば、
(define (local-date-list (n (date-value)))
(let (lst (map (fn (x) (int x 0 10)) (parse (date n 0 "%Y %m %d %H %M %S %j %w") " ")))
(setf (lst -1) (if (= $it 0) 7 $it))
lst))
こんな感じです。
残りは、バージョン（10.4.0）以降と以前では、now のタイムゾーンのオフセットの符号が逆になるので、それに合わせて関数定義を変えています。
協定世界時 (UTC) 関数も同様にをまとめると、
(if (> (sys-info -2) 10399)
(define (utc-date (secs (date-value)) (offset (now 0 -2))) (date secs offset))
(define (utc-date (secs (date-value)) (offset (- (now 0 -2)))) (date secs offset)))
(define utc-date-list date-list)
(define utc-date-value date-value)
(define utc-date-parse date-parse)
(define utc-now now)
といったところ。定義するまでもない？（笑）
utc-date-list は date-list そのものですから、年間通しての日数が次期バージョンから変わります。通常は local-date-list を使うでしょうから問題ないと思いますが、、、
どちらにも、time-of-date はありません。この関数を協定世界時 (UTC) で使うことはないでしょうから。
さて、関数date-parse は Windows では使えませんが、定義することはできます。
(define (date-parse dateStr formatStr , res)
(if (= formatStr "%c") (setq formatStr "%m/%d/%y %H:%M:%S"))
(let (specs (find-all "(%.)" formatStr)
;regStr (replace "(%.)" formatStr "(.+)" 0)
regStr (replace "(%.)" (replace "." formatStr "\\.") "(.+)" 0)
months '("" "Jan" "Feb" "Mar" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
Months '("" "January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December")
dateLst '(1900 1 1 0 0 0))
(setq res (regex regStr dateStr))
(when res
(setq res (rest (filter string? res)))
(when (= (length specs) (length res))
;(println (transpose (list specs res)))
(dolist (i (transpose (list specs res)))
(case (i 0)
("%b" (setf (dateLst 1) (find (i 1) months 1)))
("%B" (setf (dateLst 1) (find (i 1) Months 1)))
("%d" (setf (dateLst 2) (int (i 1) 0 10)))
("%H" (setf (dateLst 3) (int (i 1) 0 10)))
("%m" (setf (dateLst 1) (int (i 1) 0 10)))
("%M" (setf (dateLst 4) (int (i 1) 0 10)))
("%S" (setf (dateLst 5) (int (i 1) 0 10)))
("%Y" (setf (dateLst 0) (int (i 1) 0 10)))
("%y" (setf (dateLst 0) (int (string "20" (i 1)))))
(true )))))
(if-not (find nil dateLst) (apply date-value dateLst))))
以前掲載した自作 parse-date の関数名を date-parse にしただけですが（汗）。
以上、如何でしょうか？
newLISP マニュアル・アップデート v.10.4.0 rev 2012-03-18
newLISP のマニュアルが、3/16、3/17、3/18 と立て続けに変更され、現在、rev 2012-03-18 です。
細かな修正ですが、目立った所では、23. Linking newLISP source and executable が Windows のみの説明になっています。まっ、Linux 等では使う必要がないでしょうから、当然？
newLISP マニュアル ＆ リファレンス の日本語訳、現在のバージョンは、v.10.4.0 です。
こちらから newlisp_manual-10400 をダウンロードして下さい。
目次も含め日本語併記にしてあります。
いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報下さい。
以上、如何でしょうか？
新リスプな日々 