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

---
 docgen.lisp | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)
 create mode 100644 docgen.lisp

(limited to 'docgen.lisp')

diff --git a/docgen.lisp b/docgen.lisp
new file mode 100644
index 0000000..cc19133
--- /dev/null
+++ b/docgen.lisp
@@ -0,0 +1,56 @@
+;;;; docgen.lisp -- generate a docstring from a grammar
+
+(in-package #:argot)
+
+(defun write-rule-doc (lhs pattern)
+  (format *standard-output* "~15s ::= " lhs)
+  (write-pattern-doc pattern ))
+
+(defun write-sequence-doc (args )
+  (loop :for (a . more) :on args
+        :do (write-pattern-doc a )
+            (when more
+              (princ " " ))))
+
+(defun write-optional-doc (arg)
+  (princ "[")
+  (write-pattern-doc arg)
+  (princ "]"))
+
+(defun write-kleene-doc (arg)
+  (write-pattern-doc arg)
+  (princ "*"))
+
+(defun write-one-or-more-doc (arg)
+  (write-pattern-doc arg)
+   (princ "+"))
+
+(defun write-alternatives-doc (args)
+  (loop :for (a . more) :on args
+        :do (write-pattern-doc a)
+            (when more
+              (princ " | "))))
+
+(defun write-grammar-pattern-doc (grammar-name)
+  (princ "{") (princ grammar-name) (princ "}"))
+
+(defun write-pattern-doc (pattern )
+  (if (atom pattern)
+      (princ pattern)
+      (destructuring-bind (op . args) pattern
+        (case op
+          ((:seq :seq=) (write-sequence-doc args ))
+          ((:? :?=) (write-optional-doc (first args)))
+          ((:* :*=) (write-kleene-doc (first args)))
+          ((:+ :+=) (write-one-or-more-doc (first args)))
+          ((:or :or=) (write-alternatives-doc args))
+          
+          (:= (princ (first args)))
+          (:@ (write-pattern-doc (second args)))
+          (:{} (write-grammar-pattern-doc (first args)))
+          
+          (:item (princ "::TOKEN::"))
+          (:eof (princ "::EOF::"))))))
+
+
+
-- 
cgit v1.2.3