(defvar *operators* '(+ - * / ^))
(defun position-of-min (list ordering)
"Find the element in LIST that occurs earliest in ORDERING. Return the element and its position."
(let ((positions nil)
(i 0))
(dolist (elt ordering (values-list (rest (first (sort positions #'< :key #'first)))))
(when (find elt list)
(push (list (incf i) (position elt list :from-end t) elt) positions)))))
(defun infix-to-prefix (exp)
"Translate a list of the form (1 + 1) into (+ 1 1) - i.e. convert infix style math to prefix."
(if (atom exp)
exp
(case (length exp)
(1 (first exp))
(2 (list (first exp) (infix-to-prefix (second exp))))
(3 (list (second exp) (infix-to-prefix (first exp)) (infix-to-prefix (third exp))))
(t (multiple-value-bind (i op) (position-of-min exp *operators*)
(let ((left (butlast exp (- (length exp) i)))
(right (nthcdr (1+ i) exp)))
(list op (infix-to-prefix left) (infix-to-prefix right))))))))