aboutsummaryrefslogtreecommitdiff
path: root/grammars.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'grammars.lisp')
-rw-r--r--grammars.lisp16
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