(define-syntax trace
  (syntax-rules ()
    ((trace x)
     (begin
       (write (quote x))
       (display " => ")
       (write x)
       (newline)
       x))))

(define-syntax use-assertions
  (syntax-rules ()
    ((_) (eval '(define exit
                  (call-with-current-continuation
                   (lambda (escape) escape))) (interaction-environment)))))

(define-syntax assert
  (syntax-rules ()
    ((_ x)
     (if (not x)
         (exit 'x)))))

(use-assertions)

(define (make-source s . end)
  (if (string? s)
      (if (null? end)
          (let ((static (reverse (cons #f (reverse (string->list s))))))
            (lambda (x)
              (if (= (length static) 1)
                  (car static)
                  (if (equal? x 'peek)
                      (car static)
                      (if (equal? x 'next)
                          (begin
                            (let ((cur (car static)))
                              (begin
                                (set! static (cdr static))
                                cur)))
                          static)))))
          (let ((static (reverse (cons (car end) (reverse (string->list s))))))
            (lambda (x)
              (if (= (length static) 1)
                  (car static)
                  (if (equal? x 'peek)
                      (car static)
                      (if (equal? x 'next)
                          (begin
                            (let ((cur (car static)))
                              (begin
                                (set! static (cdr static))
                                cur)))
                          static))))))
      (if (vector? s)
          (if (null? end)
              (let ((static (reverse (cons #f (reverse (vector->list s))))))
                (lambda (x)
                  (if (= (length static) 1)
                      (car static)
                      (if (equal? x 'peek)
                          (car static)
                          (if (equal? x 'next)
                              (begin
                                (let ((cur (car static)))
                                  (begin
                                    (set! static (cdr static))
                                    cur)))
                              static)))))
              (let ((static (reverse (cons (car end) (reverse (vector->list s))))))
                (lambda (x)
                  (if (= (length static) 1)
                      (car static)
                      (if (equal? x 'peek)
                          (car static)
                          (if (equal? x 'next)
                              (begin
                                (let ((cur (car static)))
                                  (begin
                                    (set! static (cdr static))
                                    cur)))
                              static))))))
          (if (null? end)
              (let ((static (reverse (cons #f (reverse s)))))
                (lambda (x)
                  (if (= (length static) 1)
                      (car static)
                      (if (equal? x 'peek)
                          (car static)
                          (if (equal? x 'next)
                              (begin
                                (let ((cur (car static)))
                                  (begin
                                    (set! static (cdr static))
                                    cur)))
                              static)))))
              (let ((static (reverse (cons (car end) (reverse s)))))
                (lambda (x)
                  (if (= (length static) 1)
                      (car static)
                      (if (equal? x 'peek)
                          (car static)
                          (if (equal? x 'next)
                              (begin
                                (let ((cur (car static)))
                                  (begin
                                    (set! static (cdr static))
                                    cur)))
                              static)))))))))

(define (peek x)
  (x 'peek))

(define (next x)
  (x 'next))

;expr ::= letters numbers sk operations | .
;letters ::= letter | .
;numbers ::= <0> | <1> | <2> | <3> | <4> | <5> | <6> | <7> | <8> | <9> .
;sk ::= <(> | <)> | < > | .

(define (letters x res)
  (if (and (not (null? x)) (char-alphabetic? (car x)))
      (letters (cdr x) (string-append res (list->string (cons (car x) '()))))
      (list x res)))

(define (tokenize str)
  (define (tokens x res)
    (if (null? x)
        (reverse res)
        (let ((cur (car x)))
          (if (char-numeric? cur)
              (tokens (cdr x) (cons (- (char->integer cur) 48) res))
              (if (char-alphabetic? cur)
                  (let ((s (letters x "")))
                    (tokens (car s) (cons (string->symbol (cadr s)) res)))
                  (if (equal? cur #\space)
                      (tokens (cdr x) res)
                      (if (or (equal? cur #\() (equal? cur #\)))
                          (tokens (cdr x) (cons (list->string (cons cur '())) res))
                          (if (or (equal? cur #\-) (equal? cur #\+) (equal? cur #\*) (equal? cur #\/) (equal? cur #\^))
                              (tokens (cdr x) (cons (string->symbol (list->string (cons cur '()))) res))
                              #f))))))))
  (tokens (string->list str) '()))

(define (power lst)
  (if (list? (peek lst))
      (expr lst)
      (list (next lst))))

(define (factors lst now)
  (if (equal? '^ (peek lst))
      (factors lst (list (if (= (length now) 1) (car now) now) (next lst) (let ((nowt (power lst))) (if (= (length nowt) 1) (car nowt) nowt))))
      (let ((cur (peek lst)))
        (if (or (equal? cur '+) (equal? cur '-) (equal? cur '*) (equal? cur '/) (equal? cur '^) (equal? cur ")") (equal? cur 'hell))
            now
            (assert #f)))))

(define (factor lst)
  (if (equal? 'hell (peek lst))
      (assert #f)
      (factors lst (power lst))))

(define (terms lst now)
  (if (or (equal? '* (peek lst)) (equal? '/ (peek lst)))
      (terms lst (list (if (= (length now) 1) (car now) now) (next lst) (let ((nowt (factor lst))) (if (= (length nowt) 1) (car nowt) nowt))))
      (let ((cur (peek lst)))
        (if (or (equal? cur '+) (equal? cur '-) (equal? cur '*) (equal? cur '/) (equal? cur '^) (equal? cur ")") (equal? cur 'hell))
            now
            (assert #f)))))

(define (term lst)
  (if (equal? 'hell (peek lst))
      (assert #f)
      (terms lst (factor lst))))

(define (exprs lst now)
  (if (or (equal? '+ (peek lst)) (equal? '- (peek lst)))
      (exprs lst (list (if (= (length now) 1) (car now) now) (next lst) (let ((nowt (term lst))) (if (= (length nowt) 1) (car nowt) nowt))))
      (let ((cur (peek lst)))
        (if (or (equal? cur '+) (equal? cur '-) (equal? cur '*) (equal? cur '/) (equal? cur '^) (equal? cur ")") (equal? cur 'hell))
            now
            (assert #f)))))

(define (expr lst)
  (if (equal? 'hell (peek lst))
      (assert #f)
      (exprs lst (term lst))))

(define (parse list)
  (define xex (make-source list 'hell))
  (expr xex))

(parse (tokenize "a^b^c^d"))