StatefulStackFactory

This factory macro uses Emacs’s lexical binding environment to generate closures to use as stacks. They maintain their internal states which can only be accessed through {{{funcall}} with appropriate arguments.

There is also a test function so that you can easily check modifications.

Use one of the two following lines to set up lexical binding

;;;-*- mode: Emacs-lisp; lexical-binding: t ; -*-

(setq lexical-binding t)

This code won’t work without lexical binding, see above.

;;; This code is in the public domain
;;; There is absolutely no warranty of any kind.

(defmacro make-stack (stack-name)
  "This macro returns a closure that can be used as a stack.
When called with t, it returns the current stack.
When called with a non-nil argument other than t it pushes the 
argument onto the stack and returns the stack.
When called with no argument, it pops the stack and returns the result
When called with two non-nil arguments, it replaces the current
stack with the first argument allowning the stack to be reset or
returned to a previously saved state. Report error if replacement
thing isn't a list.
;;; Examples of use taken in order
;; (make-stack named-stack) ;; creates a stack named \"named-stack\"
;; (funcall named-stack 1) ;; yields (1)
;; (funcall named-stack 2) ;; yields (2 1)
;; (funcall named-stack 3) ;; yields (3 2 1)
;; (funcall named-stack t) ;; yields (3 2 1)
;; (funcall named-stack) ;; yields 3
;; (funcall named-stack t) ;; yields (2 1)
;; (funcall named-stack '(5 4 3) t) ;; yields (5 4 3)
;; (funcall named-stack) ;; yields 5
;; (funcall named-stack t) ;; yields (4 3)"
  (list 'let (list (list 'stack-list nil))
	(list 'setq stack-name
	      (list 'lambda (list '&optional 'thing 'thing2) ;; manipulate the stack
		    (list 'cond
			  (list (list 'and 'thing 'thing2) ;; if two arguments, reset stack
				(list 'if (list 'listp 'thing) ;; only reset with a list
				      (list 'setq 'stack-list 'thing)
				      (list 'error "In make-stack closure: reset argument must be list, was: %s"
					    'thing)))
			  (list (list 'eq 'thing t) ;; return current stack
				'stack-list)
			  (list 'thing ;; push to front of stack
				(list 'push 'thing 'stack-list))
			  (list t ;; did nothing else, so pop stack
				(list 'pop 'stack-list)))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun test-make-stack ()
 "This function tests the make-stack factory macro.
It first creates a local stack, then exercises its
internal functions. The results can be seen in the
*Messages* buffer.  The desired results are output
just above the ones produced by the local stack.
The function exits with an error, so the last
line shouldn't be seen."
  (let ((junk (make-stack local-stack))
	(check-stack '(1 2 3 4 5))
	(check-pop 1)
	(remainder-stack '(2 3 4 5))
	(reset-stack '(7 8 9)))
    (setq junk nil) ;; keeps debugger from complaining
    (funcall local-stack 5)
    (funcall local-stack 4)
    (funcall local-stack 3)
    (funcall local-stack 2)
    (funcall local-stack 1)
    (let ((push-result (funcall local-stack t)))
	    (message "test-make-stack: desired stack: '(1 2 3 4 5)")
	    (message (concat "test-make-stack: actual stack: " (format "%s" push-result)))
	    (let ((popped (funcall local-stack)))
	      (message "test-make-stack: desired popped element: 1")
	      (message (concat "test-make-stack: actual popped element: "(format "%s" popped)))
	      (let ((remaining-stack (funcall local-stack t)))
		(message "test-make-stack: desired remainder stack: '(2 3 4 5)")
		(message (concat "test-make-stack: actual remainder stack: "(format "%s" remaining-stack)))
		(let ((new-stack (funcall local-stack '(7 8 9) t)))
		  (message "test-make-stack: desired reset stack: '(7 8 9)")
		  (message (concat "test-make-stack: actual reset stack: "(format "%s" new-stack)))
		  (message "Next message should be an error. There should be no messages after that")
		  (funcall local-stack 0 t)
		  (message "You shouldn't see this. An error should have terminated function before this")))))))

		  
(test-make-stack)