From 1504c36d166a81de08d93d8a5a85e4c36467f7b1 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Sun, 10 Sep 2023 12:01:07 -0700
Subject: Added custom literals comparator for grammars

---
 grammars.lisp | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

(limited to 'grammars.lisp')

diff --git a/grammars.lisp b/grammars.lisp
index f8c99f6..da00a4c 100644
--- a/grammars.lisp
+++ b/grammars.lisp
@@ -15,6 +15,13 @@
     :initarg :start-rule
     :initform (error "START-RULE is required")
     :type symbol)
+   (literal-comparator
+    :accessor literal-comparator
+    :initarg :literal-comparator
+    :initform #'equalp
+    :type function
+    :documentation "The function used to compare literals 
+                    when using this grammar")
    (documentation
     :reader grammar-documentation
     :initarg :documentation
@@ -30,6 +37,7 @@
 (defvar *grammar*)
 (defvar *tokens*)
 (defvar *bindings*)
+(defvar *literals-equal-p* #'equalp)
 
 (defun succeed (result)
   (values result t))
@@ -109,7 +117,7 @@ any pattern fails the whole parse fails."
 (defun literals->patterns (literals)
   (loop :for l :in literals :collect (list := l)))
 
-(defun literals-equal? (a b) (equalp a b))
+(defun literals-equal? (a b) (funcall *literals-equal-p* a b))
 
 (defun parse-literal (literal)
   (if (literals-equal? (next-token) literal)
@@ -159,7 +167,8 @@ any pattern fails the whole parse fails."
           (if-let (grammar (find-grammar language))
             (let ((*grammar* grammar)
                   (*position* 0)
-                  (*tokens* (coerce subtokens 'vector)))
+                  (*tokens* (coerce subtokens 'vector))
+                  (*literals-equal-p* (literal-comparator grammar)))
               (parse-rule (start-rule grammar)))
             (error "No grammar called ~s" language))
           (fail))))
@@ -232,7 +241,8 @@ any pattern fails the whole parse fails."
 (defun parse (grammar tokens)
   (let ((*position* 0)
         (*grammar* grammar)
-        (*tokens* (coerce tokens 'vector)))
+        (*tokens* (coerce tokens 'vector))
+        (*literals-equal-p* (literal-comparator grammar)))
     (multiple-value-bind (result successp)  (parse-rule (start-rule *grammar*))
       (unless successp
         (error 'argot-parse-error
-- 
cgit v1.2.3