45 lines
1.4 KiB
Common Lisp
45 lines
1.4 KiB
Common Lisp
|
(in-package #:cl-forth)
|
||
|
|
|
||
|
|
(define-condition stack-error (error)
|
||
|
|
((message :initarg :message
|
||
|
|
:accessor error-message)))
|
||
|
|
|
||
|
|
(define-condition stack-underflow (stack-error)
|
||
|
|
((message :initarg :message
|
||
|
|
:accessor underflow-message)))
|
||
|
|
|
||
|
|
(defclass stack ()
|
||
|
|
((contents :initform '()
|
||
|
|
:initarg :initial-contents
|
||
|
|
:accessor contents)))
|
||
|
|
|
||
|
|
(defmethod initialize-instance :after ((obj stack) &key initial-element &allow-other-keys)
|
||
|
|
(when initial-element
|
||
|
|
(setf (contents obj) (list initial-element))))
|
||
|
|
|
||
|
|
(defmethod push-to-stack ((obj stack) value)
|
||
|
|
"Push VALUE onto the stack in the STACK."
|
||
|
|
(push value (contents obj)))
|
||
|
|
|
||
|
|
(defmethod pop-from-stack ((obj stack))
|
||
|
|
"Pop a value from the stack in the STACK."
|
||
|
|
(pop (contents obj)))
|
||
|
|
|
||
|
|
(defmethod peek-stack ((obj stack))
|
||
|
|
"Peek at the top value of the stack in the STACK."
|
||
|
|
(car (contents obj)))
|
||
|
|
|
||
|
|
(defmethod print-object ((obj stack) stream)
|
||
|
|
(print-unreadable-object (obj stream :type t)
|
||
|
|
(format stream "(~{~a~^ ~})" (contents obj))))
|
||
|
|
|
||
|
|
;; Example usage:
|
||
|
|
(defun stack-test ()
|
||
|
|
(let ((my-stack (make-instance 'stack)))
|
||
|
|
(format t "Empty Stack: ~a~%" my-stack)
|
||
|
|
(push-to-stack my-stack 10)
|
||
|
|
(push-to-stack my-stack 20)
|
||
|
|
(format t "Top element: ~a~%" (peek-stack my-stack))
|
||
|
|
(format t "Popped element: ~a~%" (pop-from-stack my-stack))
|
||
|
|
(format t "Stack after pop: ~a~%" my-stack)))
|