kb84tkhrのブログ

何を書こうか考え中です あ、あと組織とは関係ないってやつです 個人的なやつ

lambda作ろう

さてJ-Bob書いてみて意外と書けるもんだなと思ったりしてるところですが
(何か苦労した気もしますが)
せめてlambdaくらいある言語にしてみたいと思いまして
もう1回やってみようと思います
目標レベルはScheme修行のeval程度(ただし継続は除く)

前回同様、いきなりevalから書いてみようと思います

matchてやつを使うと少しコンパクトに書けるんじゃないかなと思ってまして
こんな感じの場合分けを想定しつつリファレンスを見て

  • アトムなら
    • 数なら数字に
    • 文字列なら文字列に
    • シンボルなら変数に
  • アトムでなければ
    • ひとつめの要素が組み込み関数なら組み込み関数に
    • lambdaならクロージャ
    • そうでなければ要素をひと通りevalして、引数に関数(lambda)を適用

お試し

(define (meval e)
  (match e
    ((? number?) e)
    ((? string?) e)
    ((list 'quote arg) arg)
    ((list 'cons arg1 arg2) (cons (meval arg1) (meval arg2)))
    (_ 'error)))

アトムかどうかってあんまり関係なくなった
ちゃんと切り分けてくれるかな

> (meval 1)
1
> (meval "aaa")
"aaa"
> (meval '(quote aaa))
'aaa
> (meval '(cons 1 "aaa"))
'(1 . "aaa")
> (meval '(cons 1 (cons 2 '())))
'(1 2)
> (meval '(quote aaa bbb))
'error

いけるかな
引数の数がマッチしない場合にスルーされてしまうので親切なエラーは出せなさそう
そこまで作り込むことは考えてないのでmatchで行ってみよう

いきなりlambdaに突入してみます
lambdaはあえて雑に

(define (meval e)
  (match e
    :
    ((list 'lambda ,vars body)
     `(lambda ,vars ,body))))

てそのまま返してるだけやん
Scheme手習いでももっと複雑でしたが
足りないところから始めたほうが、ああだからこういうのが必要だったのね、て
なるかなと思いまして

次はlambdaを適用しないとですけど引数の数が可変ですね
...でマッチさせられるようです

(define (meval e)
  (match e
    :
    ((list func args ...)
     (mapply (meval func) (evlis args)))))

今回は関数を適用するとき、関数をいったん評価してlambdaにするため
substfuncではなくて(meval func)を渡してるところが重要な違い

あともひととおり書いて

(define (atom? x) (and (not (pair? x)) (not (null? x))))

(define (evlis args)
  (map (lambda (x) (list 'quote (meval x))) args))

(define (subst-atom vars args a)
  (cond ((null? vars) a)
        ((eq? (car vars) a) (car args))
        (else (subst-atom (cdr vars) (cdr args) a))))

(define (subst vars args body)
  (cond ((null? body) '())
        ((atom? body) (subst-atom vars args body))
        (else (cons (subst vars args (car body))
                    (subst vars args (cdr body))))))

(define (mapply func args)
 (meval (subst (cadr func) args (caddr func))))

試す

> (meval '((lambda (a b) (cons a b)) 1 2))
'(1 . 2)

お、なんだか動いている模様

次はdefineを作りましょう
lambdaができたからScheme風のdefineにします
シンタックスシュガーじゃない方

また雑に
値を取ってくる方もセットで

(define (lookup sym)
  (cadr (assoc sym env)))

(define (meval e)
  (match e
    :
    ((? symbol? e) (lookup e))
    :
    ((list 'define name body)
     (set! env (cons (list name body) env)))
    :

試す

> (meval '(define a 3))
> env
'((a 3))
> (meval 'a)
3
> (meval '(define mycons (lambda (x y) (cons x y))))
> env
'((mycons (lambda (x y) (cons x y))) (a 3))
> (meval '(mycons 'a 'b))
'(a . b)

できてる気がする
あと最低限の組み込み関数を定義して

(define (meval e)
  (match e
    ((? number?) e)
    ((? string?) e)
    ((? symbol? e) (lookup e))
    ((list 'quote arg) arg)
    ((list 'if Q A E)
     (if (meval Q) (meval A) (meval E)))
    ((list 'null? arg)
     (null? (meval arg)))
    ((list 'equal? arg1 arg2)
     (equal? (meval arg1) (meval arg2)))
    ((list 'car arg) (car (meval arg)))
    ((list 'cdr arg) (cdr (meval arg)))
    ((list 'cons arg1 arg2) (cons (meval arg1) (meval arg2)))
    ((list '+ arg1 arg2) (+ (meval arg1) (meval arg2)))
    ((list 'define name body)
     (set! env (cons (list name body) env)))
    ((list 'lambda vars body)
     `(lambda ,vars ,body))
    ((list func args ...)
     (mapply (meval func) (evlis args)))))

matchはいいけどちょっと長すぎな気配
ということは忘れて

試す

> (meval '(define len (lambda (l) (if (null? l) 0 (+ 1 (len (cdr l)))))))
> (meval '(len '(a b c)))
3

ふむ
そして今回は高階関数も書けるはず

> (meval
   '(define map
      (lambda (f l)
        (if (null? l)
            '()
            (cons (f (car l)) (map f (cdr l)))))))
> (meval '(map len '(() (1) (1 2))))
'(0 1 2)

できた