(in-package #:header)

; TODO: structs/unions, enums, typedefs, handle preprocessor stuff.

(defparser whitespace ()
  (optional (many (unit #'whitespace?))))

(defparser preprocessor ()
  (comp ((_ (unit #\#))
         (keyword (many (unit #'alphanumericp)))
         (_ whitespace)
         (body (optional (many (one-of (unit (char/= it #\Newline))
                                       (comp ((_ (unit #\Backslash))
                                              (c (unit)))
                                         c)))))
         (_ (unit #\Newline)))
    (cons (coerce keyword 'string) (coerce body 'string))))

(defparser block-comment ()
  (comp ((_ (literal "/*"))
         (_ (optional
              (many
                (comp ((end? (optional (literal "*/")))
                       (other (if end?
                                (fail "Unreachable")
                                (unit))))
                  other))))
         (_ (literal "*/")))
    nil))

(defparser line-comment ()
  (comp ((_ (literal "//"))
         (_ (optional (many (unit (char/= it #\Newline)))))
         (_ (unit #\Newline)))
    nil))

(defun valid-char? (c first?)
  (or (if first?
        (alpha-char-p c)
        (alphanumericp c))
      (some (lambda (x) (char= c x))
            '(#\_ #\@ #\# #\$))))

(defparser identifier ()
  (comp ((first (unit (valid-char? it t)))
         (rest (optional (many (unit (valid-char? it nil))))))
    (coerce (cons first rest) 'string)))

(defparser function-declaration ()
  (comp ((type identifier)
         (_ whitespace)
         (name identifier)
         (_ whitespace)
         (args (within
                 (unit #\()
                 (optional (interlinked
                             (comp ((_ whitespace)
                                    (type (identifier))
                                    (_ whitespace)
                                    (stars (optional (many (unit #\*))))
                                    (_ whitespace)
                                    (name (optional identifier))
                                    (_ whitespace))
                               (list type (length stars) name))
                             (unit #\,)))
                 (unit #\))))
         (_ whitespace)
         (_ (unit #\;)))
    (list type name args)))

(defparser parser ()
  (optional (many (within whitespace
                          (one-of block-comment
                                  line-comment
                                  preprocessor
                                  function-declaration))
                  :all t)))