Arithmetic evaluation: Difference between revisions

Line 858:

(defun group-parentheses (tokens &optional (delimited nil))

(do ((new-tokens '()))

((endp tokens~~) (values (nreverse new-tokens) '())~~)

((endp tokens)

(when delimited

(cerror "Insert it." "Expected right parenthesis."))

⚫

(values (nreverse new-tokens) '()))

(let ((token (pop tokens)))

(case token

Line 867:

Line 870:

tokens remaining-tokens)))

((:rparen)

(~~assert delimited~~ () ~~"Unexpected right parenthesis."~~)

(if (not delimited)

(cerror "Ignore it." "Unexpected right parenthesis.")

⚫

~~(return~~ (values (nreverse new-tokens) ~~tokens~~)))

(return (values (nreverse new-tokens) tokens))))

(otherwise

(push token new-tokens))))))

Line 874:

Line 878:

(defun group-operations (expression)

(flet ((gop (exp) (group-operations exp)))

(if ~~(or~~ (eql (car expression) :integer) ~~; <integer>~~

(if (eql (car expression) :integer) expression

(~~endp~~ ~~(cdr~~ ~~expression)~~) ~~; (e1~~)

(destructuring-bind (A &optional (x nil xp) B (y nil yp) C &rest others)

~~(endp (cdddr~~ expression~~))) ; (e1 op e2)~~

expression

~~expression~~

(cond

((not xp) (gop A))

(destructuring-bind (A x B y C &rest others) expression

~~(let~~ ((A ~~(gop A)~~) (B (gop B)) (C (gop C)))

((not yp) (list (gop A) x (gop B)))

(if (~~and~~ (~~find~~ x #(~~:add~~ ~~:subtract~~))

(t (let ((a (gop A)) (B (gop B)) (C (gop C)))

(find y #(:~~multiply~~ :~~divide)~~))

(if (and (find x #(:add :subtract))

~~(gop~~ (list* A x ~~(list~~ B y C) ~~others~~))

(find y #(:multiply :divide)))

(gop (list* ~~(list~~ A x B) y C others~~))))))~~))

(gop (list* A x (list B y C) others))

(gop (list* (list A x B) y C others))))))))))

(defun evaluate-expression (expression)