diff options
| -rw-r--r-- | argot.lisp | 9 | ||||
| -rw-r--r-- | grammars.lisp | 16 |
2 files changed, 20 insertions, 5 deletions
@@ -81,7 +81,10 @@ and it returns VAR in that case." (symbolp (second s)) (endp (cddr s))))) -(defmacro deflanguage (name (&key (documentation "")) &body ruledefs) +(defmacro deflanguage (name (&key + (documentation "") + literals=) + &body ruledefs) (let ((bindings-var (gensym "BINDINGS"))) (labels ((collect-let-bindings (lhs vars) "Create let-bindings forms for the body of the :action." @@ -152,7 +155,9 @@ and it returns VAR in that case." (setf (get ',name 'argot::grammar-property) (make-instance 'grammar :documentation ,documentation - :start-rule ',(first (first ruledefs)))) + :start-rule ',(first (first ruledefs)) + ,@(when literals= + `(:literal-comparator ,literals=)))) ,@rule-adder-forms (defmacro ,name (&body tokens) 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 |