SchemeでClojure風構文

お昼ごはんを食べながら適当に書いてみた。Clojureの構文はちょっと見ただけなので違うかもしれない。

((import (rnrs))

(define-syntax fn
  (lambda (x)
    (define (parse-args args acc)
      (define (finish opt)
        (if (null? acc)
            opt
            (append (reverse acc) opt)))
      (syntax-case args (&)
        (() (finish '()))
        ((& rest) (finish #'rest))
        ((a . d)
         (parse-args #'d (cons #'a acc)))))

    (define (parse-body body acc)
      (syntax-case body ()
        (() (reverse acc))
        (((#(args ...) exprs ...) . rest)
         (with-syntax ((formals (parse-args #'(args ...) '())))
           (parse-body #'rest 
                       (cons #'(formals exprs ...) acc))))))
    (syntax-case x ()
      ((_ #(args ...) exprs ...)
       #'(fn dummy #(args ...) exprs ...))
      ((_ name #(args ...) exprs ...)
       (identifier? #'name)
       #'(fn name (#(args ...) exprs ...)))
      ((_ (#(args ...) exprs ...) ...)
       #'(fn dummy (#(args ...) exprs ...) ...))
      ((_ name (#(args ...) exprs ...) ...)
       (identifier? #'name)
       (with-syntax ((((formals body ...) rest ...)
                      (parse-body #'((#(args ...) exprs ...) ...) '())))
         #'(letrec ((name (case-lambda 
                           (formals body ...)
                           rest ...)))
             name))))))

(define-syntax def
  (syntax-rules ()
    ((_ name expr) (define name expr))))

(define-syntax defn
  (syntax-rules ()
    ((_ name #(args ...) body ...)
     (defn name (#(args ...) body ...)))
    ((_ name (#(args ...) body ...) ...)
     (define name
       (fn name (#(args ...) body ...) ...)))))

(defn print #(& args) (for-each display args) (newline))

(defn t1 #(a b) (print a b))
(t1 1 2)

(defn t2 
  (#(x) (print x))
  (#(x y) (print x y)))

(t2 1)
(t2 1 2)
(t2 2 1)

(def mult
  (fn this
      (#() 1)
      (#(x) x)
      (#(x y) (* x y))
      (#(x y & more) (apply this (this x y) more))))

(print (mult 1 2 3 4 5))

Clojureでは[]がベクタになるけど、Schemeでは#()にしないといけないのでむしろうっとおしい感じがする。

動作確認はいつものR6RS処理系でやった。

なんでこんなものを書いたかと言えば、パターンマッチ部分でベクタにもマッチできるよなぁと思ったから。本当にただそれだけ。