;; an interpreter for instructions for a simple stack machine

;; interp takes two arguments:
;;  a list of instructions - the program to execute
;;  a list of numbers - the stack to start with
;; and returns a list of numbers - the final stack

;; instructions can be
;; (push n) where n is a number - pushes n onto the stack
;; add - pops the top two numbers from the stack, adds them, and pushes the 
;;       result onto the stack 
;; sub - as above, but subtracts 
;; mul - as above, but multiplies

(defun interp (instr stack) 
  (if (null instr)
      ;; there are no more instructions so return the stack
      stack
    (let ((ins (car instr)) ;; ins is the first instruction to execute
	  (rest (cdr instr))) ;; rest is the remaining instructions
      (cond (
    ;; deal with an add instruction
    (eq ins 'add) (interp rest (cons (+ (car stack) (cadr stack)) (cddr stack)))) 
    ;; deal with a sub instruction
	    ((eq ins 'sub) (interp rest (cons (- (cadr stack) (car stack)) (cddr stack))))
    ;; deal with a mul instruction
	    ((eq ins 'mul) (interp rest (cons (* (car stack) (cadr stack)) (cddr stack)))) 
    ;; consp tests for non-empty lists. 
    ;; the only valid instruction which is a non-empty list 
    ;; is a push
	    ((consp ins) (interp rest (cons (cadr ins) stack))) 
	    )
      )
    )   
  )

;; compile expressions to lists of instructions

(defun compilexp (expr)
   (if (numberp expr) 
       (list (list 'push expr))
       (concatenate (compilexp (cadr expr))        
           (compilexp (caddr expr))
          (translate (car expr)))
    )
)

; helper function for the above to deal with the operations
(defun translate (op) 
  (cond ((eq op '+) (list 'add))
	((eq op '*) (list 'mul))
	((eq op '-) (list 'sub))
	)
)

;; put it all together: take an expression, compile it
;; and then evaluate it using the interpreter

(defun evalexp (expr) 
  (car (interp (compilexp expr) ()))
)