カッコの少ないSchemeを作る

f:id:ympbyc:20150908160824p:plain

昨日の記事

ympbyc.hatenablog.com

の内容をScheme (gauche)で実験できるようにしてみます。

今回の記事は、上から順にGaucheのリスナに貼り付けていけば、動作が確認できるようにしてあります。

準備

まず、固定長引数とそれ以降の引数を取って、余った引数を結果にapplyする関数を作るマクロを作ります。define-syntax面倒臭いのでdefine-macroしちゃいます。

(define-macro defix
  (lambda (defclause . body)
    `(define (,@defclause . next)
       (if (pair? next) 
           (apply (begin ,@body) next)
           (begin ,@body)))))

(macroexpand '(defix (-car x xs) x))
;;=> (define (-car x xs . next) 
;;=>   (if (pair? next) 
;;=>     (apply (begin x) next)
;;=>     (begin x)))

(define-macro lamfix
  (lambda (params . body)
    `(lambda (,@params . next)
       (if (pair? next) 
           (apply (begin ,@body) next)
           (begin ,@body)))))

(macroexpand '(lamfix (x xs) xs))
;;=> (lambda (x xs . next) (if (pair? next) (apply (begin xs) next) (begin xs)))

ちょっと汚いけどあんまり気にしないで。

以降、すべての define を defix, lambda を lamfix に置き換えて定義していきます。

リスト関数

(defix (cons x xs)
  (lamfix (f) (f x xs)))

(defix (car xs)
  (xs (lamfix (y ys) y)))

(defix (cdr xs)
  (xs (lamfix (y ys) ys)))

(defix (-car x xs) x)
(defix (-cdr x xs) xs)

(defix (<: x xs)
  (lamfix (y) (cons y (cons x xs))))

(defix (list x)
  (cons x '()))

(list 4 <: 3 <: 2 <: 1 -car)           ;;=> 1
(list 4 <: 3 <: 2 <: 1 -cdr -cdr -car) ;;=> 3

map や filter の例も同様に、 defix や lamfix をうまいこと使って作っていきます。

(defix (map xs f)
  (if (null? xs) '()
    (cons (f (car xs)) (map (cdr xs) f))))

(defix (filter xs f)
  (if (null? xs) '()
    (if (f (car xs))
      (cons (car xs) (filter (cdr xs) f))
      (filter (cdr xs) f))))

(defix (prefix f)
  (lamfix (x xs) (pa$ f (cons x xs))))

(define -map (prefix map))
(define -filter (prefix filter))

(list 5 <: 4 <: 3 <: 2 <: 1 
 -filter odd? 
 -map    (pa$ * 2) 
 -map    print)
;;=> 2
;;=> 6
;;=> 10
;;=> #<closure (cons cons)>

パイプライン 演算子

-> も簡単です。

(defix (-> x)
  (lamfix (f)
    (lamfix (g)
      (f (g x)))))

(defix (<- x) x)

(-> 2
 -> (pa$ + 3)
 -> (pa$ * 4)
 <- number->string)   ;;=> "20"

できました！

混ぜて使う

固定長引数の関数は defix で定義して、可変長引数の関数は define で定義すれば、混ぜて使うこともできます。

(define (list . xs)
  (fold-right (lambda (x acc) (cons x acc)) '() xs)) ;;再定義したconsを使うため

(-> (list 1 2 3 4)
 -> (cut map <> (pa$ * 2))
 <- (cut map <> print))
;;=> 2 4 6 8 #<closure (cons cons)>