Boolean Algebra
https://github.com/natefusion/booleanThis project has some experiments with parsing of mathematical expressions, executing boolean algebra, and term rewriting.
Expression parsing
Expression parsing is handled by the following functions:1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | (defun notation (exp &optional vars) (let (variables) (labels ((infix-binding-power (op) (case op (or (values 1 2)) ((and xor) (values 3 4)) (|)| (values nil nil '|)|)) (t (values 3 4 'implicit-*)))) (postfix-binding-power (op) (case op (not 10) (t nil))) (infix->prefix (min-bp) (loop with lhs = (let ((lhs (pop exp))) (case lhs (|(| (prog1 (infix->prefix 0) (unless (eq (pop exp) '|)|) (error "No closing parenthesis somewhere lol")))) ((or and xor) (list lhs (infix->prefix lhs))) (t lhs))) for op = (car exp) do (unless op (loop-finish)) (block thing (multiple-value-bind (lhs-bp) (postfix-binding-power op) (when lhs-bp (when (< lhs-bp min-bp) (loop-finish)) (pop exp) (setf lhs (list op lhs)) (return-from thing))) (multiple-value-bind (lhs-bp rhs-bp special) (infix-binding-power op) (cond ((or (eq special '|)|) (< lhs-bp min-bp)) (loop-finish)) ((eq special 'implicit-*) (setf op 'and)) (t (pop exp))) (setf lhs (list op lhs (infix->prefix rhs-bp))))) finally (return lhs))) (lex (exp) (loop for x across exp append (if (alpha-char-p x) (let ((a (read-from-string (string x)))) (pushnew a variables) (list a)) (case x ((#\') '(not)) ((#\+) '(or)) ((#\*) '(and)) ((#\^) '(xor)) ((#\() '(|(|)) ((#\)) '(|)|)) ((#\0) '(nil)) ((#\1) '(t)) ((#\space)) (t (error "wot in tarnation is '~a' doing here" x))))))) (setf exp (lex exp)) (list (mapcar (lambda (x) (read-from-string (string x))) (sort (union vars variables) #'var<=)) (infix->prefix 0))))) |