J-Bobを作ってみよう(2) 組み込み関数

組み込み関数も作ればもうちょっとそれっぽい式で遊べるはず
関数が大きくなっていきますがしばらくは何も考えずにcondの下に生やしていって
大きくなりすぎたなと感じてから考えます
でも(car e)くらいはなんとかしたほうがいいな

  (let ((op (car e)))
    (cond ((eq? op 'quote) (cadr e))

ではまずcons、car、cdrから

          ((eq? op 'cons) (cons (jeval (cadr e)) (jeval (caddr e))))
          ((eq? op 'car) (car (jeval (cadr e))))
          ((eq? op 'cdr) (cdr (jeval (cadr e))))

テスト

  (check-equal? (jeval '(cons 'a 'b)) '(a . b))
  (check-equal? (jeval '(car '(a b))) 'a)
  (check-equal? (jeval '(cdr '(a b))) '(b))

入れ子にしても

  (check-equal? (jeval '(cons 'a (cons 'b '()))) '(a b))
  (check-equal? (jeval '(car (cons 'a (cons 'b '())))) 'a)
  (check-equal? (jeval '(cdr (cons 'a (cons 'b '())))) '(b))

大丈夫

equalがあるとifもそれっぽく試せるかな

ところで'tと'nilは何か特別扱いする必要あるのかなあ
ない気がするので何もしないで放置
困ったら考えます方式

#t、#fを't、'nilにするっていうのは時々使いそうな気がするので
ちょっと関数にしておきます

(define (tnil e) (if e 't 'nil))

:
          ((eq? op 'equal)
           (tnil (equal? (jeval (cadr e)) (jeval (caddr e)))))
:

こんな感じ
ifもちゃんと動いてます

  (check-equal? (jeval '(equal 'a 'a)) 't)
  (check-equal? (jeval '(equal 'a 'b)) 'nil)
  (check-equal? (jeval '(if (equal 'a 'a) 'same 'different)) 'same)
  (check-equal? (jeval '(if (equal 'a 'b) 'same 'different)) 'different)

equalが返すべき値が'tであるべきなのか''tであるべきなのか
いまだに混乱したまま
動いてるので進みます

atom、natp、size、+、<はまとめて実装しちゃいます
そろそろjevalのcondが膨れ上がってきたので関数を分割します
(cadr e)とか(caddr e)とかが大量発生してたので組み込み関数を引数の数で分けました
そしてすべての関数を全域にすることを忘れてたのであっちこっっちに手を入れて

#lang racket

(define (tnil x) (if x 't 'nil))
(define (atom? x) (not (pair? x)))
(define (natp? x) (and (integer? x) (>= x 0)))
(define (num x) (if (natp? x) x 0))
(define (size x)
  (if (atom? x)
      0
      (+ (size (car x)) (size (cdr x)) 1)))

(define op1s '(car cdr atom natp size))
(define op2s '(cons equal + <))

(define (op1 op arg)
    (cond ((eq? op 'car)
           (if (pair? arg) (car arg) '()))
          ((eq? op 'cdr)
           (if (pair? arg) (cdr arg) '()))
          ((eq? op 'atom) (tnil (atom? arg)))
          ((eq? op 'natp) (tnil (natp? arg)))
          ((eq? op 'size) (size arg))))

(define (op2 op arg1 arg2)
    (cond ((eq? op 'cons) (cons arg1 arg2))
          ((eq? op 'equal) (tnil (equal? arg1 arg2)))
          ((eq? op '+) (+ (num arg1) (num arg2)))
          ((eq? op '<) (tnil (< (num arg1) (num arg2))))))
          
(define (jeval e)
  (let ((op (car e)))
    (cond ((member op op1s)
           (op1 op (jeval (cadr e))))
          ((member op op2s)
           (op2 op (jeval (cadr e)) (jeval (caddr e))))
          ((eq? op 'quote) (cadr e))
          ((eq? op 'if)
           (if (eq? (jeval (cadr e)) 'nil)
               (jeval (cadddr e))
               (jeval (caddr e)))))))