52 lines
1.7 KiB
Text
52 lines
1.7 KiB
Text
(require 'hash)
|
|
(require 'tree)
|
|
|
|
(define OPS (make-hash))
|
|
(hash-set OPS "^" '( 4 #f)) ;; right assoc
|
|
(hash-set OPS "*" '( 3 #t)) ;; left assoc
|
|
(hash-set OPS "/" '( 3 #t))
|
|
(hash-set OPS "+" '( 2 #t))
|
|
(hash-set OPS "-" '( 2 #t))
|
|
|
|
;; helpers
|
|
(define (is-right-par? token) (string=? token ")"))
|
|
(define (is-left-par? token) (string=? token "("))
|
|
(define (is-num? op) (not (hash-ref OPS op))) ;; crude
|
|
(define (is-op? op) (hash-ref OPS op))
|
|
(define (is-left? op) (second (hash-ref OPS op)))
|
|
(define (is-right? op) (not (is-left? op)))
|
|
(define (op-prec op) (first (hash-ref OPS op)))
|
|
|
|
;; Wikipedia algorithm, translated as it is
|
|
|
|
(define (shunt tokens S Q)
|
|
(for ((token tokens))
|
|
(writeln "S: " (stack->list S) "Q: " (queue->list Q) "token: "token)
|
|
(cond
|
|
[(is-left-par? token) (push S token) ]
|
|
[(is-right-par? token)
|
|
(while (and (stack-top S) (not (is-left-par? (stack-top S))))
|
|
(q-push Q ( pop S)))
|
|
(when (stack-empty? S) (error 'misplaced-parenthesis "()" ))
|
|
(pop S)] ; // left par
|
|
|
|
[(is-op? token)
|
|
(while (and
|
|
(is-op? (stack-top S))
|
|
(or
|
|
(and (is-left? token) (<= (op-prec token) (op-prec (stack-top S))))
|
|
(and (is-right? token) (< (op-prec token) (op-prec (stack-top S))))))
|
|
(q-push Q (pop S)))
|
|
(push S token)]
|
|
|
|
[(is-num? token) (q-push Q token)]
|
|
[else (error 'bad-token token)])) ; for
|
|
(while (stack-top S) (q-push Q (pop S))))
|
|
|
|
(string-delimiter "")
|
|
(define (task infix)
|
|
(define S (stack 'S))
|
|
(define Q (queue 'Q))
|
|
(shunt (text-parse infix) S Q)
|
|
(writeln 'infix infix)
|
|
(writeln 'RPN (queue->list Q)))
|