Path: news.eternal-september.org!eternal-september.org!feeder3.eternal-september.org!fu-berlin.de!uni-berlin.de!not-for-mail
From: ram@zedat.fu-berlin.de (Stefan Ram)
Newsgroups: comp.lang.lisp
Subject: Infix via parsing
Date: 7 Apr 2025 08:09:42 GMT
Organization: Stefan Ram
Lines: 135
Expires: 1 Mar 2026 11:59:58 GMT
Message-ID: <parsing-20250407085901@ram.dialup.fu-berlin.de>
Mime-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Trace: news.uni-berlin.de FPxXu9HxUn26mC9OE0+PgQL6o0nZsl/EM9t0zjT4FDlUPK
Cancel-Lock: sha1:B04bSey191tWypccdhzzPot1JSs= sha256:+K4pvK5FIMbFhkhvmtrj7sVKw81VJ71Hc6LfteSIpY0=
X-Copyright: (C) Copyright 2025 Stefan Ram. All rights reserved.
	Distribution through any means other than regular usenet
	channels is forbidden. It is forbidden to publish this
	article in the Web, to change URIs of this article into links,
        and to transfer the body without this notice, but quotations
        of parts in other Usenet posts are allowed.
X-No-Archive: Yes
Archive: no
X-No-Archive-Readme: "X-No-Archive" is set, because this prevents some
	services to mirror the article in the web. But the article may
	be kept on a Usenet archive server with only NNTP access.
X-No-Html: yes
Content-Language: en-US

  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

  .