(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))))