;;;; docgen.lisp -- generate a docstring from a grammar

(in-package #:argot)

(defun rule-name-string (rulename)
  (let ((str (symbol-name rulename)))
    (nstring-downcase (subseq str 1 (1- (length str))))))

(defun write-rule-doc (lhs pattern)
  (format *standard-output* "~15a ::= " (rule-name-string 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)
  (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-literal (object)
  (format *standard-output* "'~a'" (write-to-string object)))

(defun write-pattern-doc (pattern)
  (cond ((nonterminal? pattern)
         (format *standard-output* "~a" (rule-name-string pattern)))
        ((atom pattern)
         (write-literal pattern))
        (t
         (destructuring-bind (op . args) pattern
           (case op
             (:seq (write-sequence-doc args))
             (:seq= (write-sequence-doc args ))
             (:? (write-optional-doc (first args)))
             (:?= (write-optional-doc (first args) ))
             (:* (write-kleene-doc (first args)))
             (:*= (write-kleene-doc (first args) ))
             (:+ (write-one-or-more-doc (first args)))
             (:+= (write-one-or-more-doc (first args) ))
             (:or (write-alternatives-doc args))
             (:or= (write-alternatives-doc args ))
             (:= (write-literal (first args)))
             (:@ (write-pattern-doc (second args)))
             (:{} (write-grammar-pattern-doc (first args)))
             (:item (princ "token"))
             (:eof (princ "eof")))))))