cutの実装

scheme gauche

とりあえず明日の仕事というか宿題が終わったので、schemeに戻れる。
まずどっちからやろうかな、と考えて、より大変そうなcutからやってみる。早速 srfi-26を覗いてみる。
と、こんな感じの入り口マクロに

(define-syntax cut
  (syntax-rules ()
    ((cut . slots-or-exprs)
     (srfi-26-internal-cut () () . slots-or-exprs))))

こんな感じの本体マクロのセット（本質的なところだけを抜き出しています）。

(define-syntax srfi-26-internal-cut
  (syntax-rules (<>)

    ;; construct fixed- or variable-arity procedure:
    ;;   (begin proc) throws an error if proc is not an <expression>
    ((srfi-26-internal-cut (slot-name ...) (proc arg ...))
     (lambda (slot-name ...) ((begin proc) arg ...)));;(0)

    ;; process one slot-or-expr
    ((srfi-26-internal-cut (slot-name ...)   (position ...)      <>  . se) 
     (srfi-26-internal-cut (slot-name ... x) (position ... x)        . se));;(1)
    ((srfi-26-internal-cut (slot-name ...)   (position ...)      nse . se)
     (srfi-26-internal-cut (slot-name ...)   (position ... nse)      . se))));;(2)

やっている事は単純で、(1),(2)のルールでcut以降の式を順に走査していき、<>が出てきたら(1)でlambdaの引数に書き換え、そう出なければそのまま、という置き換えを繰り返し、式が空になったら(0)のルールでごそっと lambdaでくるむ。というやりかた。
ちょうど、srfi-26-internal-cutの１つめのリストが後からlambdaの引数リストになる部分で、２つめのリストが式本体(の<>をlambdaの引数に置き換えた物)となる。
で、ネストしたリストのcutが上手くいかないのは、(1),(2)がdeepに見れないから、で、そう考えると以下の動作は非常にナットク。

gosh> ((cut not (equal? <> 0)) 0)
*** ERROR: Compile Error: wrong number of arguments: #f requires 0, but got 1
"(stdin)":357:((cut not (equal? <> 0)) 0)

Stack Trace:
_______________________________________
gosh> ((cut not (equal? <> 0)))
*** ERROR: unbound variable: <>
Stack Trace:
_______________________________________
  0  (equal? <> 0)
        At line 358 of "(stdin)"

上記の場合 equal?のリストの中まで走査しないので<>は読まれず、 (lambda () (not (equal? <> 0)))　になってしまう。だから引数を与えれば怒られるし、引数を与えなければ <>が不正だと怒られる。なるほど。
こんな使い方しなければ良い（実際ネストした奴にcut入れるのは何となく違和感がある）のだけれど、折角なのでなんとかしてみようとしてハマる。

(define-syntax my-inner-cut
	(syntax-rules (<>)
	  ((my-inner-cut (slots ...) (exprs ...))
	   (lambda (slots ...) (exprs ...)))

          ;; nest解析部
	  ((my-inner-cut (slots ...) (exprs ...) (h . t) . rest)
	   (my-inner-cut (slots ...) (exprs ...) (my-inner-nest () () (h . t)) . rest))

	  ((my-inner-cut (slots ...) (exprs ...) 'inner params trans . rest)
	   (my-inner-cut (slots ... params) (exprs ... trans) . rest))

          ;;走査部
	  ((my-inner-cut (slots ...) (exprs ...) <> . rest)
	   (my-inner-cut (slots ... x) (exprs ... x) . rest))
	  ((my-inner-cut (slots ...) (exprs ...) ns . rest)
	   (my-inner-cut (slots ...) (exprs ... ns) . rest))))

とかして my-inner-nestで、云々とか・・・・うわーワケワカランくなってきた。難しい過ぎる。というかこれは思考の迷宮状態なのでもうダメ。一時あきらめて撤退。改めて挑戦（する意味は無いのかもしれない）。