diff options
| -rw-r--r-- | argot.lisp | 36 | ||||
| -rw-r--r-- | docgen.lisp | 4 | ||||
| -rw-r--r-- | examples/calc.lisp | 6 | ||||
| -rw-r--r-- | grammars.lisp | 2 |
4 files changed, 34 insertions, 14 deletions
@@ -2,6 +2,10 @@ (in-package #:argot) +(defconstant grammar-property 'grammar-property + "Symbol in the ARGOT package used to store grammars on symbols' +property lists.") + (define-condition invalid-rule-def (error) ((rule :reader rule :initarg :rule)) @@ -100,12 +104,13 @@ and it returns VAR in that case." (let ,bindings (declare (ignorable ,lhs ,@vars)) ,action)))))) - (rule-includer (name lhs pattern &optional check action bindings vars) + (rule-includer (name lhs pattern &optional check action bindings vars doc) `(include-rule - ,name + (get ',name 'argot::grammar-property) (make-rule :lhs ',lhs :pattern ',pattern + :doc ,doc ,@(expand-functional-argument :check lhs bindings check vars) ,@(expand-functional-argument :action lhs bindings action vars))))) (let* ((parsed-rules @@ -113,9 +118,9 @@ and it returns VAR in that case." :collect (handler-case (parse-rule-def ruledef) (invalid-rule-def (e) (invoke-debugger e))))) (rule-adder-forms - (loop :for (lhs pattern vars check action) :in parsed-rules + (loop :for (lhs pattern vars check action doc) :in parsed-rules :for bindings := (collect-let-bindings lhs vars) - :collect (rule-includer name lhs pattern check action bindings vars))) + :collect (rule-includer name lhs pattern check action bindings vars doc))) (docstring (with-output-to-string (*standard-output*) (princ documentation) @@ -123,6 +128,19 @@ and it returns VAR in that case." (loop :for (lhs pattern . more) :in parsed-rules :do (write-rule-doc lhs pattern) (terpri)) + + (princ "------------------------------------------") + (terpri) + (princ "ADDITIONAL NOTES:") + (terpri) + (loop :for (lhs _p _v _c _a doc) :in parsed-rules + ;:for lhs-name := (symbol-name lhs) + :when doc + :do (format *standard-output* "~15a ~a~%" + lhs + ;(subseq lhs-name 1 (1- (length lhs-name))) + doc)) + (princ "------------------------------------------") (terpri) (princ "KEY: ") (terpri) (princ "::TOKEN:: Any ole token") (terpri) @@ -134,15 +152,15 @@ and it returns VAR in that case." (princ "<RULE> A nonterminal symbol - naming a parse rule") (terpri) (princ "[OPT] Zero or one of OPT")))) `(progn - (defvar ,name nil) - (setf ,name (make-instance 'grammar - :documentation ,documentation - :start-rule ',(first (first ruledefs)))) + (setf (get ',name 'argot::grammar-property) + (make-instance 'grammar + :documentation ,documentation + :start-rule ',(first (first ruledefs)))) ,@rule-adder-forms (defmacro ,name (&body tokens) ,docstring - (argot:parse ,name tokens))))))) + (argot:parse (get ',name 'argot::grammar-property) tokens))))))) diff --git a/docgen.lisp b/docgen.lisp index cb43edc..49b0d34 100644 --- a/docgen.lisp +++ b/docgen.lisp @@ -4,7 +4,7 @@ (defun write-rule-doc (lhs pattern) (format *standard-output* "~15s ::= " lhs) - (write-pattern-doc pattern )) + (write-pattern-doc pattern)) (defun write-sequence-doc (args ) (loop :for (a . more) :on args @@ -36,7 +36,7 @@ (defun write-grammar-pattern-doc (grammar-name) (princ "{") (princ grammar-name) (princ "}")) -(defun write-pattern-doc (pattern ) +(defun write-pattern-doc (pattern) (cond ((nonterminal? pattern) (princ pattern)) ((atom pattern) diff --git a/examples/calc.lisp b/examples/calc.lisp index d3140ee..0a25a6b 100644 --- a/examples/calc.lisp +++ b/examples/calc.lisp @@ -16,10 +16,12 @@ (<expr> :match (:or <subexpr> <value> <unop> <binop>)) (<subexpr> - :match (:{} calc)) + :match (:{} calc) + :doc "A subexpression, like (1 + 2 / cos(1.5))") (<value> :match (:item) - :if numberp) + :if numberp + :doc "A Number") (<binop> :match (:seq (:@ lhs <expr>) diff --git a/grammars.lisp b/grammars.lisp index 533b7ce..c9a1c55 100644 --- a/grammars.lisp +++ b/grammars.lisp @@ -4,7 +4,7 @@ ;;; GRAMMAR & RULES -(defstruct rule lhs pattern action check) +(defstruct rule lhs pattern action check doc) (defclass grammar () ((rules |