;;;; 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)
  (princ "(")
  (loop :for (a . more) :on args
        :do (write-pattern-doc a)
            (when more
              (princ " | ")))
  (princ ")"))

(defun write-grammar-pattern-doc (grammar-name)
  (princ "{") (princ grammar-name) (princ "}"))

(defun write-pattern-doc (pattern)
  (cond ((nonterminal? pattern)
         (princ pattern))
        ((atom pattern)
         (princ "'") (princ pattern) (princ "'"))
        (t
         (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::")))))))