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