I have a tiny infix parser that I reimplement for each language.
But I never wrote a CL version, because I never learned CL. Now,
the chatbot wrote the CL for me, while the general outline of
the code, the structure of the code and data were devised by me.

Note how the method "parse" parses all binary operators with compact
code and uses "funcall" to call a function stored in "next-method".

;; (declaim (optimize (debug 3) (safety 3)))

;;;; Parser for arithmetic expressions
(defpackage :parser
(:use :cl)
(:export :main))
(in-package :parser)

;;; Operations map
(defparameter *operations*
(let ((table (make-hash-table :test 'equal)))
(setf (gethash #\^ table) (lambda (x y) (expt x y)))
(setf (gethash #\* table) (lambda (x y) (* x y)))
(setf (gethash #\/ table) (lambda (x y) (/ x y)))
(setf (gethash #\+ table) (lambda (x y) (+ x y)))
(setf (gethash #\- table) (lambda (x y) (- x y)))
table))

;;; Left-associative map
(defparameter *left-associative*
(let ((table (make-hash-table :test 'equal)))
(setf (gethash #\^ table) nil)
(setf (gethash #\* table) t)
(setf (gethash #\/ table) t)
(setf (gethash #\+ table) t)
(setf (gethash #\- table) t)
table))

;;; Define the parser class
(defclass myparser ()
((input-stream :accessor input-stream
:initarg :stream
:type stream
:documentation "The input stream being parsed.")))

(defmethod check ((p myparser) operators)
"Check if the current character in the input stream matches any of the operators."
;; Peek and consume the operator if matched.
(let ((peek-char (peek-char nil (input-stream p) nil)))
(if peek-char
;; Check if the character is in the operators list.
(if (find peek-char operators)
;; Consume and return the character.
(progn
(read-char (input-stream p))
peek-char)
nil)
nil)))

(defmethod numeral ((p myparser))
"Parse a numeral from the input stream."
(- (char-code (read-char (input-stream p)))
(char-code #\0)))

(defmethod prefix ((p myparser))
"Parse a prefix expression, handling unary minus."
;; Handle unary minus.
(let ((sign 1))
;; Loop until no more unary minus signs are found.
(loop while (char= #\-
;; Peek without consuming.
(peek-char nil
;; Input stream accessor.
(input-stream p)
nil)) do
;; Consume '-' and toggle sign.
;; Toggle sign for each '-'.
;;
(progn
(read-char (input-stream p)) ;; Consume '-'
(setf sign (- sign))))
(* sign (numeral p))))

(defmethod parse ((p myparser) operators next-method)
"Parse an expression with given operators and next-method for precedence."
(let ((result (funcall next-method p)))
;; Loop to handle operator precedence and associativity.
(loop for sym = (check p operators) while sym do
;; Apply the operation.
(setf result
(funcall (gethash sym *operations*)
result
(if (gethash sym *left-associative*)
(funcall next-method p)
;; For right-associative, recurse with parse.
(parse p operators next-method)))))
result))

(defmethod power ((p myparser))
"Parse power expressions with ^ operator."
(parse p '(#\^) #'prefix))

(defmethod product ((p myparser))
"Parse product expressions with * and / operators."
(parse p '(#\* #\/) #'power))

(defmethod sum ((p myparser))
"Parse sum expressions with + and - operators."
(parse p '(#\+ #\-) #'product))

(defmethod start ((p myparser))
"Start parsing from the highest precedence level."
(sum p))

(defun main ()
"Main function to test the parser."
;; Define a test function to evaluate expressions.
(let ((test (lambda (s)
;; Create a parser instance and evaluate the expression.
(let ((p (make-instance 'myparser :stream (make-string-input-stream s))))
;; Print the result of parsing.
(format t "~a~%" (start p))))))
;; Test cases.
(funcall test "2^2^3/2/2") ;; Should print: 64
(funcall test "2+2*2^2^-3"))) ;; Should print: 4.1810155

;; (trace main start sum product power prefix numeral parse check)
(main)

. Prints:

64
4.1810155

.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)