eval1.ss

#!r6rs

;; John McCarthy:
;; Recursive Functions of Symbolic Expressions and Their Computation by Machine, Part I. 184-195
;; http://dblp.org/rec/journals/cacm/McCarthy60

;; Paul Graham
;; The Roots of Lisp
;; http://www.paulgraham.com/rootsoflisp.html

(import (rnrs) (srfi :78))

(define (eval e a)
  (cond
    [(symbol? e) (cdr (assq e a))]
    [(symbol? (car e))
     (case (car e)
       [(quote) (cadr e)]
       [(symbol?) (symbol? (eval (cadr e) a))]
       [(eq?) (eq? (eval (cadr e) a)
                   (eval (caddr e) a))]
       [(car) (car (eval (cadr e) a))]
       [(cdr) (cdr (eval (cadr e) a))]
       [(cons) (cons (eval (cadr e) a)
                     (eval (caddr e) a))]
       [(if) (if (eval (cadr e) a)
                 (eval (caddr e) a)
                 (eval (cadddr e) a))]
       [else (eval (cons (cdr (assq (car e) a)) (cdr e)) a)])]
    [(eq? (caar e) 'rec)
     (eval (cons (caddar e) (cdr e))
           (cons (cons (cadar e) (car e)) a))]
    [(eq? (caar e) 'lambda)
     (eval (caddar e)
           (append (map cons
                        (cadar e)
                        (map (lambda (e) (eval e a)) (cdr e)))
                   a))]
    [else (error 'eval "invalid expr" e)]))


(check (eval 'x '((x . a) (y . b))) => 'a)
(check (eval '(eq? 'a 'a) '()) => #t)
(check (eval '(cons x '(b c)) '((x . a) (y . b))) => '(a b c))
(check (eval '(if (symbol? x) 'atom 'list)
             '((x . '(a b))))
       => 'list)
(check (eval '(f '(b c))
             '((f . (lambda (x) (cons 'a x)))))
       => '(a b c))
(check (eval '((rec first-symbol
                 (lambda (x)
                   (if (symbol? x) x (first-symbol (car x)))))
               y)
             '((y . ((a b) (c d)))))
       => 'a)
(check (eval '((lambda (x y) (cons x (cdr y)))
               'a
               '(b c d))
             '())
       => '(a c d))

(check-report)