Arithmetic evaluation: Difference between revisions
Content added Content deleted
(add mildly cheeky E example) |
(CL bugfixes and better error handling) |
||
Line 858: | Line 858: | ||
(defun group-parentheses (tokens &optional (delimited nil)) |
(defun group-parentheses (tokens &optional (delimited nil)) |
||
(do ((new-tokens '())) |
(do ((new-tokens '())) |
||
((endp tokens |
((endp tokens) |
||
(when delimited |
|||
(cerror "Insert it." "Expected right parenthesis.")) |
|||
⚫ | |||
(let ((token (pop tokens))) |
(let ((token (pop tokens))) |
||
(case token |
(case token |
||
Line 867: | Line 870: | ||
tokens remaining-tokens))) |
tokens remaining-tokens))) |
||
((:rparen) |
((:rparen) |
||
( |
(if (not delimited) |
||
(cerror "Ignore it." "Unexpected right parenthesis.") |
|||
⚫ | |||
(return (values (nreverse new-tokens) tokens)))) |
|||
(otherwise |
(otherwise |
||
(push token new-tokens)))))) |
(push token new-tokens)))))) |
||
Line 874: | Line 878: | ||
(defun group-operations (expression) |
(defun group-operations (expression) |
||
(flet ((gop (exp) (group-operations exp))) |
(flet ((gop (exp) (group-operations exp))) |
||
(if |
(if (eql (car expression) :integer) expression |
||
(destructuring-bind (A &optional (x nil xp) B (y nil yp) C &rest others) |
|||
expression |
|||
(cond |
|||
((not xp) (gop A)) |
|||
(destructuring-bind (A x B y C &rest others) expression |
|||
((not yp) (list (gop A) x (gop B))) |
|||
( |
(t (let ((a (gop A)) (B (gop B)) (C (gop C))) |
||
(if (and (find x #(:add :subtract)) |
|||
(find y #(:multiply :divide))) |
|||
(gop (list* |
(gop (list* A x (list B y C) others)) |
||
(gop (list* (list A x B) y C others)))))))))) |
|||
(defun evaluate-expression (expression) |
(defun evaluate-expression (expression) |