Skip to content

Instantly share code, notes, and snippets.

@wtokuno

wtokuno/eval1.ss

Created October 19, 2016 03:17
Show Gist options
  • Save wtokuno/a7456f814f1401c9629a377cf77deea1 to your computer and use it in GitHub Desktop.
Save wtokuno/a7456f814f1401c9629a377cf77deea1 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment