diff options
| author | colin <colin@cicadas.surf> | 2023-09-10 12:01:07 -0700 |
|---|---|---|
| committer | colin <colin@cicadas.surf> | 2023-09-10 12:01:07 -0700 |
| commit | 1504c36d166a81de08d93d8a5a85e4c36467f7b1 (patch) | |
| tree | a9930f25f6c6d8df4efbbab77ccafa88b8ca0b22 /grammars.lisp | |
| parent | b1d927635d4a15d4904080bc9738799fb4873fff (diff) | |
Diffstat (limited to 'grammars.lisp')
| -rw-r--r-- | grammars.lisp | 16 |
1 files changed, 13 insertions, 3 deletions
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 |