listを一連の流れの連鎖ではなく候補からの選択と捉えてみると…

scheme

listを一連の流れの連鎖ではなく候補からの選択と捉えてみると、別な形のマクロが思い浮かぶ。
(やり過ぎ良くない…ただ、実験ということで)
例えば、こんな感じ。clojureの->,->>にならい、初期値を取りそれをもとに選択を行うようになっている。

(define (f x p val) (and (p x) val))
(define (QandA Q)
  (@maybeL Q (f symbol? 'symbol)
           (f integer? 'int)
           (f list? 'list)
           (f identity 'unknown)))
(map QandA '(10 aa (aa) #(aa))) ; => (int symbol list unknown)

他の構文とは異質なものなので、それをはっきりさせるために@をつけている。

code

(use util.match)
(define-macro (@maybeL init . candidates)
  (let ((tmp (gensym)))
    `(let1 ,tmp ,init
       (or ,@(map (match-lambda
                      [(fn . args) `(,fn ,tmp ,@args)]
                      [fn `(,fn ,tmp)])
                  candidates)))))

(define-macro (@maybeR init . candidates)
  (let ((tmp (gensym)))
    `(let1 ,tmp ,init
       (or ,@(map (match-lambda
                   [(fn . args) `(,fn ,@(append args (list tmp)))]
                   [fn `(,fn ,tmp)])
                  candidates)))))

(define-macro (@allL init . candidates)
  (let ((tmp (gensym)))
    `(let1 ,tmp ,init
       (and ,@(map (match-lambda
                      [(fn . args) `(,fn ,tmp ,@args)]
                      [fn `(,fn ,tmp)])
                  candidates)))))

(define-macro (@allR init . candidates)
  (let ((tmp (gensym)))
    `(let1 ,tmp ,init
       (and ,@(map (match-lambda
                   [(fn . args) `(,fn ,@(append args (list tmp)))]
                   [fn `(,fn ,tmp)])
                  candidates)))))

@maybeLがあるとfizzbuzzが以下のように書ける。(意味があるかは知らない)

fizzbuzz

(define (f n x val) (and (zero? (modulo n x)) val))
(dotimes (i 100)
  (print
   (@maybeL k (f 15 'fizzbuzz) (f 3 'fizz) (f 5 'buzz) identity)))

clojureのカスケードマクロを導入

scheme

昨日書いていたコードの中でassoce-default相当の関数を書こうとした際に、
clojureの-?>が使いたくなった。-?>は結果をみて偽なら実行を途中で打ち切るという点ではand-let*と同様、
でもand-let*とは異なり結果に特に名前をつけたくないような場合に使いたくなる。
これがあるとassoc-defaultは以下のように書ける。

(define (assoc-default e alist) ;;elispなどにある
  (-?> (assoc e alist) cadr))

(assoc-default 'x '((x 10) (y 20) (z 30))) ; => 10
(assoc-default 'i '((x 10) (y 20) (z 30))) ; => #f

code

(use util.match)
(define-macro (-> init . rest)
  (fold (lambda (xs acc)
          (match xs
            [(fn . args) `(,fn ,acc ,@args)]
            [fn `(,fn ,acc)]))
        init rest))

(define-macro (->> init . rest)
  (fold (lambda (xs acc)
          (match xs
            [(fn . args) `(,fn ,@(append args (list acc)))]
            [fn `(,fn ,acc)]))
        init rest))

(define-macro (-?> init . rest)
  (let1 tmp (gensym)
    (fold (lambda (xs acc)
            (match xs
              [(fn . args) 
               `(let1 ,tmp ,acc
                  (and ,tmp (,fn ,tmp ,@args)))]
              [ fn `(let1 ,tmp ,acc (and ,tmp (,fn ,tmp)))]))
          init rest)))

;; (macroexpand '(-> 10))
;; (macroexpand '(->> 10))
;; (macroexpand '(-?> 10))
;; (macroexpand '(-> 10 (+ 2) (- 3)))
;; (display (unwrap-syntax (macroexpand '(-?> 10 (+ 2) (- 3)))))
;; (macroexpand '(->> 10 (+ 2) (- 3)))

自分勝手なgoshコマンドの作成

scheme

個人用のスクリプトを書く際には、便利なライブラリが全てuseされていると嬉しい。
(gauche.experimental.*は、これをuseするのが億劫になり使わないことが度々)
今までは逐一利用したいライブラリをuseしてきたけれど…面倒くさい。
特に他人と共有しようとするスクリプトでなければ、もっとわがままに振る舞っても良いのではないかと思った。
幸いgoshは-lオプションで事前に読み込むファイルを設定できる。

個人的な処理を行う際に起動するgoshコマンドをgosh-exとして作ってみた。
行う手順は以下のとおり

  • ~/.gosh-ex作成
  • gosh-ex コマンドを作成

.gosh-ex

useしておきたいライブラリなどをuseするなどする。

(use gauche.experimental.lamb)
(use gauche.experimental.ref)
(use gauche.experimental.app)
(use srfi-1)
(use util.match)
(use util.list)

gosh-exコマンド

以下のようなシェルスクリプトを作成

#!/bin/sh
gosh -I ~ -l ~/.gosh-ex $@

これでgosh-exで立ち上げたreplでは便利なライブラリがデフォルトでつかえるようになる。

re:schemeで全dataを+するのを知りたいです

scheme

こんな感じかな？
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1347295398
http://d.hatena.ne.jp/yad-EL/20100921/p1

(define (mysum xs)
  (fold (lambda (x acc) (+ (if (list? x) (mysum x) x) acc))
	0 xs))
;; (mysum 20)
;; (mysum '()) ; => 0
;; (mysum '(1 2 3)) ; => 6
;; (mysum '((1 2) ((3)) (4 (5)))) ; => 15

(define (tree-map fn tree)
  (map (lambda (x) (if (list? x) (tree-map fn x) (fn x))) tree))
(define (mytrans xs)
  (let1 source '(zero one two three four five six seven eight nine)
    (cond ((null? xs) 0)
	  (else (tree-map (pa$ list-ref source) xs)))))

;; (mytrans 1)
;; (mytrans '())
;; (mytrans '(1 2 3)) ; => (one two three)
;; (mytrans '((1 2) ((3)) (4 (5 6)))) ; => ((one two) ((three)) (four (five six)))

(define (my-find xs e) 
  (and-let* ((pair (assoc e xs)))
    (cadr pair)))
;; (my-find 10)
;; (my-find 'a)
;; (my-find '((x 10) (y 20) (x 30)) 'x) ; => 10
;; (my-find '((x 10) (y 20) (x 30)) 'i) ; => #f

mirahを使ってみる

java ruby mirah

mirah=javaのspeed+rubyの文法　のような言語です。
rubyっぽい記述を翻訳して.classに落とし込むようなトランスレータのようなものみたいです。
C#っぽい見た目のファイルをC+glibの形に翻訳するvalaに近い感じですね。

install

BuildingMirahがとても参考になる。
javaとgitの環境は必要

pwd=`pwd`
mkdir workarea && cd workarea

## jruby
wget http://jruby.org.s3.amazonaws.com/downloads/1.5.2/jruby-bin-1.5.2.tar.gz
tar xvzf jruby-bin-1.5.2.tar.gz
mv jruby-1.5.2 jruby

## mirah
git clone http://github.com/headius/bitescript.git #core library for mirah
git clone http://github.com/headius/mirah.git

## build
cd ./mirah
../jruby/bin/jruby -S rake jar

## add $PATH
cd $pwd
cd workarea/jruby/bin
jruby=`pwd`
cd $pwd
cd workarea/mirah/bin
mirah=`pwd`
export PATH=$mirah:$jruby:$PATH
cd $pwd

使ってみる

例えば、以下のようなファイルを作成(hello.mirah)

puts "hello"

このファイルをmirahcでコンパイル

$ mirahc hello.mirah && java Hello
# mirahc に-jオプションをつけると.javaで出力してくれる。
$ mirahc -j hello.mirah

ちなみに以下のようなjavaのコードに翻訳されます。

// Generated from hello.mirah
public class Hello extends java.lang.Object {
  public static void main(java.lang.String[] argv) {
    java.io.PrintStream temp$1 = java.lang.System.out;
    temp$1.println("hello");
  }
}

anything-occurなどで現在のselectionの位置を表示する。

emacs

上下に移動する際に、persistent-actionを実行して上げればできそうです。(type-attributeがlineなら)
今回は、

  • anything-bm-list*
  • anything-occur*

を作ってみました。

code

(defadvice anything-next-line (after execute-persistent-action disable)
(unless (or (anything-get-previous-header-pos)
(anything-get-next-header-pos))
(call-interactively 'anything-execute-persistent-action)))
(defadvice anything-previous-line (after execute-persistent-action disable)
(unless (or (anything-get-previous-header-pos)
(anything-get-next-header-pos))
(call-interactively 'anything-execute-persistent-action)))
;; (defadvice anything-next-line (after line-goto disable)
;; (and-let* ((selection (anything-get-selection)))
;; (let1 old-amount anything-scroll-amount
;; (setq anything-scroll-amount (1- (car selection)))
;; (unwind-protect
;; (anything-scroll-other-window-base 'goto-line)
;; (setq anything-scroll-amount old-amount)))))
;; (defadvice anything-previous-line (after line-goto disable)
;; (and-let* ((selection (anything-get-selection)))
;; (let1 old-amount anything-scroll-amount
;; (setq anything-scroll-amount (1- (car selection)))
;; (unwind-protect
;; (anything-scroll-other-window-base 'goto-line)
;; (setq anything-scroll-amount old-amount)))))
(defmacro with-anything-line-move-advice (advice-name action)
`(progn
(ad-enable-advice 'anything-next-line 'after ',advice-name)
(ad-activate 'anything-next-line)
(ad-enable-advice 'anything-previous-line 'after ',advice-name)
(ad-activate 'anything-previous-line)
(unwind-protect
,action
(progn (ad-deactivate 'anything-previous-line)
(ad-deactivate 'anything-next-line)))))
(defun anything-occur* ()
"Preconfigured Anything for Occur source."
(interactive)
(with-anything-line-move-advice
execute-persistent-action
(anything-occur)))
(defun anything-bm-list* ()
"Preconfigured `anything' for visible bookmarks."
(interactive)
(with-anything-line-move-advice
execute-persistent-action
(anything-bm-list)))
view raw anything-auto-watch-line hosted with ❤ by GitHub