From 5800a49934ab75be17f03af8c9a2243120a97339 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Wed, 2 Aug 2023 21:01:03 -0700
Subject: Add docgen

---
 argot.lisp | 41 ++++++++++++++++++++++++++---------------
 1 file changed, 26 insertions(+), 15 deletions(-)

(limited to 'argot.lisp')

diff --git a/argot.lisp b/argot.lisp
index 2218dd5..f394e2a 100644
--- a/argot.lisp
+++ b/argot.lisp
@@ -118,21 +118,32 @@ and it returns VAR in that case."
                   :lhs ',lhs
                   :pattern ',pattern
                   ,@(expand-functional-argument :check lhs bindings check vars)
-                  ,@(expand-functional-argument :action lhs bindings action vars))))) 
-      `(progn
-         (defvar ,name nil)
-         (setf ,name (make-instance 'grammar
-                                      :documentation ,documentation
-                                      :start-rule ',(first (first ruledefs))))
-         ,@(loop
-             :for ruledef :in ruledefs
-             :for (lhs pattern vars check action) := (handler-case (parse-rule-def ruledef)
-                                                       (invalid-rule-def (e) (invoke-debugger e)))
-             :for bindings := (collect-let-bindings lhs vars)
-             :collect (rule-includer name lhs pattern check action bindings vars))
-
-         (defmacro ,name (&body tokens)
-           (argot:parse ,name tokens))))))
+                  ,@(expand-functional-argument :action lhs bindings action vars)))))
+      (let* ((parsed-rules
+               (loop :for ruledef :in ruledefs
+                     :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
+                     :for bindings := (collect-let-bindings lhs vars)
+                     :collect (rule-includer name lhs pattern check action bindings vars)))
+             (docstring
+               (with-output-to-string (*standard-output*)
+                 (princ documentation)
+                 (terpri) (terpri)
+                 (loop :for (lhs pattern . more) :in parsed-rules
+                       :do (write-rule-doc lhs pattern)
+                           (terpri)))))
+       `(progn
+          (defvar ,name nil)
+          (setf ,name (make-instance 'grammar
+                                     :documentation ,documentation
+                                     :start-rule ',(first (first ruledefs))))
+          ,@rule-adder-forms
+
+          (defmacro ,name (&body tokens)
+            ,docstring
+            (argot:parse ,name tokens)))))))
 
 
 
-- 
cgit v1.2.3