#lang racket
(require scheme/mpair)
(define ns (make-base-namespace))

(define (tokenize expr)
  (string-split (regexp-replace* #rx"([\\(\\)\\+\\-\\^%\\*/])" expr " & ")))

(define (eval-string s)
  (eval (with-input-from-string s read) ns))

(define make-stack
  (lambda ()
    (let ((ls '()))
      (lambda (msg . args)
        (cond
          ((eqv? msg 'empty?) (null? ls))
          ((eqv? msg 'push!) (set! ls (cons (car args) ls)))
          ((eqv? msg 'top) (car ls))
          ((eqv? msg 'pop!) (set! ls (cdr ls)))
          ((eqv? msg '->list) ls)
          (else "oops"))))))



(define make-queue
  (lambda ()
    (let ((end (mcons 'ignored '())))
      (mcons end end))))

(define (fillq! q lst)
  (cond
    ((null? lst) #t)
    (else (begin
            (putq! q (car lst))
            (fillq! q (cdr lst))))))

(define putq!
  (lambda (q v)
    (let ((end (mcons 'ignored '())))
      (set-mcar! (mcdr q) v)
      (set-mcdr! (mcdr q) end)
      (set-mcdr! q end))))

(define getq
  (lambda (q)
    (mcar (mcar q))))

(define delq!
  (lambda (q)
    (set-mcar! q (mcdr (mcar q)))))

(define (right-assoc? op)
  (equal? op "^"))

(define (left-assoc? op)
  (not (right-assoc? op)))

(define (precedence op)
  (cond
    ((or (equal? op "+") (equal? op "-")) 1)
    ((or (equal? op "%") (equal? op "*") (equal? op "/")) 2)
    ((equal? op "^") 3)
    (else (raise-user-error "Not a valid operator" op))))

(define (shunting-yard expr)
  (let ((main_loop #f) (token #f) (ops '("+" "-" "/" "*" "^" "%")) (inq (make-queue)) (outstack (make-stack)) (auxstack (make-stack)))
    (begin
      (fillq! inq (reverse expr))
      (call/cc (lambda (k) (set! main_loop k)))
      (cond
         ((and (eqv? 'ignored (getq inq))
               (not (auxstack 'empty?))) (begin
                                           (outstack 'push! (auxstack 'top))
                                           (auxstack 'pop!)
                                           (main_loop #t)))
         ((and (eqv? 'ignored (getq inq))
               (auxstack 'empty?)) outstack)
         (else (begin
                 (set! token (getq inq))
                 (delq! inq)
                 (cond
                   ((string->number token) (begin
                                             (outstack 'push! token)
                                             (main_loop #t)))
                   ((member token ops) (let ((operator_loop #f))
                                         (begin
                                           (call/cc (lambda (k) (set! operator_loop k)))
                                           (cond
                                             ((and (not (auxstack 'empty?))
                                                   (member (auxstack 'top) ops)
                                                   (or (and (right-assoc? token)
                                                            (< (precedence token) (precedence (auxstack 'top))))
                                                       (and (left-assoc? token)
                                                            (<= (precedence token) (precedence (auxstack 'top))))))
                                             (begin
                                               (outstack 'push! (auxstack 'top))
                                               (auxstack 'pop!)
                                               (operator_loop #t)))
                                           (else (begin
                                                   (auxstack 'push! token)
                                                   (main_loop #t)))))))
                   ((equal? token "(") (let ((parentheses_loop #f))
                                       (begin
                                         (call/cc (lambda (k) (set! parentheses_loop k)))
                                         (cond
                                           ((equal? ")" (auxstack 'top)) (begin
                                                                         (auxstack 'pop!)
                                                                         (main_loop #t)))
                                           ((member (auxstack 'top) ops) (begin
                                                                           (outstack 'push! (auxstack 'top))
                                                                           (auxstack 'pop!)
                                                                           (parentheses_loop #t)))))))
                   ((equal? token ")") (begin
                                       (auxstack 'push! token)
                                       (main_loop #t))))))))))


(define (eval-pn expr)
  (let ((q (make-queue)) (outstack (make-stack)) (loop #f) (ops '("+" "-" "/" "*" "^" "%")))
    (begin
      (fillq! q (reverse expr))
      (call/cc (lambda (k) (set! loop k)))
      (cond
        ((eqv? 'ignored (getq q)) (outstack 'top))
        ((member (getq q) ops)
         (let* ((n1 (outstack 'top)) (n2 (begin (outstack 'pop!) (outstack 'top))))
           (begin
             (outstack 'pop!)
             (outstack 'push! (number->string (eval-string (string-append "(" (getq q) " " n1 " " n2 ")"))))))
         (delq! q)
         (loop #t))
        (else (begin
                (outstack 'push! (getq q))
                (delq! q)
                (loop #t)))))))



(define expr "3*(4+5)/3")
(set! expr (tokenize expr))
(set! expr ((shunting-yard expr) '->list))
(eval-pn expr)