diff options
| -rw-r--r-- | argot.lisp | 46 | ||||
| -rw-r--r-- | package.lisp | 2 |
2 files changed, 40 insertions, 8 deletions
@@ -62,7 +62,7 @@ and it returns VAR in that case." (and (nonterminal? lhs) (pattern? pattern))) (list lhs pattern (collect-vars pattern) nil nil)) - ((guard (list lhs :-> pattern :? check) + ((guard (list lhs :-> pattern :?? check) (and (nonterminal? lhs) (pattern? pattern))) (list lhs pattern (collect-vars pattern) check nil)) @@ -70,11 +70,11 @@ and it returns VAR in that case." (and (nonterminal? lhs) (pattern? pattern))) (list lhs pattern (collect-vars pattern) nil action)) - ((guard (list lhs :-> pattern :=> action :? check) + ((guard (list lhs :-> pattern :=> action :?? check) (and (nonterminal? lhs) (pattern? pattern))) (list lhs pattern (collect-vars pattern) check action)) - ((guard (list lhs :-> pattern :? check :=> action) + ((guard (list lhs :-> pattern :?? check :=> action) (and (nonterminal? lhs) (pattern? pattern))) (list lhs pattern (collect-vars pattern) check action))) (trivia::match-error () @@ -290,8 +290,29 @@ any pattern fails the whole parse fails." (define-condition argot-parse-error (error) ((position :initarg :position) - (token :initarg :token) - (input :initarg :input))) + (input :initarg :input)) + (:report (lambda (err stream) + (with-slots (position input) err + (let ((pos (max 0 (- position 2)))) + (format + stream + "Parse failed at position ~a, around:~%~a" + pos (print-seq-range-pointing-at-center input pos 4))))))) + +(defun listslice (seq start stop) + (coerce (alexandria-2:subseq* seq start stop) 'list)) + +(defun print-seq-range-pointing-at-center (items position radius) + (let* ((front + (format nil "... ~{~s~^ ~}" (listslice items (max 0 (- position radius)) position ))) + (line + (format nil "~a ~{~s~^ ~} ..." + front (listslice items position (+ position radius 1))))) + (concatenate + 'string + line (list #\Newline) + (loop :repeat (1+ (length front)) :collect #\Space) + "^" (list #\Newline)))) (defun parse (grammar rule tokens) (let ((*position* 0) @@ -301,6 +322,17 @@ any pattern fails the whole parse fails." (unless successp (error 'argot-parse-error :position *position* - :input *tokens* - :token (elt *tokens* (1- *position*)))) + :input *tokens*)) result))) + + + +;;; deflanguage + +(defmacro deflanguage (name options &body rules) + `(progn + (eval-when (:compile-toplevel) + (argot:defgrammar ,name ,options ,@rules)) + + (defmacro ,name (&body tokens) + (argot:parse ,name ',(car (first rules)) tokens)))) diff --git a/package.lisp b/package.lisp index 19880cb..0bbaec6 100644 --- a/package.lisp +++ b/package.lisp @@ -4,4 +4,4 @@ (:use #:cl) (:import-from #:trivia #:match #:ematch #:guard) (:import-from #:alexandria #:if-let) - (:export #:defgrammar #:parse)) + (:export #:defgrammar #:deflanguage #:parse)) |