stack-based programming in Lisp?
Frank Buss
returning parameters to functions (called "words" in Forth) and within
functions, because it leads to compact code. Is this possible in Lisp, too?
Let's try this Forth code:
159340636 value seed
: lroll ( u1 -- u2 ) dup 2* swap 0< - ;
0 invert dup 1 rshift xor constant highest-bit
: rroll ( u1 -- u2 ) dup 1 rshift swap 1 and if highest-bit or then ;
: random-bit ( -- 1 | 0 ) seed dup rroll or seed lroll xor dup to seed 1 and ;
: random-byte ( -- byte ) 0 8 0 do 1 lshift random-bit or loop ;
In Lisp it is a lot more verbose, but with 64 bits it is more random (see
the thread in comp.lang.forth for a nice discussion about different
algorithms and how random they are) and it should work with every Common
Lisp implementation:
(defconstant +highest-bit+ #.(expt 2 63))
(defparameter *cells* 34534233090)
(defun lroll (x)
(if (>= x +highest-bit+)
(logior (ash (- x +highest-bit+) 1) 1)
(ash x 1)))
(defun rroll (x)
(if (= (logand x 1) 1)
(logior (ash x -1) +highest-bit+)
(ash x -1)))
(defun random-bit ()
(setf *cells* (logxor (logior *cells* (rroll *cells*)) (lroll *cells*)))
(logand *cells* 1))
(defun random-byte ()
(let ((result 0))
(loop for i from 0 below 8 do
(setf result (logior (ash result 1) (random-bit))))
result))
--
Frank Buss, f...@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
D Herring
> After some programming in Forth, I like using the stack for passing and
> returning parameters to functions (called "words" in Forth) and within
> functions, because it leads to compact code. Is this possible in Lisp, too?
Look up the following post to this group:
Subject: Re: The Weakness of Lisp
From: Pascal Bourguignon <p...@informatimago.com>
Date: Sun, 20 Aug 2006 05:04:48 +0200
It contained a fairly complete stack implementation in Lisp.
- Daniel
Pascal Bourguignon
> After some programming in Forth, I like using the stack for passing and
> returning parameters to functions (called "words" in Forth) and within
> functions, because it leads to compact code. Is this possible in Lisp, too?
Haven't I sketched one some time ago already?
;; Let's implement a few forth primitives:
(defpackage "FORTH"
(:use)
(:import-from "CL" "DEFPARAMETER" "DEFUN" "DEFMACRO" "&OPTIONAL" "PROGN"))
(in-package "FORTH")
(defparameter *stack* '())
(defun reset () (cl:setf *stack* '()))
(defun push (value) (cl:push value *stack*))
(defun bos () (push (cl:null *stack*)))
(defun length<= (list minlength)
(cl:and (cl:plusp minlength) list (length<= (cl:cdr list) (cl:1- minlength))))
(defun check-not-empty (&optional (minlength 1))
(cl:when (length<= *stack* minlength) (cl:error "Not enough element in the stack")))
(defmacro if (then &optional else)
`(cl:if (cl:progn (check-not-empty) (cl:pop *stack*)) ,then ,else))
(defun pop () (check-not-empty) (cl:pop *stack*))
(defun top () (check-not-empty) (cl:car *stack*))
(defun dup () (cl:push (top) *stack*))
(defun swap () (check-not-empty 2) (cl:rotatef (cl:car *stack*) (cl:cadr *stack*)))
(defun < () (push (cl:< (pop) (pop))))
(defun + () (push (cl:+ (pop) (pop))))
(defun - () (push (cl:- (pop) (pop))))
(defun * () (push (cl:* (pop) (pop))))
;; Let's implement fact in forth:
(defun fact () (dup) (push 1) (<) (if (progn (dup) (push -1) (+) (fact) (*))))
;; Indeed it's simplier than in lisp (note for example, that we need only
;; one branch in the if).
(push 10) (fact) (pop)
--> 3628800
Of course, you can also write a reader to avoid the parentheses that
became really useless since there are no arguments.
--
__Pascal Bourguignon__ http://www.informatimago.com/
This is a signature virus. Add me to your signature and help me to live.
Frank Buss
I hope your code doesn't erase my hard disk.
> ;; Let's implement fact in forth:
>
> (defun fact () (dup) (push 1) (<) (if (progn (dup) (push -1) (+) (fact) (*))))
>
> ;; Indeed it's simplier than in lisp (note for example, that we need only
> ;; one branch in the if).
>
> (push 10) (fact) (pop)
> --> 3628800
>
>
> Of course, you can also write a reader to avoid the parentheses that
> became really useless since there are no arguments.
But then there is a problem for the IF-macro, because how do you detect the
end of the IF without parentheses? I think one advantage of Forth is that
it has even less syntax than Lisp: There are just words and numbers (but
you can define words, which reads the input stream for building your own
syntax). So using a reader is a good idea. In Forth the fact function would
look like this:
: fact dup 1 > if dup 1- recurse * then ;
So with some code below, you can write it like this:
(forth-eval ": fact dup 1 > if dup 1- recurse * then ; 10 fact .")
And if you are tired of using Lisp, switch to the Forth-mode:
(forth *standard-input*)
The code is a simple interpreter, with immediate words hard-coded into the
parser. This could be both enhanced. And now it would be interesting to see
a Common Lisp implementation in Forth, which then can be executed in the
Lisp Forth implementation :-)
(defparameter *stack* '())
(defparameter *words* (make-hash-table :test 'equal))
(setf (gethash "." *words*)
(lambda (stream)
(declare (ignore stream))
(format t "~a " (pop *stack*))))
(setf (gethash "cr" *words*)
(lambda (stream)
(declare (ignore stream))
(terpri)))
(setf (gethash "if" *words*)
(lambda (stream)
(when (= 0 (pop *stack*))
(loop do
(when (equal "then" (read-word stream))
(loop-finish))))))
(setf (gethash "then" *words*)
(lambda (stream)
(declare (ignore stream))))
(setf (gethash "dup" *words*)
(lambda (stream)
(declare (ignore stream))
(push (car *stack*) *stack*)))
(setf (gethash ">" *words*)
(lambda (stream)
(declare (ignore stream))
(push
(if (< (pop *stack*) (pop *stack*)) -1 0)
*stack*)))
(setf (gethash "+" *words*)
(lambda (stream)
(declare (ignore stream))
(push (+ (pop *stack*) (pop *stack*)) *stack*)))
(setf (gethash "*" *words*)
(lambda (stream)
(declare (ignore stream))
(push (* (pop *stack*) (pop *stack*)) *stack*)))
(setf (gethash "1-" *words*)
(lambda (stream)
(declare (ignore stream))
(push (1- (pop *stack*)) *stack*)))
(defparameter *compile-word* nil)
(defparameter *compile-word-name* nil)
(defun add-to-word (string)
(setf *compile-word* (concatenate 'string *compile-word* " " string)))
(defun evaluate-number (string)
(let ((number
(handler-case (parse-integer string)
(error () nil))))
(if number
(push number *stack*)
(format t "unknown word: ~a~%" string))))
(defun evaluate-word (stream word)
(if *compile-word-name*
(cond ((equal word ";")
(setf (gethash *compile-word-name* *words*) *compile-word*
*compile-word-name* nil))
((equal word "recurse")
(add-to-word *compile-word-name*))
(t (add-to-word word)))
(if (equal word ":")
(setf *compile-word-name* (read-word stream)
*compile-word* "")
(progn ;(format t "word: ~a ~a~%" word *stack*)
(let ((definition (gethash word *words*)))
(cond ((stringp definition) (forth-eval definition))
((functionp definition) (funcall definition stream))
(t (evaluate-number word))))))))
(defun is-whitespace (char)
(member char '(#\Space #\Tab #\Newline)))
(defun read-word (stream)
(peek-char t stream nil nil)
(with-output-to-string (out)
(loop for c = (peek-char nil stream nil nil) do
(unless (and c (not (is-whitespace c)))
(loop-finish))
(write-char c out)
(read-char stream))))
(defun forth (stream)
(loop do
(unless (peek-char t stream nil nil) (loop-finish))
(let ((word (read-word stream)))
(evaluate-word stream word))))
(defun forth-eval (string)
(let ((stream (make-string-input-stream string)))
(forth stream)))
Christopher Browne
> Of course, you can also write a reader to avoid the parentheses that
> became really useless since there are no arguments.
The other thing about FORTH is that the parser is *way* simpler than
that for CL. Indeed, it's pretty much just a "detect the next token
based on finding the next whitespace" thing. The compiler isn't much
more than that.
Macros are *way* different from that.
--
output = ("cbbrowne" "@" "gmail.com")
http://linuxdatabases.info/info/spreadsheets.html
MICROS~1: The company that brought new meaning to "Nervous System"