Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (eval-when (:compile-toplevel :execute :load-toplevel)
- (defvar *infix-precedence* '((* /)
- (+ -)
- (> < >= <= == !=)
- (&&)
- (||)))
- (defvar *unary-ops* '(+ -))
- (defun infix-to-prefix (expr ops stop-ops)
- (let ((first (car expr))
- (rest (cdr expr)))
- (cond
- ((and (listp first) (not (eq (car first) 'op-wrapper)))
- (infix-to-prefix (nconc
- (infix-to-prefix first *infix-precedence* nil)
- rest)
- ops
- stop-ops))
- ((find first *unary-ops*)
- (infix-to-prefix (list*
- (list 'op-wrapper
- first
- (car (infix-to-prefix
- (list (car rest))
- nil
- nil)))
- (cdr rest))
- ops
- stop-ops))
- ((equal (car ops) stop-ops) expr)
- ((find (car rest) (car ops))
- (infix-to-prefix
- (let ((e (infix-to-prefix (cdr rest)
- *infix-precedence*
- (car ops))))
- (list* (list 'op-wrapper (car rest) first (car e))
- (cdr e)))
- ops
- stop-ops))
- ((consp (car rest))
- (infix-to-prefix
- (list* (list* 'op-wrapper
- first
- (mapcar (lambda (x)
- (car (infix-to-prefix
- (list x)
- *infix-precedence*
- nil)))
- (car rest)))
- (cdr rest))
- ops
- stop-ops))
- (ops (infix-to-prefix (list* first (cdr expr))
- (cdr ops)
- stop-ops))
- (t first)))))
- (defmacro op-wrapper (&rest args) args)
- (defmacro c-expr (&rest expr)
- (car (infix-to-prefix expr *infix-precedence* nil)))
- (defun == (left right) (equal left right))
- (defun != (left right) (not (equal left right)))
- (defun && (left right) (and left right))
- (defun || (left right) (or left right))
- ; (trace infix-to-prefix)
- (defun sum (x y) (+ x y))
- (print (c-expr - 2 + sum ( 10 20 ) == 28 ))
Add Comment
Please, Sign In to add comment