;;;; 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::"))))))