hira:質問箱

hira:質問箱

hiraの疑問とか悩みとか

Q

'()

Q&A

atmarkのwrite表現について

atmarkをwriteすると|@|となるのですが、なぜでしょう。 SXMLをwriteするときにイヤンな感じなので@のみにして欲しいと思ったのですが、きっと訳ありに違いないと思ったので質問してみました。 

;;;実行例
(write-to-string '@) ;=> "|@|"
(eq? '@ (read-from-string "@")) ;=> #t

;;;これが#tになって欲しい
(let1 atstr "@"
  (equal? atstr (write-to-string (read-from-string atstr)))) ;=> #f

'|'と'()'の組み合わせについて

acのときの1,2が#fになるのはこういうものなんでしょうか？ abと同様、"a","c"が返ることを期待していたのですが、どうでしょう。 

((#/(a)(b)|(a)(c)/ "ab") 0) ;=> "ab"
((#/(a)(b)|(a)(c)/ "ab") 1) ;=> "a"
((#/(a)(b)|(a)(c)/ "ab") 2) ;=> "b"
((#/(a)(b)|(a)(c)/ "ac") 0) ;=> "ac"
((#/(a)(b)|(a)(c)/ "ac") 1) ;=> #f
((#/(a)(b)|(a)(c)/ "ac") 2) ;=> #f

いきなり自己解決(ココに書くと速攻で自分のミスに気付くらしい。)↓ 

((#/(a)(b)|(a)(c)/ "ab") 0) ;=> "ab"
((#/(a)(b)|(a)(c)/ "ab") 1) ;=> "a"
((#/(a)(b)|(a)(c)/ "ab") 2) ;=> "b"
((#/(a)(b)|(a)(c)/ "ab") 3) ;=> #f
((#/(a)(b)|(a)(c)/ "ab") 4) ;=> #f
((#/(a)(b)|(a)(c)/ "ac") 0) ;=> "ac"
((#/(a)(b)|(a)(c)/ "ac") 1) ;=> #f
((#/(a)(b)|(a)(c)/ "ac") 2) ;=> #f
((#/(a)(b)|(a)(c)/ "ac") 3) ;=> "a"
((#/(a)(b)|(a)(c)/ "ac") 4) ;=> "c"

健全なマクロ内でのgensym?

gauche.parameterの実装を眺めていたのですが、tmp1aとtmp2aが不思議でなりません。 展開されたらtmp1a,tmp2aだらけになるように思ってしまいます。 実際はgensymされたように振る舞っているようなのですが、一般的にそういうものなのでしょうか。 このワザは使える！と思ったのですが、裏技だったらどうしようと不安になったので質問してみました。 

;;;lib/gauche/parameter.scm
(define-syntax %parameterize
  (syntax-rules ()
    ((_ (param ...) (val ...) (tmp1 ...) (tmp2 ...) () body)
     (let ((tmp1 val) ... (tmp2 #f) ...)
       (dynamic-wind
        (lambda () (set! tmp2 (param tmp1)) ...)
        (lambda () . body)
        (lambda () (param tmp2) ...))))
    ((_ (param ...) (val ...) (tmp1 ...) (tmp2 ...) ((p v) . more) body)
     (%parameterize (param ... p) (val ... v) (tmp1 ... tmp1a) (tmp2 ... tmp2a) more body))
    ((_ params vals vars other body)
     (syntax-error "malformed binding list for parameterize" other))
    ))

;;;sample
(%parameterize () () () () ((a b) (c d)) body)
;hira image
=> (%parameterize (a) (b) (tmp1a) (tmp2a) ((c d)) body)
=> (%parameterize (a c) (b d) (tmp1a tmp1a) (tmp2a tmp2a) () body)
=> (let ((tmp1a b) (tmp1a d) (tmp2a #f) (tmp2a #f))
     (dynamic-wind
       (lambda () (set! tmp2a (a tmp1a)) (set! tmp2a (c tmp1a)))
       (lambda () body)
       (lambda () (a tmp2a) (c tmp2a))))
;actual? tmp1b, tmp2bのように一意なシンボルになる
=> (%parameterize (a) (b) (tmp1a) (tmp2a) ((c d)) body)
=> (%parameterize (a c) (b d) (tmp1a tmp1b) (tmp2a tmp2b) () body)
=> (let ((tmp1a b) (tmp1b d) (tmp2a #f) (tmp2b #f))
     (dynamic-wind
       (lambda () (set! tmp2a (a tmp1a)) (set! tmp2b (c tmp1b)))
       (lambda () body)
       (lambda () (a tmp2a) (c tmp2b))))

シンボルの束縛値を得るには

そのスコープに束縛されているシンボルの値が欲しいです。 

(define a 'A)
(define b 'B)
(define (ab sym)
  (let ((a 1) (b 2))
    (symbol-bound sym)))
(ab 'a) => 1
(ab 'b) => 2

これを実現するsymbol-boundはどうやれば作れますか？ evalを使ってもトップレベルの環境しか見れないので、やはり無理なのでしょうか。 

(define (eval-ab sym)
  (let ((a 1) (b 2))
    (eval sym (interaction-environment))))
(eval-ab 'a) => A
(eval-ab 'b) => B

applyは遅い？ 

(use gauche.time)
(use srfi-1)

;;everyを知らずに作っちゃったmy-every
;;悔しいのでgaucheのeveryと競争してみる
(define my-every
  (case-lambda
    ((pred           ) #t)
    ((pred val . rest) (and (pred val) (apply my-every pred rest)))))

;;my-everyからcase-lambdaをはずす
(define (my-every2 pred . args)
  (if (null? args)
    #t
    (and (pred (car args)) (my-every2 pred (cdr args)))))

;引数をmy-everyに合わせたgaucheのevery(N-ary caseを削除。Fast pathのみ)
(define (every pred . lis1)
  (or (null-list? lis1)
      (let lp ((head (car lis1))  (tail (cdr lis1)))
        (if (null-list? tail)
          (pred head) ; Last PRED app is tail call.
          (and (pred head) (lp (car tail) (cdr tail)))))))

(define charlist (string->list "
01234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789
"))
(time (apply my-every  char? charlist))
(time (apply my-every2 char? charlist))
(time (apply every     char? charlist))

;;;結果
gosh> (time (apply my-every  char? charlist))
;(time (apply my-every char? charlist))
; real   0.063
; user   0.063
; sys    0.000
#t
gosh> (time (apply my-every2 char? charlist))
;(time (apply my-every2 char? charlist))
; real   0.017
; user   0.015
; sys    0.000
#t
gosh> (time (apply every     char? charlist))
;(time (apply every char? charlist))
; real   0.000
; user   0.000
; sys    0.000
#t

gaucheのevery速いです。 my-every2は、たまにmy-every並に遅いときがあります。 gaucheのeveryはつねに0。これは(一般的に?)applyのコストが高いからなのでしょうか？

eof値を得るには

eof-objectを保持していたいのですが、*eof*のような定数ってありませんか？ 今はこんなことをやって取得しているのですが、どうもしっくりきません。 

    gosh> (define eof (with-input-from-string "" (lambda () (read))))
    eof
    gosh> (eof-object? eof)
    #t

eofの取得方法はこれしかないのでしょうか。 この質問の背景にはGaucheRefj:port-for-eachなどの「入力ポートと関係していないreader」を簡単に作りたい、という要求があります。

define-syntax, syntax-rulesのプロシージャ版ってありませんか？

下のマクロはプロシージャの方が良いのですが、マクロの引数マッチが便利なのでマクロにしちゃってます。 

(define-syntax /fi
  (syntax-rules ()
    ((_ (inf opt)      thnk ) (apply with-input-from-file inf thnk (apply %add-autoditect (%parse-opt opt 'i)) ))
    ((_ (inf args ...) thnk ) (apply with-input-from-file inf thnk (      %add-autoditect  args ...          ) ))
    ((_  inf           thnk ) (      with-input-from-file inf thnk                        :encoding "*JP"      ))
    ))

これを次のようなプロシージャに変換したいのですが、どうするのが手っ取り早いでしょう。 作ろうかと思ったのですが、有り物があるならそれを使いたいなぁと思いまして。 

(define (/fi . args) 引数パターンでディスパッチして、引数をちゃんとバインドする)
Last modified : 2013/04/28 23:06:58 UTC