flet & labels in Scheme

ループ処理を書く時などに、全く同じ関数呼び出しを複数回書くことがあると思うんですが、それがどうも面倒*1なので、ローカル関数を手軽に作る構文を書いてみました。

マクロ:

(require "mlfun.ss")

(define-syntax define-flet
  (syntax-rules ()
    ((define-flet flet let)
     (define-syntax flet
       (syntax-rules ()
         ((flet ((name params . expr) (... ...)) . body)
          (let ((name (fn params . expr)) (... ...)) . body)))))))

(define-flet flet let)
(define-flet flet* let*)
(define-flet fletrec letrec)            ;`labels' in CL

(関数は lambda でも良いんですが、自動カリー化とかパターンマッチを組み込んである自作の fn を使っています)

例:

(fun (read-header in)
  (fletrec ((line () (read-line in 'any))
            (loop (l r)
              (if (string=? l "")
                  (reverse r)
                  (loop (line) (cons l r)))))
    (loop (line) '())))

追記:

let での変数のバインディングと flet のそれとではアリティーが違うことに着目して、変数と関数を両方バインドできるようにしてみました。

(define-syntax define-flet
  (syntax-rules ()
    ((define-flet flet let)
     (define-syntax (flet stx)
       (syntax-case stx ()
         ((flet loop . rest)
          (and (identifier? #'loop)
               (eq? (syntax->datum #'let) 'let))
          (syntax/loc stx
            (let loop . rest)))
         ((flet (bind (... ...)) . body)
          (quasisyntax/loc stx
            (let #,(map (lambda (x)
                          (syntax-case x ()
                            ((v e) x)
                            ((v p . e)
                             (syntax/loc x
                               (v (fn p . e))))))
                        (syntax->list #'(bind (... ...))))
              . body))))))))

モジュールのエクスポート時に flet を let にリネームすれば、let と flet の構文を統合することが出来ますね。

追記2:

let で関数束縛の構文を使った際に emacs でラムダっぽくインデントするようにしてみました。

(defadvice scheme-indent-function (after flet-hack activate)
  (unless ad-return-value
    (setq ad-return-value
          (scheme-indent-flet (ad-get-arg 0) (ad-get-arg 1)))))

(defun scheme-indent-flet (indent-point state)
  (goto-char (elt state 2))
  (when (and (eq (char-after) ?\()                 ;start of params
             (< (progn (forward-sexp 1) (point))   ;end of params
                indent-point))
    (condition-case ()
        (progn
          (backward-up-list 3)
          (forward-char 1)
          (when (and (looking-at "\\=let")
                     (< indent-point
                        ;; end of binding
			(progn (forward-sexp 2) (point))))
            (goto-char (elt state 1))
            (+ (current-column) lisp-body-indent)))
      (error nil))))

実は cl-indent.el で flet をどうやってインデントしているか調べようとしたんですが、難し過ぎて諦めかけました。

ライブラリ:
mlfun.ss

*1:インターナルdefineを使う方も多いと思うんですが、それだとdefineを何度も書くのが面倒、letだとlambdaを書くのが面倒、ということです