;;;; Evaluator for Scheme-1.
;;;; This file can be loaded into Scheme as a whole.
;;;; Then you can initialize and start the evaluator by evaluating
;;;; the expression (read-eval-print).
;;; Scheme-1:
;;; * Only numbers, strings, #t, and #f are valid self-evaluating
;;; (literal) forms.
;;; * Only the following special forms are defined:
;;; if, cond, lambda, quote, define
;;; and define is only allowed at the outer level---no
;;; defines inside lambdas.
;;; * The following primitive procedures are defined:
;;; car cdr cons null + - * / = > < >= <= list append equal?
;;; number? symbol? procedure?
;;; Since no expression has any side-effects, there is no need for
;;; the begin form, the bodies of lambda expressions consist
;;; of a single expression, as do the consequent clauses of cond
;;; clauses (e.g., so that
;;; (cond ((> i 0)
;;; (* i (f (- i 1)))
;;; (+ i 2))
;;; ... )
;;; is illegal).
;;;
;;;
;;; Several of the functions in this file take two environment
;;; arguments, generally named INNER-ENV and OUTER-ENV (we'll use the
;;; notation INNER-ENV+OUTER-ENV to mean "the environment you'd get by
;;; extending OUTER-ENV with the definitions in INNER-ENV). OUTER-ENV
;;; corresponds to the "outer-level" definitions---the predefined
;;; global environment, plus the results of any 'define' statements in
;;; the program. INNER-ENV contains parameter bindings. Why not just
;;; combine them into one environment? Well, the problem is that we
;;; want the outer environment to change as do more 'define's.
;;; Suppose we have a sequence of definitions like this
;;; (define (g x) (f (+ x 1)))
;;; (define (f x) (if (< x 0) '() ...))
;;; Our intention is that g will use the later definition of f. However,
;;; if we were to expand the definition of g as usual:
;;; (define g (lambda (x) (f (+ x 1))))
;;; and then include the environment at the time we evaluate this
;;; definition in the compound procedure returned by lambda,
;;; that environment would NOT include the definition of f, and we'd have
;;; a problem when it came time to call g.
;;;
;;; To get around this problem, we separate the part of the environment
;;; that EVERYBODY shares (the outer, global environment) from the
;;; parts introduced by parameter lists (which we're calling "inner"
;;; environments). Since by design, only the global environment can
;;; change over time in Scheme-1, we thus get all the flexibility we need.
;;;
;;; In full Scheme, this little trick won't work, because ANY of the
;;; environments can change over time. So to handle the full language,
;;; we're going to have to use still another approach.
;;;
;;; See the NOTES at the end for other implementation details.
;;; PART 1. Main evaluation procedures
;; Assuming that FORM is a valid Scheme-1 expression or 'define' form,
;; returns a cons pair (v . env') where v is FORM's value in the
;; environment ENV and env' is the resulting environment.
;; (ENV and env' will be the same unless FORM is a 'define' form.)
(define (eval-and-extend form outer-env)
(if (eq? (expression-class form) 'define)
(cons 'okay (add-define (operand 1 form) (operand 2 form) outer-env))
(cons (eval-1 form (the-empty-environment) outer-env) outer-env)))
;; The value of Scheme-1 expression EXP in the environment defined by
;; INNER-ENV and OUTER-ENV environment ENV. EXP may not be a 'define'.
(define (eval-1 exp inner-env outer-env)
(let ((kind (expression-class exp)))
(cond ((eq? kind 'self-evaluating) exp)
((eq? kind 'symbol) (lookup-variable-value exp
inner-env outer-env))
((eq? kind 'quote) (operand 1 exp))
((eq? kind 'if) (eval-if (operand 1 exp) (operand 2 exp)
(optional-operand 3 exp)
inner-env outer-env))
((eq? kind 'lambda) (make-procedure (operand 1 exp)
(operand 2 exp)
inner-env))
((eq? kind 'cond) (eval-1 (cond->if exp) inner-env outer-env))
((eq? kind 'pair) (apply-1
(eval-1 (operand 0 exp)
inner-env outer-env)
(map (lambda (e)
(eval-1 e inner-env outer-env))
(operand-list 1 exp))
outer-env))
((eq? kind 'define)
(error "Misplaced define (inside another expression): " exp))
(else
(error "Unknown expression type -- EVAL: " exp)))))
;; Given that the Scheme-1 definition (define HEADER BODY) is valid, and
;; OUTER-ENV is an environment, returns the environment that results from
;; evaluating this definition in OUTER-ENV and extending OUTER-ENV with
;; the resulting binding.
(define (add-define header body outer-env)
(cond ((symbol? header)
(extend-environment header
(eval-1 body (the-empty-environment) outer-env)
outer-env))
((and (pair? header) (symbol? (operand 0 header)))
(add-define (operand 0 header)
(make-lambda (operand-list 1 header) body)
outer-env))
(else (error "Bad definition header: " header))))
;; The value of (if TEST THEN-PART ELSE-PART) in the environment
;; INNER-ENV + OUTER-ENV.
(define (eval-if test then-part else-part inner-env outer-env)
(if (true? (eval-1 test inner-env outer-env))
(eval-1 then-part inner-env outer-env)
(eval-1 else-part inner-env outer-env)))
;; The result of evaluating the list of Scheme-1 expressions and definitions
;; EXPS in environment ENV. The scope of any 'define' forms at the outer
;; level of EXPS is the entire sequence of
;; True iff VALUE is a Scheme-1 value that represents true.
(define (true? value) (not (equal? value #f)))
;;; PART 2. Support for parsing expressions
(define special-form-symbols '(cond if lambda quote define))
;; A symbol indicating what kind of Scheme-1 expression EXP is:
;; symbol For a symbol (identifier)
;; self-evaluating For strings, numbers, and booleans
;; other For other atoms (nil, vectors, etc.)
;; cond, if, lambda, quote, define
;; For expressions whose car is one of these symbols
;; pair For other pairs.
(define (expression-class exp)
(cond ((or (number? exp) (string? exp) (boolean? exp))
'self-evaluating)
((symbol? exp) 'symbol)
((atom? exp) 'other)
((memq (car exp) special-form-symbols) (car exp))
(else 'pair)))
(define (atom? x) (not (pair? x)))
;; Operand (subexpression) number N in the expression EXP, which must
;; be a combination or special form with at least N+1 items.
;; Operands are numbered from 0.
(define (operand n exp)
(list-ref exp n))
;; Operand number N (>= 0) in the expression EXP, which must be a combination
;; or special form. Returns #f (false) if EXP has fewer than N+1 operands.
(define (optional-operand n exp)
(cond ((null? exp) #f)
((eqv? n 0) (car exp))
(else (optional-operand (- n 1) (cdr exp)))))
;; The list of operands (subexpressions) in expression EXP, beginning with
;; operand number N (numbering from 0). EXP must be combination or special
;; form with at least N items. Operands are numbered from 0.
(define (operand-list n exp)
(list-tail exp n))
;;; Part 3. Creating and applying procedures
;; A unique value that marks Scheme-1 closure values.
(define closure-mark (list 'closure))
;; A compound procedure with formal parameters PARAMETERS (a list of
;; symbols), environment ENV, and BODY (a list of 0 or more definitions
;; followed by an expression) as the body.
(define (make-procedure parameters body env)
(list closure-mark parameters body env))
;; Accessors: If P is (make-procedure FORMALS BODY ENV),
;; then (procedure-parameters p) is FORMALS, (procedure-body p) is BODY,
;; and (procedure-environment p) is ENV.
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))
;; True iff PROC is a value produced by make-procedure.
(define (compound-procedure? proc)
(and (pair? proc) (eq? (car proc) closure-mark)))
(define (primitive-procedure? val) (procedure? val))
;; The result of applying PROC, which must be a compound procedure (created
;; by lambda) to the list of values ARGUMENTS, where OUTER-ENV is the current
;; outer (global) environment.
(define (apply-compound-procedure proc arguments outer-env)
(eval-1
(procedure-body proc)
(extend-environment
(procedure-parameters proc) arguments (procedure-environment proc))
outer-env))
;; Apply PROC, which must be a Scheme-1 procedure value (either
;; primitive or compound) to the argument values ARGUMENTS, where OUTER-ENV
;; is the current outer (global) environment.
(define (apply-1 proc arguments outer-env)
(cond ((primitive-procedure? proc) (apply proc arguments))
((compound-procedure? proc)
(apply-compound-procedure proc arguments outer-env))
(else
(error "Attempt to apply something that isn't a function: " proc))))
;;; Part 4. Environments
;;; An environment is a mapping from symbols to Scheme-1 values.
;; Assuming SYMBOLS is the list of symbols (s1 ... sn), VALUES is a
;; list of Scheme-1 values (v1 ... vn), and ENV0 is an environment,
;; the new environment that maps si to vi for i in 1..n, and maps everything
;; else according to ENV0. It is an error if SYMBOLS contains repeated
;; symbols.
(define (extend-environment symbols values env0)
(if (symbol? symbols)
(cons (cons symbols values) env0)
(append (map cons symbols values) env0)))
(define (the-empty-environment) '())
;; The mapping of VAR in ENV0+ENV1. It is an error if VAR is defined
;; in neither ENV0 nor ENV1.
(define (lookup-variable-value var env0 env1)
(let ((match (or (assq var env0) (assq var env1))))
(if match (cdr match)
(error "Undefined variable: " var))))
;;; Part 5. Constructing Scheme-1 expressions.
(define (make-lambda formals body)
(cons 'lambda (list formals body)))
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
;; A Scheme-1 'if' expression that is equivalent to EXP, which must be
;; a valid Scheme-1 'cond' expression.
(define (cond->if exp)
(expand-clauses (operand-list 1 exp)))
;; A Scheme-1 'if' expression that is equivalent to the sequence of
;; clauses CLAUSES, which must be from a valid Scheme-1 'cond' expression.
(define (expand-clauses clauses)
(if (null? clauses)
#f
(let ((first (car clauses))
(rest (cdr clauses)))
(cond ((not (pair? first))
(error "Badly formed cond clause -- COND->IF" first))
((not (eq? (operand 0 first) 'else))
(make-if (operand 0 first)
(operand 1 first)
(expand-clauses rest)))
((null? rest) (operand 1 first))
(else (error "ELSE clause isn't last -- COND->IF" clauses))))))
;;; Part 6. Predefined procedures.
;; A mapping of primitive procedure names to the procedures. We just use
;; Scheme's existing functions as the implementation in most cases, since
;; we are using Scheme's representation of values for Scheme-1's
;; representation. However, look at the definition of procedure?
(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
(list '+ +)
(list '- -)
(list '* *)
(list '/ /)
(list '= =)
(list '< <)
(list '> >)
(list '>= >=)
(list '<= <=)
(list 'list list)
(list 'append append)
(list 'equal? equal?)
(list 'number? number?)
(list 'symbol? symbol?)
(list 'procedure?
(lambda (x) (or (primitive-procedure? x)
(compound-procedure? x))))
;; more primitives
))
;;; To make the global environment, we take the primitive-procedures list
;;; apart again, which may make you ask why we didn't make it two lists
;;; to start with. It's useful, however, both for clarity and to avoid
;;; errors to keep the symbols and their definitions closely paired.
;; The mapping from predefined Scheme-1 symbols to Scheme-1 values.
(define initial-global-environment
(extend-environment
(map car primitive-procedures)
(map cadr primitive-procedures)
(the-empty-environment)))
;;; Part 7. Read-eval-print loop
(define standard-input-prompt "Scheme1> ")
(define standard-output-prompt "")
;; Prompt for, read, evaluate, and print Scheme-1 expressions until
;; or end-of-file is read, using OUTER-ENV as the global environment.
;; INPUT-PROMPT and OUTPUT-PROMPT are issued before each input and output,
;; respectively.
(define (driver-loop input-prompt output-prompt outer-env)
(prompt-for-input input-prompt)
(let ((input (read)))
(if (not (eof-object? input))
(let ((output (eval-and-extend input outer-env)))
(announce-output output-prompt)
(user-print (car output))
(driver-loop input-prompt output-prompt (cdr output))))))
(define (prompt-for-input string)
(display string)
(flush))
(define (announce-output string)
(display string))
(define (user-print object)
(if (compound-procedure? object)
(display (list 'compound-procedure
(procedure-parameters object)
(procedure-body object)))
(display object))
(newline))
;; Read, evaluate, and print Scheme-1 definitions and expressions from
;; the standard input, starting with the standard predefined Scheme-1
;; environment.
(define (read-eval-print)
(display "Scheme-1 Interpreter")
(newline)
(driver-loop standard-input-prompt standard-output-prompt
initial-global-environment))
;; Read, evaluate, and print Scheme-1 definitions and expressions from
;; the file named FILE-NAME, starting with the standard predefined
;; Scheme-1 environment.
(define (read-eval-print-file file-name)
(with-input-from-file file-name
(lambda () (driver-loop "" "" initial-global-environment))))
;;; Part 9. Testing
;; Evaluate the sequence of expressions and definitions SEQ starting with
;; the predefined environment, yielding the list of resulting values.
(define (eval-1-seq seq)
(define (eval-loop seq outer-env)
(if (null? seq) '()
(let ((result (eval-and-extend (car seq) outer-env)))
(cons (car result)
(eval-loop (cdr seq) (cdr result))))))
(eval-loop seq initial-global-environment))
;; Given that TESTS is a list of lists, each of the form (INPUT OUTPUT),
;; check that in each case, the evaluation of (PROC INPUT) yields OUTPUT
;; (using equal? to check).
(define (test-proc proc tests)
(if (not (null? tests))
(let* ((input (caar tests))
(output (cadar tests))
(result (proc input)))
(if (not (equal? result output))
(format (current-output-port)
"Error: input ~a yields ~a instead of ~a~%"
input result output))
(test-proc proc (cdr tests)))))
;;; Part 8. NOTES:
;;; Representing Scheme Values
;;; It's convenient (actually, kind of obvious) to represent most Scheme-1
;;; values "as themselves". Thus, the Scheme values used in the evaluator
;;; to represent all Scheme-1's values other than closures (i.e., the
;;; results of evaluating lambda expressions) will be those values
;;; themselves: evaluating 3 in Scheme-1 yields 3, (cons 1 2),
;;; yields (1 . 2), and so forth.
;;;
;;; For lambda, we have a little problem. You might think we could
;;; simply represent result of evaluating (lambda (x) x) as the list
;;; (lambda (x) x), but then how do we tell the value of
;;; (lambda (x) x)
;;; from the value of
;;; (list 'lambda (list 'x) 'x)
;;; or of
;;; '(lambda (x) x) ?
;;; So in Scheme-1, we're going to "mark" closures with a special value,
;;; closure-mark, defined below. This value will have the property that
;;; no value a user can produce with a Scheme-1 program can be eq? to it.
;;; We will represent a Scheme-1 closure value, then, with a Scheme list
;;; of the form
;;; ( (ARGUMENTS) BODY ENV),
;;; where here stands for the value of closure-mark. ENV is
;;; the inner environment at the time the lambda is evaluated (that is,
;;; enclosing parameter definitions, but not the outer environment, which
;;; contains predefined names and the results of 'defines').