(import (scheme base)
        (infix-to-prefix rule-set)
        (infix-to-prefix)
        (srfi 64))

(current-operator-rule-set
 (rule-set
  (list
   (operator '= 0)
   (operator '+ 1 (direction 'left #t) (identity 0))
   (operator '- 1 (direction 'left) (identity 0 #t #t 3))
   (operator '* 2 (direction 'left #t) (identity 1))
   (operator '/ 2 (direction 'left) (identity 1 #t))
   (operator '^ 4 (direction 'right) #f (prefix #t 'expt)))))

(test-begin "infix-to-prefix")

(test-equal '(+ a b)
  (infix->prefix '(a + b)))

(test-equal '(+ a b c)
  (infix->prefix '(a + b + c)))

(test-equal '(+ a (* b c))
  (infix->prefix '(a + b * c)))

(test-equal '(+ a b c)
  (infix->prefix '((a + b) + c)))

(test-equal '(+ a b)
  (infix->prefix '(a + (b + c))))

(test-equal '(- a b c)
  (infix->prefix '(a - b - c)))

(test-equal '(- a b c)
  (infix->prefix '((a - b) - c)))

(test-equal '(- a (- b c))
  (infix->prefix '(a - (b - c))))

(test-equal '(- (+ (- a b) c) d)
  (infix->prefix '(a - b + c - d)))

(test-equal '(+ (* a b) (* c d))
  (infix->prefix '(a * b + c * d)))

(test-equal '(- a)
  (infix->prefix '(- a)))

(test-equal '(* (- a) b)
  (infix->prefix '(- a * b)))

(test-equal '(- (expt a 2))
  (infix->prefix '(- a ^ 2)))

(test-end "infix-to-prefix")