Skip to content

Instantly share code, notes, and snippets.

@peey

peey/lisp-infix.lisp

Last active Jun 13, 2016
Embed
What would you like to do?
(defpackage :com.cxmcmbutterfly.lisp-infix
(:use :common-lisp)
(:export :$
:*operator-precedence-alist*))
(in-package :com.cxmcmbutterfly.lisp-infix)
;; default list of binary operations in the order of precedence, taken in the order that C++ takes it in sans lognor, logeqv and other binary operators unavailable in C++
;; , see http://clhs.lisp.se/Body/f_logand.htm
;; reference used: http://en.cppreference.com/w/cpp/language/operator_precedence
;; this is exported, and may be changed
(defparameter *operator-precedence-alist*
'((* . 5)
(/ . 5)
(mod . 5)
(+ . 6)
(- . 6)
(ash . 7)
(< . 8)
(<= . 8)
(> . 8)
(>= . 8)
(= . 9)
(/= . 9)
(eq . 9) ; for checking boolean equality
(logand . 10)
(logxor . 11)
(logior . 12) ; what's the i for? I hope this is same as cpp bitwise or
(and . 13)
(or . 14)))
(define-condition malformed-expression-error (error)
((text :initarg :text :reader text)))
;; returns values of stack, list of popped elements
(defun recursively-pop-stack (stack element operator-precedence-alist &optional (popped '()) )
(if (and (not (null stack))
(>= (cdr (assoc element operator-precedence-alist)) (cdr (assoc (first stack) operator-precedence-alist))))
;; recursively pop stack
(progn
(push (pop stack) popped)
(recursively-pop-stack stack element operator-precedence-alist popped))
;; else
(values (push element stack) popped)))
;; apply popped operators to first two operands in queue
(defun apply-popped (popped-stack queue)
(loop for operator in popped-stack ;; popped last is the index 0 element of the list/stack
do
(let ((b (pop queue))
(a (pop queue)))
(push (list operator a b) queue)))
queue)
;; an implementation of shunting-yard algorithm for operators w/o brackets
(defun shunting-yard (list-of-expressions operator-precedence-alist)
(let ((queue '())
(stack '()))
(loop for element in list-of-expressions
do
(if (assoc element operator-precedence-alist)
(multiple-value-bind (new-stack popped)
(recursively-pop-stack stack element operator-precedence-alist)
(setf stack new-stack)
(setf queue (apply-popped popped queue)))
;; if number / something that's expected to evaluated to a number
(push element queue)))
(first (apply-popped stack queue)))) ; append remaining stack to the queue, get the single expression left in the queue of expressions
(defmacro $ (&rest list-of-expressions)
"Infix binary operations for lisp!"
(shunting-yard list-of-expressions *operator-precedence-alist*))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.