scheme-interpreter-story/interpret.scm

#lang racket

(require racket/match)

(require "utilities.scm")
(require "box.scm")
(require "environment.scm")
(require "syntax.scm")

(provide interpret-program)

;;; interpreter
;;

(define (interpret-program prg env)
  (if (null? prg)
      #t
      (match (car prg)
	((list (syx 'id 'define meta-1) (syx 'id name meta-2) exp)
	 (update-env! env (make-binding name (interpret-exp exp env)))
	 (interpret-program (cdr prg) env)))))

(define (interpret-exp exp env)
  (cond ((syx-atomic? exp) (syx-data exp))
	((syx-id? exp) (env-ref (syx-id exp) env))
	((null? exp) '())
	((and (pair? exp) (syx-special? (car exp)))
	 (interpret-special exp env))
	((pair? exp)
	 (apply (interpret-exp (car exp) env)
		(map (lambda (e) (interpret-exp e env)) (cdr exp))))
	(else (error "interpret-exp: unknown syntax" exp))))

(define (interpret-special exp env)
  (match exp

    ((list (syx 'special 'lambda meta) params body)
     (let ((param-names (map syx-id params)))
       (lambda args
	 (let ((env (extend-env* env (map make-binding param-names args))))
	   (interpret-exp body env)))))

    ((list* (syx 'special 'begin meta) stmts)
     (let loop ((stmts stmts))
       (if (null? (cdr stmts))
	   (interpret-exp (car stmts) env)
	   (begin
	     (interpret-exp (car stmts) env)
	     (loop (cdr stmts))))))

    ((list (syx 'special 'if meta) t c a)
     (if (interpret-exp t env)
	 (interpret-exp c env)
	 (interpret-exp a env)))

    ((list (syx 'special 'quote meta) d)
     d)

    (else (error "invalid syntax in interpret special" exp))))