(defpackage :labels-parser
  (:use :cl )
  (:export ))
(in-package :labels-parser)

(defmacro cond-switch* ((&rest bindings) &body clauses)
  `(let* (,@bindings)
    (cond ,@clauses)))

(defun read-group (s)
  (labels ((is-terminal-p (char)
             (or (null char)
                 (member char '(#\space #\) #\,))))
           (peek ()
             (peek-char nil *standard-input* nil))
           (discard ()
             (read-char *standard-input*))
           (getch ()
             (read-char *standard-input*))

           (consume-whitespace (next)
             (if (eql #\space (peek))
                 (progn (read-char)
                        (consume-whitespace next))
                 (funcall next)))
           (consume-matching (pred)
             (if (funcall pred (peek))
                 (getch)
                 (error 'parse-fail)))
           (consume-until (term-pred pred &optional accum)
             (cond-switch* ((nc (peek)))
               ((funcall term-pred nc)
                (consume-whitespace
                 (lambda () (reverse accum))))
               (t
                (consume-until term-pred pred
                               (cons (consume-matching pred)
                                     accum)))))
           (consume-nonterminal (pred)
             (consume-until #'is-terminal-p pred))

           (read-symbol ()
             (coerce (consume-nonterminal #'alphanumericp)
                     'string))
           (read-number ()
             (parse-integer
              (coerce (consume-nonterminal #'digit-char-p)
                      'string)))
           (read-primitive ()
             (cond-switch* ((c (peek)))
               ((null c) nil)
               ((digit-char-p c) (read-number))
               ((alpha-char-p c) (read-symbol))))
           (read-list (&optional accum)
             (cond-switch* ((next (read-primitive))
                            (nc (peek)))
               ((null next)
                (if (eql #\) nc)
                    (reverse accum)
                    (error 'parse-fail)))
               ((eql #\) nc)
                (discard)
                (reverse (cons next accum)))
               (t
                (read-list (cons next accum)))))

           (read-main ()
             (cond-switch* ((nc (peek)))
               ((null nc) nil)
               ((eql #\space nc) (read-char) (read-main))
               ((eql nc #\()
                (read-char)
                (consume-whitespace
                 (lambda () (read-list))))
               (t (prog1 (read-primitive)
                    (when (listen *standard-input*)
                      (error 'parse-fail)))))))
    (let ((*standard-input* s))
      (read-main))))