J-Bobを作ってみよう(3) 関数定義、関数適用、REPL

さていよいよ関数定義と関数適用です
よく覚えていないのでとりあえず雑に書いてみます
J-Bobではクロージャとか考えなくてもよさそうな気がしている

まずは関数定義
J-Bobのdefunは式一つ書ければいいんだよな・・・？

(define env '())
(define (addfunc name args body)
  (set! env (cons (list name args body) env)))

雑ですね

これだけでは何もわからないので関数適用も書いてみます
こっちはさすがにちょっと複雑かな

関数適用は
関数本体を探してきて、仮引数を実引数に置き換えて、evalしなおす、
みたいな感じでいける？
こう？

(define (findfunc name)
  (car (member name env (λ (x y) (equal? x (car y))))))

(define (subst e v a)
  (cond ((null? e) '())
        ((atom? e)
         (if (equal? e v) a e))
        (else (cons (subst (car e) v a)
                    (subst (cdr e) v a)))))

(define (japply name args)
  (jbob
   (let* ((f (findf name))
          (vars (cadr f)))
     (let loop ((vars vars)
                (args args)
                (res (caddr f)))
       (if (null? vars)
           res
           (loop (cdr vars) (cdr args)
                 (subst res (car vars) (car args))))))))

japplyがちょっとごちゃっとした感じだけど別にたいしたことはしていない

あとjevalに手を入れてと
dethmはdefunと同じだったから・・・

          ((or (eq? op 'defun) (eq? op 'dethm))
           (addfunc (cadr e) (caddr e) (cadddr e)))
          (else (japply op (cdr e)))

動かしてみよう

> (jeval '(defun tcons (x y) (cons x y)))
> env
'((tcons (x y) (cons x y)))
> (jeval '(tcons 'a 'b))
'(a . b)

お、動くぞ？

> (jeval '(defun len (x)
            (if (atom x)
                '0
                (+ '1 (len (cdr x))))))
> (jeval '(len '(a b c)))
3

お？
なんか動く？

毎回jevalと打つのも面倒なので即席REPLを

(define (repl)
  (printf ">> ")
  (printf "~a~n" (jeval (read)))
  (repl))

動かす

> (repl)
>> (cons 'a 'b)
(a . b)
>> (defun len (x)
     (if (atom x)
         '0
         (+ '1 (len (cdr x)))))
#<void>
>> (len '(a b c))
3

まあまあそれっぽい

なお、readには親切な編集機能はないので上のインデント等は手動で修正したりしてます
結局面倒だったり

> (repl)
>> (defun member? (x ys)
     (if (atom ys)
         'nil
         (if (equal x (car ys))
             't
             (member? x (cdr ys)))))
#<void>
>> (defun set? (xs)
     (if (atom xs)
         't
         (if (member? (car xs) (cdr xs))
             'nil
             (set? (cdr xs)))))
#<void>
>> (defun add-atoms (x ys)
     (if (atom x)
         (if (member? x ys)
             ys
             (cons x ys))
         (add-atoms (car x)
                    (add-atoms (cdr x) ys))))
#<void>
>> (dethm set?/add-atoms (a bs)
     (if (set? bs)
         (equal (set? (add-atoms a bs)) 't)
         't))
#<void>
>> (add-atoms '(a (b c)) '(b))
(a c () b)
>> (set?/add-atoms '(a (b c)) '(b))
t

おおおお
もしかしてこれでできてるの？
(add-atomsの結果が一瞬ハテナだけどこれはこういうものな気がする)
早すぎない？

なんか変数を環境に入れたりとかやってなかったかな
関数の引数としてしか出てこないからこれで足りちゃうのか？