scheme-interpreter-story/initial-work/i6.scm

#lang racket

(require racket/match)

(define builtins
  `((car . ,car)
    (cdr . ,cdr)
    (cons . ,cons)
    (list . ,list)
    (list . ,list?)
    (null? . ,null?)
    (+ . ,+)
    (- . ,-)
    (* . ,*)
    (/ . ,/)
    (= . ,=)
    (eq? . ,eq?)
    (equal? . ,equal?)
    (not . ,not)
    ;;
    (display . ,display)
    (newline . ,newline)
    (print . ,(lambda (s) (display s) (newline)))
    ))

(define special-forms
  '(lambda if quote begin and or))

(define (ex prg builtins spec)
  ;; a program is a list of definitions
  (if (null? prg)
      #t
      (match (car prg)
	(`(define ,name ,source)
	 (let ((value (i source builtins spec)))
	   (ex (cdr prg)
	       (cons (cons name value) builtins)
	       (remove name spec)))))))

(define (i exp env spec)
  (cond ((number? exp) exp)
	((boolean? exp) exp)
	((symbol? exp)
	 (cond ((assoc exp env) => cdr)
	       (else (error "unbound variable" exp))))
	((list? exp)
	 (if (member (car exp) spec)
	     (i-special exp env spec)
	     (apply (i (car exp) env spec)
		    (map (lambda (exp) (i exp env spec)) (cdr exp)))))
	(else (error "unknown expression type" exp))))

(define (i-special exp env spec)
  (match exp

    (`(if ,t ,c ,a)
     (if (i t env spec)
	 (i c env spec)
	 (i a env spec)))

    (`(lambda (,x) ,b)
     (lambda (y)
       (i b (cons (cons x y) env) (remove x spec))))

    (`(quote ,d)
     d)

    (`(begin)
     (error "bad begin"))
    (`(begin ,thing . ,things)
     (let loop ((thing thing) (things things))
       (if (null? things)
           (i thing env spec)
           (begin
             (i thing env spec)
             (loop (car things) (cdr things))))))

    (`(and . ,things)
     (let loop ((things things))
       (if (null? things)
	   #t
	   (if (i (car things) env spec)
	       (loop (cdr things))
	       #f))))

    (`(or . ,things)
     (let loop ((things things))
       (if (null? things)
	   #f
	   (if (i (car things) env spec)
	       #t
	       (loop (cdr things))))))

    (else (error "Unimplemented special form:" exp))))

(define t1
  (list '(define n1 1)
	'(define n2 2)
	'(define n3 (+ n1 n2))
	'(define f (lambda (x) (* x x)))
	'(define main (print (f n3)))))

;; > (i '(begin (print 1) (print 2) (print 3)) builtins special-forms)
;; 1
;; 2
;; 3

;; > (ex t1 builtins special-forms)
;; 9
;; #t