(call-with-values (lambda () (values 1 2 3)) (lambda (a b c) (+ a b c))) ;; => 6個人的にcall-with-valuesの可読性*2は低いと思っているのですが、receiveを使うと以下のように書けます。
(receive (a b c) (values 1 2 3) (+ a b c)) ;; => 6同様の処理が多少見やすく書けます。もちろん好みによりますが。記述量の面で見てもlambdaを書かない分少なくなります。
(import (rnrs) (srfi :6)) ;; string input port (define in (open-input-string "SRFI-6 test :)")) (get-string-all in) ;; -> "SRFI-6 test :)" (define out (open-output-string)) (put-string out "Hello") (get-output-string out) ;; -> "Hello" (put-string out " SRFI-6!") (get-output-string out) ;; -> "Hello SRFI-6!"注意が必要なのは
get-output-stringでしょう。この手続きは出力ポートに呼び出し時点までに溜め込まれた文字列を返しますが、溜め込まれた文字列をクリアしません。上記の例のように複数回の呼び出しでも同一の文字列が取得可能です。これはR6RSで既定されているopen-string-output-portが返す第2値とは異なる振る舞いをします。% pegasus install json-install \ -u https://raw.github.com/ktakashi/json-tools/master/formula/json-select.scm -- Retrieving: https://github.com/ktakashi/json-tools/archive/master.zip -- Extracting: json-tools-master/ -- Extracting: json-tools-master/README.md -- Extracting: json-tools-master/ext/ -- Extracting: json-tools-master/ext/json.scm -- Extracting: json-tools-master/ext/packrat.scm -- Extracting: json-tools-master/ext/srfi/ -- Extracting: json-tools-master/ext/srfi/%3a64.sls -- Extracting: json-tools-master/ext/srfi/%3a64/ -- Extracting: json-tools-master/ext/srfi/%3a64/testing.sls -- Extracting: json-tools-master/formula/ -- Extracting: json-tools-master/formula/json-select.scm -- Extracting: json-tools-master/src/ -- Extracting: json-tools-master/src/text/ -- Extracting: json-tools-master/src/text/json/ -- Extracting: json-tools-master/src/text/json/select.scm -- Extracting: json-tools-master/src/text/json/select/ -- Extracting: json-tools-master/src/text/json/select/parser.scm -- Extracting: json-tools-master/src/text/json/tools.scm -- Extracting: json-tools-master/tests/ -- Extracting: json-tools-master/tests/parser.scm -- Extracting: json-tools-master/tests/select.scm -- Extracting: json-tools-master/tests/tools.scm -- Installing: /usr/local/share/sagittarius/sitelib/src -- Deleting working directory: json-install-HEAD/json-tools-masterインストールできました。他の処理系で使いたい場合は、Githubから直接クローンするかアーカイブをダウンロードするかしてください。
#!r6rs
(import (rnrs)
(text json tools)
(text json select))
(define json '#(("name" . #(("first" . "Lloyd") ("last" . "Hilaiel")))
("favoriteColor" . "yellow")
("languagesSpoken"
#(("lang" . "Bulgarian") ("level" . "advanced"))
#(("lang" . "English")
("level" . "native")
("preferred" . #t))
#(("lang" . "Spanish") ("level" . "beginner")))
("seatingPreference" "window" "aisle")
("drinkPreference" "whiskey" "beer" "wine")
("weight" . 156)))
(json:nodeset->list ((json:select ".languagesSpoken") json))
#|
(("languagesSpoken"
#(("lang" . "Bulgarian") ("level" . "advanced"))
#(("lang" . "English")
("level" . "native")
("preferred" . #t))
#(("lang" . "Spanish") ("level" . "beginner"))))
|#
(json:nodeset->list ((json:select ".languagesSpoken > .level") json))
#|
(("level" . "advanced")
("level" . "native")
("level" . "beginner"))
|#
json-toolsはChicken Scheme由来のjsonライブラリのJSONオブジェクト表現を使っています。ただ、そのままだと配列と連想配列を区別し辛かったりと不便な点もあるので、APIは渡されたオブジェクトを<json-node>に変換します。また、json-toolsでサポートしていAPIは基本ノードセットと呼ばれるオブジェクトを返します。そのため、実際に取り出されたS式JSONを得るにはjson:nodeset->list手続きを呼び出す必要があります。(define (bar)
(let-syntax ((foo (syntax-rules () ((_ b) (when (< b 10) (bar))))))
(define (buz b) (foo b))
(buz 10)))
これが展開後には以下のようになる。
(define (bar) (define (buz b) (when (< #<id b> 10) (bar))) (buz 10))問題になるのは識別子#<id b>で現在のマクロ展開器ならば識別子が持つ環境フレームに変数bが入って変数参照手続きがたどれるようになっている。しかし、ナイーブな実装で先にマクロだけを展開してしまうと生成された識別子は局所変数の参照を持たないフレームを持つことになり変数参照がうまくいかない。
(let () (letrec-syntax ((a (syntax-rules () ((_) 'foo))))) (print (a))) ;; -> prints 'foo火を見るよりも明らかなバグである。なぜこんな挙動になるかといえば、let(rec)-syntaxはマクロ展開後にbeginになるというのに起因している。Sagittariusではマクロ展開フェーズを内部的に持っていないので、コンパイラがマクロを見つけると展開するという仕組みになっている。そして、それを実現するためにlet(rec)-syntaxで束縛されたマクロはコンパイル時環境を破壊的に拡張するという方法をとっている。これが問題なのだ。
(let () ...) ;; (()) empty (letrec-syntax ...) ;; ((a . <macro>)) *1 (print (a)) ;; ((a . <macro>)) *2本来であれば*1で足されたマクロは*2の段階では見えなくなっていなければならないが、そんなこともないのが問題になっている。解決方法はいくつかあると思っていて、ぱっと思いつくだけで以下のものがある。
#!r6rs
(import (for (rnrs) run expand))
(define-syntax foo
(lambda (x)
(define-syntax bar
(syntax-rules ()
((_) #''foofoo)))
(syntax-case x ()
((_)
(with-syntax ((name (bar)))
#'name)))))
(foo) ;; -> foofoo
これを解決するのがフェーズというわけである。マクロbarはマクロfooが展開される前に展開される必要がある。ではbar内で使われているsyntax-rules等の名前を解決する必要がある。フェーズとはその名前解決が行われる段階を明示的に指定したものと思えばよい。runとexpandが名前つきで提供されているが、これらは(meta 0)と(meta 1)の別名である。#!r6rs
(import (for (rnrs) run expand (meta 2)))
(define-syntax meta0
(lambda (x)
(define-syntax meta1
(lambda (x)
(define-syntax meta2
(lambda (x)
(syntax-case x ()
((_) #'(generate-temporaries '(a))))))
(syntax-case x ()
((_)
(with-syntax (((name) (meta2)))
#'#'name)))))
(define (gen-name) (meta1))
(syntax-case x ()
((_)
(with-syntax ((name (gen-name)))
#'(display 'name))))))
(meta0) ;; -> prints temporary symbol
見た目に分かりやすいようにマクロの名前は各メタレベルにしてある。こんなコード書くやついねぇよ！と思うかもしれないが、例示できるコードレベルで出るということは必ず誰かは使うということである。明示的か暗黙的にかは別にしてもだ。(import (srfi :5))
(let (loop (i 0))
(when (< i 10)
(display i) (newline)
(loop (+ i 1))))
loopの位置が束縛の先頭にはいるという感じです。(正直、僕にはエディタの恩恵が受けづらくなるだけに見えるのですが・・・)(import (srfi :5))
(let (loop (x 0) (y 1) . (z 2 3 4))
(if (list? x)
(list x y z)
(loop z x y)))
オプショナル引数は複数個の値がリストにパックされます。また通常のletフォームもサポートされるので、通常の名前付きlet+オプショナル引数という感じでも書くことができます。((letrec ((loop (lambda (x y . z)
(if (list? x)
(list x y z)
(loop z x y)))))
loop) 0 1 2 3 4)
納得の展開結果ではないでしょうか？(import (rnrs) (text json tools))
(define json '#(("name" . #(("first" . "Lloyd") ("last" . "Hilaiel")))
("favoriteColor" . "yellow")
("languagesSpoken"
#(("lang" . "Bulgarian") ("level" . "advanced"))
#(("lang" . "English")
("level" . "native")
("preferred" . #t))
#(("lang" . "Spanish") ("level" . "beginner")))
("seatingPreference" "window" "aisle")
("drinkPreference" "whiskey" "beer" "wine")
("weight" . 156)))
((json:filter (lambda (node)
;; The given node can be other type and
;; this piece of code may raise an error
;; but for above structure this works :)
(equal? "name" (json:map-entry-key node))))
(json:child-nodes json))
;; -> <json:nodeset>
All JSON selectors return JSON nodeset type which contains sets of JSON node. Followings are the JSON node types;(json:nodeset->list ((json:filter (lambda (node)
(equal? "name" (json:map-entry-key node))))
(json:child-nodes json1)))
;; --> (("name" . #(("first" . "Lloyd") ("last" . "Hilaiel"))))
Not sure if the procedure name is proper. (I also though `json:nodeset->sexp`.) To casual use, `json:filter`, `json:child-nodes`, `json:child-nodes-as-list`, `json:child` or `json:child-as-list` are easy to use. The rest of selectors are a bit tricky.(import (text json select))
;; use the same JSON structure defined above
((json:select ".languagesSpoken") json)
;; --> <json:nodeset>
(json:nodeset->list ((json:select ".languagesSpoken") json))
;; --> '(("languagesSpoken"
;; #(("lang" . "Bulgarian") ("level" . "advanced"))
;; #(("lang" . "English")
;; ("level" . "native")
;; ("preferred" . #t))
;; #(("lang" . "Spanish") ("level" . "beginner"))))
The returning value is JSON nodeset the same as tools. So again to retrieve the S-exp result, you need to call the procedure `json:nodeset->list`. Currently, not all query language are implemented but it would be a matter of time.(import (rnrs) (clos user))
(define-record-type (pare kons pare?)
(fields (mutable x kar set-kar!)
(immutable y kdr)))
(define-method write-object ((p pare) out)
(format out "#<pare ~s:~s>" (kar p) (kdr p)))
(print (kons 1 2))
This was because R6RS record didn't create CLOS class but own record type. I was thinking this is very inconvenient and made me not to use R6RS record. So I have made the change and now above code works as I expect.(import (rnrs) (clos user) (clos core)) (define-class <a> () (a b)) (define-class <b> (<a>) (c d)) (define-class <c> (<a>) (a c d)) (print (class-slots <b>)) ;; ((c) (d) (a) (b)) : 0.5.0 or before ;; ((a) (b) (c) (d)) : current (print (class-slots <c>)) ;; ((a) (c) (d) (b)) : 0.5.0 or before ;; ((a) (b) (a) (c) (d)) :currentSo basically no eliminating slots and different order. Then I had immediately noticed the problem that this breaks slot accessing. For example, refering <c>'s slot 'a' may return <b>'s 'a' slot value. The solution was very easy. The bottom most class's slots need to be shown first this means searching reverse order was sufficient.
#!read-macro=srfi/:4 (import (srfi :4)) (define s8 #s8(0 -1 2 -3 4)) (s8vector-ref s8 1) ;; => -1 (s8vector-set! s8 0 5) ;; => unspecified (list->s8vector '(1 2 3 4 5)) ;; => #s8(1 2 3 4 5) (s8vector->list s8) ;; => #s8(5 -1 2 -3 4)R6RS以降バイトベクタが基本データ型に入ったのでこのSRFIの存在意義が薄れた感はありますが、R5RSで書かれたスクリプト等に使われている場合があるので知っておいても損はないかと思います。
(define-syntax test
(syntax-rules ()
((_ a b)
(let ((a a))
(+ a b)))))
(let ((a 1) (b 2)) (test b a))
というのは、3を返す必要がある。(今一いい例ではないかもしれないが)上記の例ではaがテンプレート変数ということになる。Sagittariusではテンプレート変数は基本的にリネームされ、実際に渡される式とは別の扱いになっている。リネームの再に現在のマクロ環境が用いられてリネームされるので生成される識別子aはこの場合は空の環境を持ったものになる。(実際にはマクロであることを識別するためのマークと定義されたライブラリの情報が入る)(define-syntax aif
(lambda (x)
(syntax-case x ()
((aif expr then else)
(with-syntax ((it (datum->syntax #'aif 'it)))
#'(let ((it expr))
(if it then else)))))))
(aif (car '(a)) it #f) ;; => a
上記の例ではitはマクロaifが定義された環境(つまり空)を持つ識別子となる。そうすることでaif式内で参照されるitはあたかもグローバルに束縛された変数を参照するような挙動をする。しかし、現状の実装では以下のような場合に上手く動かない。(define-syntax wrap
(syntax-rules ()
((_)
(aif 'ok it #f))))
(wrap) ;;=> should return ok but raises an error
一段マクロをかますことで、itがテンプレート変数に変更され環境が変わるからである。本来であればitは大域で定義された変数と同様な動きをするべきだが、そうなっていない。(wrapが局所で定義されたらどうするんだという話もあるがとりあえず放置・・・);; make upcase symbol of car part if it's symbol
(and (pair? o)
(let ((a (car o)))
(and (symbol? a)
(let ((s (symbol->string a)))
(cons (string->symbol (string-upcase s)) (cdr o))))))
andとletがネストして非常に読みにくい素敵コードだ。こんな不快深い階層のネストを解消してくれる構文がand-let*である。これを使うと上記のようなコードは以下のようにすっきりと書ける。
(and-let* (( (pair? o))
(a (car o))
( (symbol? a) )
(s (symbol->string a)))
(cons (string->symbol (string-upcase s)) (cdr o)))
あまり変わらない？それはあなたの心が澱んでいる可能性が高いのでリフレッシュさせることをお勧めする。
