From 0f42ae0e6d61e344e10604bc9b82f033fcdb91c9 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Tue, 8 Aug 2023 07:03:58 -0700
Subject: Added more documentation gen; deflangauge no longer uses defvar

---
 argot.lisp         | 36 +++++++++++++++++++++++++++---------
 docgen.lisp        |  4 ++--
 examples/calc.lisp |  6 ++++--
 grammars.lisp      |  2 +-
 4 files changed, 34 insertions(+), 14 deletions(-)

diff --git a/argot.lisp b/argot.lisp
index f79e2ed..b52052e 100644
--- a/argot.lisp
+++ b/argot.lisp
@@ -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
-- 
cgit v1.2.3