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 +++++++++++++++++++++++++++---------
 1 file changed, 27 insertions(+), 9 deletions(-)

(limited to 'argot.lisp')

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)))))))
 
 
 
-- 
cgit v1.2.3