Hide Login/Register to vote and to have access to more features

You are here: Root > Software > Development > Examples

A Hardware Lisp Interpreter by Frank Buss
Created by stuart on: Sat, 17 Jun 2006 23:07:23 GMT, Last modification: Sat, 17 Jun 2006 23:07:23 GMT

Frank Buss wrote: "My goal is to write an interpreter, which uses a state machine and not the Common Lisp call stack, because then it is easier to translate it to VHDL. I think I can simplify the source below a bit, but I like some ideas, which are inspired from SECD and other implementations."

This message has been archived on Google Groups

From: Frank Buss 
Subject: a hardware Lisp interpreter
Newsgroups: comp.lang.lisp
Message-ID: 
Date: Sat, 17 Jun 2006 03:20:49 +0200
Organization: IT4 Systems GmbH & Co. KG

My goal is to write an interpreter, which uses a state machine and not the
Common Lisp call stack, because then it is easier to translate it to VHDL.
I think I can simplify the source below a bit, but I like some ideas, which
are inspired from SECD and other implementations:

- there is a variables stack, which stores variable/value pairs, where the
car of a pair is the variable name and the cdr is the value.

- functions are stored in the form (parameterlist . body), e.g. ((list) .
(car (cdr list))) for the cadr function

- if a list instead of a symbol is the car of an expression, it is
interpreted as a function, so you could write this:
(@eval '(((a b) . (cons a b)) 1 2))
and it returns (1 . 2). This is the same like "lambda". I wonder why Common
Lisp has an extra lambda macro for this?

I think with the lambda construct in theory it should be possible to define
a "let" semantic and with this you can write everything you need. But I'll
add a "let" operator (with implicit progn) and a "set" function, to make
programming for this system a bit easier.

What do you think about it?


(defun test ()
  (assert (equalp 1 (@eval 1)))
  (assert (equalp 3 (@eval '(car (cdr (cdr '(1 2 3)))))))
  (assert (equalp '(1 . 2) (@eval '(cons 1 2))))
  (assert (equalp '(1 . 2) (@eval '(((a b) . (cons)) 1 2)))))

(defparameter *variables* nil)
(defparameter *data-stack* nil)
(defparameter *state-stack* nil)
(defparameter *eval-stack* nil)
(defparameter *state* nil)
(defparameter *eval-state* nil)
(defparameter *expression* nil)
(defparameter *stop* nil)

(defun lookup-variable (search-name)
  (loop for (name . value) in *variables* do
        (when (eql name search-name)
          (return-from lookup-variable value))))

(defstruct eval-state
  parameters
  parameter-names
  parameter
  parameter-name
  body
  variables-before-function
  variables-for-function
  function-name)

(defun init-machine ()
  (setf *variables* '())
  (setf *data-stack* '())
  (setf *state-stack* '())
  (setf *eval-stack* '())
  (setf *state* 'start)
  (setf *stop* nil)
  (setf *eval-state* nil)
  (push '(car . ((list))) *variables*)
  (push '(cdr . ((list))) *variables*)
  (push '(cadr . ((list) . (car (cdr list)))) *variables*)
  (push '(cons . ((a b))) *variables*)
  (push '(quote . ((a))) *variables*))

(defun start-state ()
  (let ((pop-state t))
    (if (atom *expression*)
        (if (numberp *expression*)
            (push *expression* *data-stack*)
          (push (lookup-variable *expression*) *data-stack*))
      (let ((function-or-function-name (car *expression*)))
        (cond ((consp function-or-function-name)
               (let ((parameter-names (car function-or-function-name))
                     (body (cdr function-or-function-name))
                     (parameters (cdr *expression*)))
                 (push *eval-state* *eval-stack*)
                 (setf *eval-state* (make-eval-state
                                     :function-name nil
                                     :parameters parameters
                                     :parameter-names parameter-names
                                     :body body
                                     :variables-before-function *variables*
                                     :variables-for-function *variables*)
                       *state* 'eval-parameters
                       pop-state nil)))
              ((eql function-or-function-name 'quote)
               (push (cadr *expression*) *data-stack*))
              (t
               (let ((parameters (cdr *expression*))
                     (function (lookup-variable
function-or-function-name)))
                 (push *eval-state* *eval-stack*)
                 (setf *eval-state* (make-eval-state
                                     :function-name function-or-function-name
                                     :parameters parameters
                                     :parameter-names (car function)
                                     :body (cdr function)
                                     :variables-before-function *variables*
                                     :variables-for-function *variables*)
                       *state* 'eval-parameters
                       pop-state nil))))))
    (when pop-state
      (let ((next-state (pop *state-stack*)))
        (unless next-state (setf *stop* t))
        (setf *state* next-state)))))

(defun eval-parameters-state ()
  (setf (eval-state-parameter *eval-state*) (pop (eval-state-parameters
*eval-state*))
        (eval-state-parameter-name *eval-state*) (pop
(eval-state-parameter-names *eval-state*)))
  (if (and (eval-state-parameter *eval-state*) (eval-state-parameter-name
*eval-state*))
      (progn
        (push 'set-parameter *state-stack*)
        (setf *state* 'start
              *expression* (eval-state-parameter *eval-state*)))
    (progn
      (setf *variables* (eval-state-variables-for-function *eval-state*))
      (let ((function-name (eval-state-function-name *eval-state*))
            (pop-state t))
        (cond ((eql function-name 'car)
               (let ((list (lookup-variable 'list)))
                 (push (car list) *data-stack*)))
              ((eql function-name 'cdr)
               (let ((list (lookup-variable 'list)))
                 (push (cdr list) *data-stack*)))
              ((eql function-name 'cons)
               (let ((a (lookup-variable 'a))
                     (b (lookup-variable 'b)))
                 (push (cons a b) *data-stack*)))
              (t
               (setf *state* 'start
                     pop-state nil
                     *expression* (eval-state-body *eval-state*))))
        (when pop-state
          (setf *variables* (eval-state-variables-before-function
*eval-state*))
          (setf *eval-state* (pop *eval-stack*))
          (if *eval-state*
              (let ((next-state (pop *state-stack*)))
                (unless next-state (setf *stop* t))
                (setf *state* next-state))
            (setf *stop* t)))))))

(defun set-parameter-state ()
  (let ((variable (cons (eval-state-parameter-name *eval-state*) (pop
*data-stack*))))
    (push variable (eval-state-variables-for-function *eval-state*)))
  (setf *state* 'eval-parameters))

(defun @eval (expression)
  (init-machine)
  (setf *expression* expression)
  (loop with count = 0 do
        (incf count)
        (when (> count 1000) (return-from @eval "endless loop"))
        (cond ((eql *state* 'start)
               (start-state))
              ((eql *state* 'eval-parameters)
               (eval-parameters-state))
              ((eql *state* 'set-parameter)
               (set-parameter-state)))
        (when *stop* (loop-finish)))
  (pop *data-stack*))

-- 
Frank Buss, fb@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de

Authors

Frank Buss

Tags

Examples | Implementations | Embedded Systems

0 Notes and 0 comments