パターンガードとGaucheのutil.match

最近のHaskellにはパターンガードというものがあるらしい.

{-# LANGUAGE PatternGuards #-}

addLookup alist x y
    | Just m <- lookup x alist
    , Just n <- lookup y alist
    = m + n
    | otherwise
    = 0

main = print $ addLookup [(1, 2), (3, 4)] 1 3 -- => 6

Gaucheの util.match でどのように書けるか考えてみた.上のコードでは使ってないけど,ガードの後の式から前に束縛した変数が見えるのでそのようにする.

(use util.match)

(define add-assoc
  (match-lambda*
   ((alist x y)
    (match (assoc x alist)
      ((_ . m) (=> next)
       (match (assoc y alist)
         ((_ . n)
          (+ m n))
         (_ (next))))
      (_ 0)))))

(define (main args)
  (print (add-assoc '((1 . 2) (3 . 4)) 1 3))) ; => 6

できたけど今一つな感じ.複数の式に順次マッチさせるだけなら match-let* が使えるけど,あれはマッチに失敗すると例外が飛んでくるのですっきりしない.一旦リストに纏める方法では前の変数が見えない.


何が問題なのだろう.match のネストが簡潔に書けるマクロがあればいいのかなぁ.上記の例だと,match-let* にマッチに失敗した場合が書ければそれだけでかなりすっきりする気もする.
(19:29 コードがおかしかったので修正)

Ruby2.0.0をインストール

Ruby2.0.0-p195をインストール.
makeすると

gcc: installation problem, cannot exec '/usr/local/bin/i686-apple-darwin9-gcc-4.0.1': No such file or directory
dtrace: failed to compile script probes.d: Preprocessor failed to process input program
make: *** [probes.h] Error 1

という謎のエラーが出るので

ln -s /usr/local/bin/i386-apple-darwin9.8.0-gcc /usr/local/bin/i686-apple-darwin9-gcc-4.0.1

してmakeしたったら無事makeできた.make testもOK.

Leopardにcabalをインストール

HaskellでParsecを使ってみようと思いつつインストールしようにも古代OS故にcabalが入っていないので諦めていたが,ぐぐったらcabalを手動で入れればいいらしいので依存ライブラリを入れていたらいつの間にかParsecが入っていた.
というわけで,勢い余って

  • transformers-0.3.0.0
  • mtl-2.1.2
  • zlib-0.5.4.1
  • deepseq-1.3.0.1
  • text-0.11.2.3
  • parsec-3.1.3
  • network-2.4.1.2
  • HTTP-4000.2.8
  • Cabal-1.16.0.3
  • cabal-install-1.16.0.2

を手動でインストールしてしまった.
Hackageから適当に取ってきて

ghc --make Setup.hs
./Setup configure
./Setup build
sudo ./Setup install

する作業.依存ライブラリで足りない物があるとconfigureの時に言ってくれる.
インストールは(ほぼ)恙無く終わったけどちゃんと動くのかしら.
cabal updateは動いたっぽいのできっと大丈夫だろう.

動的環境を指定してthunkを呼ぶ

shift/reset と動的環境の関係についていろいろ考えていた時に出てきた副産物.

(use util.match)

(define (capture/de proc)
  (match (let/cc de
           (list (proc de)))
    ((r) r)
    (thunk
     (thunk))))

(define (with/de de thunk)
  (let/cc cont
    (de (.$ cont thunk))))

(define (de-test thunk)
  (dynamic-wind
    (^() (print "before thunk"))
    thunk
    (^() (print "after thunk"))))
gosh> (capture/de (^k (de-test (^() (with/de k (^() (print "hoge") 42))))))
before thunk
after thunk
hoge
before thunk
after thunk
42
gosh> (regexp-replace-all #/./ "aa" (^m (print "hoge") "b"))
"hoge\nbhoge\nb"
gosh> (capture/de (^k (regexp-replace-all #/./ "aa" (^m (with/de k (^() (print "hoge"))) "b"))))
hoge
hoge
"bb"

深く考えてないけど動いてそう.

make-syntactic-closure の練習

(define-syntax alet1
  (sc-macro-transformer
   (lambda (expr use-env)
     (let ((it-expr (cadr expr))
           (var (caddr expr))
           (expr1 (cadddr expr))
           (body (car (cddddr expr))))
       `(let ((it ,(make-syntactic-closure use-env '() it-expr))
              (,var ,(make-syntactic-closure use-env '() expr1)))
          ,(make-syntactic-closure use-env `(it ,var) body))))))

(let ((x 7))
  (alet1 42 print (lambda (x) (display x) (newline))
         (begin
           (print it)
           (print x)
           (let ((it 23))
             (print it)))))
42
7
23

一発でうまく書くことはできなかった…
body の free-names に '(it) を指定することで use-env でもなく mac-env でもなくマクロから生で挿入した it が見えるようになる…ということなのか?


(9/28 11:00修正&追記)
Twitterで @dico_leque さんにbodyのsyntactic closureにvarも指定しないといけないとご指摘を頂いたのに,こっちを編集するのを忘れていた.修正 '(it) => `(it ,var)
chibi-schemeではなくても動いてしまったのだけど,どうやらchibi-schemeのバグらしい.

make-syntactic-closure の free-names のイメージ

(make-syntactic-closure environment free-names form)free-names は,let で包むイメージでいいんだろうか.

(let ((x 1))
  (let-syntax ((foo (sc-macro-transformer
                     (lambda (expr env)
                       (let ((var (cadr expr)))
                         (make-syntactic-closure var (list var) env))))))
    (let ((x 2))
      (foo x))))

foo展開のイメージ

(let ((x@1 1))
  (let-syntax ((foo (sc-macro-transformer
                     (lambda (expr env)
                       (let ((var (cadr expr)))
                         (make-syntactic-closure var (list var) env))))))
    (let ((x@2 2))
      (let ((x@2 x@1)) x@2))))

あるいは,マクロ定義時の環境が透けて見えるイメージ?


下のコード,コメントはchibi-schemeでの実行結果.

(let ((print (lambda (x) (display x) (newline)))
      (x 1))
  (let-syntax ((foo (sc-macro-transformer
                     (lambda (expr env)
                       (let ((var (cadr expr)))
                         `(begin
                            (print ,var)                                         ; 1
                            (print ,(make-syntactic-closure env '() var))        ; 2
                            (print ,(make-syntactic-closure env '(x) var))       ; 1
                            (print ,(make-syntactic-closure env (list var) var)) ; 1
                            ))))))
    (let ((x 2))
      (foo x))))

マイナーカップキャラランク

ポケモン金銀のオリジナルルール「マイナーカップ」のキャラランクを適当に作ってみた.
マイナーカップのルールはニンテンドウカップ2000を基準に以下の追加ルール:

バタフリー スピアー ピジョット ラッタ オニドリル プクリン パラセクト カモネギ ベロリンガ モンジャラ アズマオウ メタモン オオタチ ヨルノズク レディアン アリアドス トゲチック マリルリ ウソッキー エイパム キマワリ ヤンヤンマ ヤミカラス アンノーン ソーナンス ノコッチ マグカルゴ サニーゴ デリバード カポエラー以外の最終進化系禁止
ユンゲラー ゴーリキー ゴースト ラッキー シードラ ストライク ハクリュー禁止 一撃太鼓禁止 電気球太い骨破壊の遺伝子禁止

こう見てるとオクタンやハクリューアーボックは居てもよかったんじゃないかなぁ.
以下,滑稽なキャラランク.同ランク内は適当,ランク分けも適当,直感,机上論.

A+

ケーシィ ラッタ プクリン マリルリ イワーク ポリゴン