Infix evaluation in scheme...?

scheme-infix.scm

#lang r5rs
(#%require schemeunit)

(define ** expt)
(define (!= x y) (not (= x y)))
(define (^^ a b) (or (and a (not b))
                      (and b (not a))))
; can you believe they made && and || special forms???
(define (&& a b) (and a b))
(define (|| a b) (or a b))
(define :: cons)

; a list of lists of operators. lists are evaluated in order, so this also
; determines operator precedence
(define infix-operators
  (list
    (list modulo quotient remainder gcd lcm)
    (list **)
    (list * /)
    (list + -)
    (list memq memv member assq assv assoc)
    (list ::)
    ; now this is interesting: because scheme is dynamically typed, we aren't
    ; limited to any one type of function
    (list < > = != <= >=)
    (list &&)
    (list || ^^)
    ))

;;; evaluates `terms` as a basic infix expression
(define (! . terms)
  ; evaluate one group of operators in the list of terms
  (define (!** terms stack operators odd?)
    ; why `odd?`? because scheme's list-iteration is forwards-only and
    ; list-construction is prepend-only, every other group of operators is
    ; actually evaluated backwards which, for operators like / and -, can be a
    ; big deal! therefore, we keep this flipped `odd?` counter to track if we
    ; should flip our arguments or not
    (define (calc op a b)
      (if odd? (op a b) (op b a)))

    (cond ((null? terms) stack) ; base case
          ; operator we can evaluate -- pop operator and operand, then recurse
          ((and (> (length stack) 1) (memq (car stack) operators))
           (let ((op (car stack))
                 (fst (car terms))
                 (snd (cadr stack)))
             (!** (cdr terms)
                  (cons (calc op fst snd) (cddr stack))
                  operators
                  (not odd?))))
          ; otherwise just keep building the stack
          (else (!** (cdr terms)
                     (cons (car terms) stack)
                     operators
                     (not odd?)))))

  ; evaluate a list of groups of operators in the list of terms
  (define (!* terms operator-groups odd?)
    (if (or (null? operator-groups) ; done evaluating all operators
            (null? (cdr terms)))    ; only one term left
        terms ; finished processing operator groups
        ; evaluate another group -- separating operators into groups allows
        ; operator precedence
        (!* (!** terms '() (car operator-groups) odd?)
            (cdr operator-groups)
            (not odd?))))

  (car (!* terms infix-operators #f)))

(check = (! 5 - 6)          -1)
(check = (! 2 * 3)           6)
(check = (! 2 * 3 + 2)       8)
(check = (! 2 * 3 + 4 * 5)  26)
(check = (! 0 - 4)          -4)
(check = (! 4 + 3 * 2 - 19) -9)

; also works for inequalities!
(check eq? (! 4 + 3 * 2 - 19 < 0 - 4) #t)
(check eq? (! -2 * 2 = 0 - 4)         #t)