もっと! ML/Haskell っぽい関数構文

ML や Haskell では、関数を定義する時に、変数だけでなくリテラルやデータ・コンストラクタなどでパターンマッチをすることができますね。

PLT Scheme にも、それによく似た構文があります。

> (require scheme/match)
> (match '(1 . 2)
    ((cons x y) (list x y)))
(1 2)

これを利用して、以前の ML風および Haskell風関数構文を、より本物っぽくする方法を考えてみました。

結果から言うと、こういう関数定義ができるようになります。

> (fact 0 := 1
        n := (* n (fact (- n 1))))
> (fact 5)
120

(Haskell の文法とは少し異なる点に注意してください。関数名を繰り返さなくて済むというメリットを重視したものですが、後述のようにデメリットもあります)


まず、無名関数をパターンマッチに対応させるところから始めましょう。

PLT の match 構文では1つのデータに対するパターンマッチしか定義できないので、2変数以上の関数をパターンマッチ対応にするのはちょっと苦労しそうです。

と思ったんですが、match-let という派生構文と generate-temporaries という関数を使えば簡単でした。

(define-syntax (fn stx)
  (syntax-case stx ()
    ((fn () . expr)
     (syntax/loc stx (begin . expr)))
    ((fn params . expr)
     (stx-every identifier? #'params)
     (curry (syntax/loc stx (lambda params . expr))))
    ((fn (param ...) . expr)
     (with-syntax (((g ...) (generate-temporaries #'(param ...))))
       (curry
        (syntax/loc stx
          (lambda (g ...)
            (match-let ((param g) ...) . expr))))))))

パターンを直接 lambda の変数リストの中に置くことはできないので、一旦パターンに対応する一時変数を用意しておき (generate-temporaries)、それを lambda の変数リストにするんです。

そして match-let により、元のパターンと受け取った引数の組のリストを平行してマッチしていきます。

テスト

> ((fn ((cons x y))
     (list x y))
   '(1 . 2))
(1 2)

cons によるパターンマッチを関数のパラメータとしている例です。Haskell だと \(x:y) -> という風に書くところですね。

もちろん普通の変数をパラメータにすることもできます。

> ((fn ((cons x y) z)
     (list x y z))
   '(1 . 2) 3)
(1 2 3)
> (((fn ((cons x y) z)
      (list x y z))
    '(1 . 2))
   3)
(1 2 3)

(カリー化もばっちり!)


さて次に関数定義の構文なんですが、これまで導入を見送ってきた複数の節でのパターンマッチをサポートしてみましょう (Haskell 風構文との整合性もあるので fn ではサポートしません)。

節の区切りには ML と同じく縦棒を使いたいんですが、Scheme (Lisp) ではこれは特別な意味を持つ文字なので、そのまま使うことはできません。

> (string->symbol "|")
\|

というわけで、バックスラッシュでエスケープする必要がありますね。

(fun (fact 0) 1
  \| (fact n) (* n (fact (- n 1))))

という定義ができるようにしましょう。

(define-syntax fun
  (let ((vbar? (same-id? '\|))
        (cl:name
         (lambda (clause)
           (car (syntax-e (car clause)))))
        (cl:params
         (lambda (clause)
           (cdr (syntax-e (car clause)))))
        (cl:body cdr))
    (lambda (stx)
      (syntax-case stx ()
        ((fun . clauses)
         (stx-any vbar? #'clauses)
         (let ((clauses (stx-break* vbar? #'clauses)))
           (with-syntax ((name
                          (cl:name
                           (foldl (lambda (x y)
                                    (or (and (= (length (cl:params x))
                                                (length (cl:params y)))
                                             (free-identifier=? (cl:name x)
                                                                (cl:name y))
                                             y)
                                        (raise-syntax-error
                                         #f "malformed definition" stx)))
                                  (car clauses)
                                  (cdr clauses))))
                         (temps
                          (generate-temporaries (cl:params (car clauses)))))
             (quasisyntax/loc stx
               (define name
                 (fn temps
                   #,(let loop ((cl (car clauses))
                                (rest (cdr clauses)))
                       (let ((binds
                              (map list
                                   (cl:params cl)
                                   (stx->list #'temps)))
                             (body (cl:body cl)))
                         (if (stx-every identifier? (cl:params cl))
                             ;; No error handlers needed; ignore rest of
                             ;; clauses, if any
                             #`(let #,binds #,@body)
                             #`(with-handlers ((exn:misc:match?
                                                (lambda (x)
                                                  #,(if (pair? rest)
                                                        (loop (car rest)
                                                              (cdr rest))
                                                        #'(raise x)))))
                                 (match-let #,binds
                                   #,@body)))))))))))
        ((fun (name . params) . expr)
         (syntax/loc stx
           (define name (fn params . expr))))))))

最初の節でマッチに失敗したら例外を捕えて次の節を試す、という流れをお馴染みの再帰で組み立てています。

以下は縦棒で区切られた節を集める関数です (stx-break*)。

(require (only-in srfi/1 break))

(define (stx-break p? stx)
  (receive (l r)
      (break p? (if (syntax? stx)
                    (syntax->list stx)
                    stx))
    (values l
            ;; remove separator
            (if (pair? r) (cdr r) '()))))

(define (stx-break* p? stx)
  (let loop ((l stx) (r '()))
    (if (stx-null? l)
        (reverse r)
        (receive (x y) (stx-break p? l)
          (loop y (cons x r))))))

これで ML 版の関数構文は完成です。

次に Haskell 版ですが、これは元々 ML 版の糖衣構文だったので楽勝だろうと思いきや、以外とてこずってしまいました。

無名関数は変更無しなので関連部分のみ示します。

(require (only-in scheme/list add-between))

(define declare? (same-id? ':=))

(define-syntax (app-fun stx)
  (syntax-case stx ()
    ((app-fun n . e)
     (stx-any declare? #'e)
     ;; Convert
     ;;   (fact 0 := 1
     ;;         n := (* n (fact (- n 1))))
     ;; =>
     ;;   (fun (fact 0) 1
     ;;     \| (fact n) (* n (fact (- n 1))))
     (quasisyntax/loc stx
       (fun
           #,@(apply append
                     (add-between
                      (map (lambda (x)
                             (list (cons #'n (car x))
                                   (cdr x)))
                           (let loop ((l (syntax->list #'e)) (r '()))
                             (if (null? l)
                                 (reverse r)
                                 (receive (v e) (stx-break declare? l)
                                   (if (null? e)
                                       (raise-syntax-error
                                        #f "Malformed definition" stx)
                                       (loop (cdr e)
                                             (cons (cons v (car e))
                                                   r)))))))
                      '(\|))))))
    [snip]))

中置記法の := では上で作った stx-break* が役に立たないことに気付き、愕然としたのがてこずった理由です。

また、ML 版と違い、関数のボディーには1つの式しか置けないという制限も生じました (前の実装には無かった制限です)。ボディー部分と次の節の変数リストとの区切りが無いため、やむを得ない措置です。


ファイル:
mlfun.ss
hasfun.ss
hasfun-helper.ss
arcfun.ss