Skip to content

Instantly share code, notes, and snippets.

@9999years
Created August 22, 2019 02:04
Show Gist options
  • Save 9999years/993e8c84e2eeec9301bb3a24501fdfcd to your computer and use it in GitHub Desktop.
Save 9999years/993e8c84e2eeec9301bb3a24501fdfcd to your computer and use it in GitHub Desktop.
Infix evaluation in scheme...?
#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)
@damien-mattei
Copy link

Exponentiation is right evaluated (not left) but how modify the code to fix this bug?

@9999years
Copy link
Author

9999years commented May 17, 2024

@damien-mattei These seem to work for me:

(display (! 2 ** 3))  ; 2*2*2 = 8
(display (! 4 ** 2))  ; 4*4 = 16

Or do you mean that 2 ** 3 ** 2 is parsed as 2 ** (3 ** 2) = 512 instead of (2 ** 3) ** 2 = 64? I'm not sure that the exponentiation operator should be left-associative.

At any rate, this is just a little toy definition from college. I'll leave right-associative operators as an exercise for the reader :)

@damien-mattei
Copy link

damien-mattei commented May 17, 2024

yes by convention the exponentiation operator is right-associative (of course mathematically talking exponentiation is not associative) there is something strange in the code too because odd? is depending to the parity of the place of the current operator group in the list of operator precedence... i'm checking all that and try to modify the code.... thank for your answer

note : not sure it is from college level all that :-)

in fact i do not understand why odd? change at each call of !** , if i keep it in code it give a correct result too on one example.Between each complete pass of expression it is ok to (not odd?) in !* because the stack is reverse of what we want indeed.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment