let.el -- Lisplet Evaluator for Teaching

This is a simple evaluator for lisp and similar languages, designed for teaching and experimentation about programming language implementations.

Copyright (C) 1993 The Harlequin Group.
This was written as an odd-moments activity by John Sturdy at Harlequin Ltd (john@cb1.com); the copyright belongs to Harlequin. You may pass copies around, so long as you keep this copyright notice intact.

It is written to run on GNUemacs, although it should work on almost any lisp system.

Lesson 2

Before reading this file, you should have read the file islet.el, which provides an introduction to lisp sufficient for understanding this file.

First, we develop a very simple evaluator, and later do a more sophisticated one.

We are going to write a function that behaves like the built-in eval function shown in the previous file. It will take one argument, which can be of any type... so the first thing the function must do is switch on the type of its argument. We'll do this with a cond form, which will distinguish between variables to look up, operator calls to evaluate, numeric constants to pass on, and so forth. And about that variable lookup... we'll need something to look them up in: this is called the environment in programming language parlance. It's possible to have lots of environments for different things, but for now we'll just have one for variables. In the previous file we saw a function for doing lookup; it is assoc, and it works on association lists. To start things off, we'll make an environment pre-loaded with some variables, a (which will contain 1 initially), b (which will contain 2) and so on...

(setq environment '( (a . 1)
		     (b . 2)
		     (c . 4)
		     (d . 8)))

Now we can start the evaluator function itself:

(defun naive-eval (arg)
  ;; we decide what to do with the form mostly by looking at its type:
   ;; the first few types evaluate to themselves; that is, they are constants:
   ((eq arg nil) arg)
   ((eq arg t) arg)
   ((integerp arg) arg)
   ((stringp arg) arg)
   ;; symbols (variable names) are looked up in the environment
   ((symbolp arg) (let ((pair (assoc arg environment)))
		     (if pair
			 (cdr pair)
		       (error "No such variable in my environment: %s" arg))))
   ;; lists might be a "special form" like "if"; or a function call
   ((listp arg) (let ((operator (car arg))
		       (arguments (cdr arg)))
		    ((eq operator 'quote) (car arguments)) ; unevaled, remember
		    ((eq operator 'if) (if (naive-eval (nth 0 arguments))
					    (naive-eval (nth 1 arguments))
					  (naive-eval (nth 2 arguments))))
		    ;; that's dealt with all the special forms! now do the ones which
		    ;; require all their arguments evaluated:
		    (t			; that means you! ie default case of cond
		     (let ((arguments (mapcar 'naive-eval arguments)))
			((eq operator '+) (+ (nth 0 arguments)
					     (nth 1 arguments)))
			((eq operator '-) (- (nth 0 arguments)
					     (nth 1 arguments)))
			((eq operator '=) (= (nth 0 arguments)
					     (nth 1 arguments)))))))))))

That's a very small subset of the language... I've left interesting things like let and setq out; for now I just wanted to show you how simple it is in principle! Try it out on a few things before we go on:

(naive-eval 1)
(naive-eval '(+ 2 3))
(naive-eval '(if (= a 1) 7 b))		; remember a,b,c,d are predefined
					; in the environment

Having shown how simple it is in principle, we now go on to do a version with all the special forms defined. We also take a short cut: note how all the operators like +, - above are implemented by calling the corresponding function in the underlying Lisp system; we will just punt straight down a level for those, by using apply. That also lets us pass an arbitrary number of arguments on to them without having to do a loop accumulating the sum for + and so on. We'll just pass on anything I'm not interested in explaining to you at the moment, down to emacs-lisp for it to deal with. The idea is that you should get the idea...

(provide 'let) ; this will be explained later!

;; remove any old definitions first ; this will be explained later!
(mapcar 'makunbound '(languages:lisp-special-forms

environment handling

The collection of variables accessible at some point in the program is called the environment.

We store the environment in an association list (as described in the previous chapter) in which the variable names are the keys, and the values bound to the names are the values.

If assoc, which eval::lookup calls, finds no pair (ie no binding) it returns nil; otherwise it returns the value found. This is not quite the semantics we always want, as it does not let us distinguish between nil being bound and there being no binding.

;;; {paragraphs about this to go here}

(defun eval::lookup (key env)
  "Look KEY up in ENV."
  (let* ((vp (assoc key env)))
    (if vp
	(cdr vp)

(defun eval::bind (environment key value)
  "Add to ENVIRONMENT a binding of KEY to VALUE."
  (rplacd environment
	  (cons (cons key
		(cdr environment)))

(defun eval::update (environment key value)
  "In ENVIRONMENT replace the value bound to KEY by VALUE."
  (let* ((pair (assoc key environment)))
    (if pair
	(rplacd pair value)
      (error "Cannot assign to %s, no existing binding" key)))

(defun eval::environment-bindings (environment)
  "Return the binding list of ENVIRONMENT."
  (cdr environment))

(defun eval::make-environment (bindings)
  "Make the binding list BINDINGS into an environment."
  (cons 'eval::environment bindings))

(defun eval::new-environment ()
  "Make a new, empty environment."
   (eval::make-environment nil))

;;;; the plain evaluator
;;; {paragraphs about this to go here}

(defun eval:plain-eval (evaluand)
  "Evaluate EVALUAND in the current context, in a plainly lispy manner."
   ((or (eq evaluand t) (null evaluand)
	(integerp evaluand)
	(vectorp evaluand)
	(stringp evaluand))
   ((consp evaluand)
    (let* ((operator-name (car evaluand))
	   (operator-special-form  (eval::lookup
	   (arglist (cdr evaluand)))
      (if operator-special-form
	  (funcall operator-special-form
	(let* ((operator-procedure (eval::lookup
	  (if operator-procedure
	      (funcall operator-procedure
		       (mapcar 'eval:eval arglist))
	    (error "%s not defined in current language" operator-name))))))
   ((symbolp evaluand)
    (eval::lookup evaluand eval-context::environment))
   (t (error "No way to evaluate %s" evaluand))))

(defun eval::eval (evaluand)
  "Evaluate EVALUAND in the current context."
  (funcall eval-context::evaluator evaluand))

;;;; operator definition mechanisms
;;; {paragraphs about this to go here}

(defun eval::define-operator-internal (language name args bodyrest)
  "Make an operator definition in a language."
  (eval::bind language name (list 'lambda args bodyrest)))

(defmacro eval::define-operator (language name args &rest body)
  "Sweetener for eval::define-operator-internal."
  (list 'eval::define-operator-internal
	(list 'quote name)
	(list 'quote args)
	(list 'quote (cons 'progn body))))

(defun eval::clone-lisp-procedures (procedure-list)
  "Make evaluator primitives for the lisp operators given in PROCEDURE-LIST."
  (mapcar (function (lambda (procname)
		      (eval::bind languages:lisp-procedures
				  (list 'lambda '(arglist)
					(list 'apply (list 'quote procname) 'arglist)))))

;;;; a language to start off with: a simple dialect of Lisp
;;; {paragraphs about this to go here}

(defvar languages:lisp-special-forms (eval::new-environment)
  "The special forms of a lisp-like language for the evaluator.")

(defvar languages:lisp-procedures (eval::new-environment)
  "The procedures of a lisp-like language for the evaluator.")

;;;; useful code for implementing lisp operators:
;;; {paragraphs about this to go here}

(defun eval::add-bindings (new-bindings extant-bindings)
  "Add each binding in NEW-BINDINGS to the alist EXTANT-BINDINGS."
  (if new-bindings
      (let* ((new-binding-pair (car new-bindings)))
	 (cdr new-bindings)
	 (cons (cons (car new-binding-pair)
		     (eval::eval (car (cdr new-binding-pair))))

(defun eval::eval-forms (forms)
  "Evaluate each of FORMS, returning the value of the last one."
  (if (null forms)
    (let* ((this-result (eval:eval (car forms)))
	   (remaining-forms (cdr forms)))
      (if (null remaining-forms)
	(eval::eval-forms remaining-forms)))))

(defun eval::cond-internals (cond-body)
  "Recursive evaluator for COND-BODY."
  (if (null cond-body)
    (let* ((this-cond (car cond-body)))
      (if (eval::eval (car this-cond))
	  (eval::eval-forms (cdr this-cond))
	(eval::cond-internals (cdr cond-body))))))

;;;; lisp operator definitions
;;; {paragraphs about this to go here}

;   we make a batch of standard things that simply call the
;   corresponding function in the host lisp system:

 '(cons car cdr
   list assoc rplaca rplacd append reverse nreverse
   + - * / = < >
   or and not
   eq equal
   null integerp vectorp stringp consp symbolp vectorp
   vector make-vector aset aref
   funcall apply mapcar

 let* (let*-body)
 (let* ((binding-list (car let*-body))
	(body-forms (cdr let*-body))
	   binding-list (eval::environment-bindings
   (eval::eval-forms body-forms)))

 if (if-body)
 (let* ((condition (car if-body))
	(cases (cdr if-body))
	(true-case  (car cases))
	(false-case (car (cdr cases))))
   (if (eval::eval condition)
       (eval::eval true-case)
     (eval::eval false-case))))

 cond (cond-body)
 (eval::cond-internals cond-body))

 progn (progn-body)
 (eval::eval-forms progn-body))

;;;; initial evaluation environment
;;; {paragraphs about this to go here}

(defvar eval-context::environment (eval::new-environment)
  "The environment of the current context.")

(defvar eval-context::language-special-forms languages:lisp-special-forms
  "The special forms of the language of the current context.")

(defvar eval-context::language languages:lisp-procedures
  "The procedures of the language of the current context.")

(defvar eval-context::evaluator (symbol-function 'eval:plain-eval)
  "The current evaluator.")

;;; {paragraph about loading and running this to go here}

; end of let.el

John C. G. Sturdy
[John's home] Last modified: Sun Jun 10 21:39:56 GMT Daylight Time 2007