From 53388e6d564cf87beaeca5a0598559d1dc8df7ad Mon Sep 17 00:00:00 2001
From: Alexander Rosenberg <zanderpkg@pm.me>
Date: Mon, 16 Sep 2024 03:08:29 -0700
Subject: [PATCH] Fix operator parsing

---
 parse.lisp | 38 ++++++++++++++++++++++++++++++++------
 1 file changed, 32 insertions(+), 6 deletions(-)

diff --git a/parse.lisp b/parse.lisp
index 035c0f4..2801320 100644
--- a/parse.lisp
+++ b/parse.lisp
@@ -86,6 +86,20 @@ proposition."))
     (iff "<->" "<>" "<=>" "⇔" "↔" "≡" "iff" "=" "==" "xnor" "⊙"))
   "Alist table of operator symbols and their possible string representations.")
 
+(defun alpha-string-p (str)
+  "Return t if STR is only alphabetical characters."
+  (not (find-if-not 'alpha-char-p str)))
+
+(defparameter *longest-non-alpha-operator*
+  (apply 'max (mapcar
+               (lambda (entry)
+                 (apply 'max
+                        (mapcar 'length
+                                (remove-if 'alpha-string-p (cdr entry)))))
+               *operator-symbol-table*))
+  "The longest operator in `*operator-symbol-table*' such that `alpha-string-p'
+returns t.")
+
 (defparameter *operator-descriptions* ;; noindent 30
   `((open-paren ("open parenthesis")
      ,(format nil "Used in combination with a close parenthesis to denote ~
@@ -202,6 +216,18 @@ a variable."
   (unless (zerop (length str))
     (elt str 0)))
 
+(defun try-find-operator-for-token (token)
+  "Return the operator symbol for TOKEN, if it is an operator. As a second
+value, return the matched portion of TOKEN. If no match is found, return
+(values nil nil)."
+  (loop for len downfrom (min *longest-non-alpha-operator* (length token)) to 1
+        for cur-test = (subseq token 0 len)
+        for oper-sym = (operator-symbol cur-test)
+        when oper-sym do
+          (return-from try-find-operator-for-token
+            (values oper-sym cur-test)))
+  (values nil nil))
+
 (defun next-symbol-token (str &key multi-char-names)
   "Return the next token from STR that is not a paren. If MULTI-CHAR-NAMES is
 non-nil, allow names to be more than one character long."
@@ -219,13 +245,13 @@ non-nil, allow names to be more than one character long."
              (return
                (string
                 (cond
-                  ;; single character unary operand
-                  ((let ((val (operator-symbol (string (first token)))))
-                     (and (symbolp val) (unary-p val)))
-                   (first token))
-                  ;; multi-char variable, constant (true or false), or operator
+                  ;; operator
+                  ((multiple-value-bind (sym match)
+                       (try-find-operator-for-token str)
+                     (declare (ignorable sym))
+                     match))
+                  ;; multi-char variable, constant (true or false)
                   ((or multi-char-names
-                       (operator-symbol str)
                        (symbolp (interpret-operand str)))
                    str)
                   ;; single letter variable (multi-char-names is off)