Merge pull request #12 from ryukinix/infix-to-prefix-fix

Make infix-to-prefix works with unary operations

Author: ryukinix

lisp-inference.asd

@@ -8,7 +8,7 @@
   :description "An Inference Engine using Propositional Calculus"
   :author "Manoel Vilela <[email protected]>"
   :license "BSD"
-  :version "0.1.0"
+  :version "0.2.0"
   :serial t
   :pathname "src"
   :components ((:file "package")
@@ -25,7 +25,7 @@
   :description "Lisp Inference Test Suit"
   :author "Manoel Vilela <[email protected]>"
   :license "BSD"
-  :version "0.1.0"
+  :version "0.2.0"
   :serial t
   :pathname "t"
   :depends-on (:lisp-inference :prove)

src/package.lisp

@@ -40,6 +40,7 @@
            #:make-biconditional
            #:*valid-operators*
            #:prefix-to-infix
+           #:infix-to-prefix
            #:print-truth-table ;; truth-table.lisp
            #:eval-expression
            #:equal-expression

src/parser.lisp

@@ -112,8 +112,19 @@
 
 
 (defun infix-to-prefix (exp)
-    (cond ((atom exp) exp)
-          ((null (cdr exp)) (infix-to-prefix (car exp)))
-          (t (list (cadr exp)
-                   (infix-to-prefix (car exp))
-                   (infix-to-prefix (cddr exp))))))
+  "INFIX-TO-PREFIX translate a infix expression to a prefix expression.
+
+This function assumes that exp it is not ambiguous.
+In that case, use a completly 'parenthesed' expression
+
+Returns a new prefixed list.
+"
+  (cond ((atom exp) exp)
+        ((and (listp exp)
+              (= 2 (length exp)))
+         (list (car exp)
+               (infix-to-prefix (cdr exp))))
+        ((null (cdr exp)) (infix-to-prefix (car exp)))
+        (t (list (cadr exp)
+                 (infix-to-prefix (car exp))
+                 (infix-to-prefix (cddr exp))))))

src/truth-table.lisp

@@ -3,6 +3,9 @@
 
 (in-package :lisp-inference)
 
+(defparameter *truth-string* "T")
+(defparameter *false-string* "F")
+
 (defun propositionp (symbol)
   "Check if the given SYMBOL can be a proposition (letters)"
   (and (atom symbol)
@@ -106,8 +109,8 @@
 
 (defun pretty-values (v)
   (if (not (null v))
-      "T"
-      "F"))
+      *truth-string*
+      *false-string*))
 
 (defun prepare-table (evaluated-cases)
   "Get the evaluated cases after EVAL-OPERATIONS
@@ -204,10 +207,10 @@ a tautology."
 
 
 (defun main ()
-  (format t "Example of usage: (^ p q)~%Operators: ~a ~%" *valid-operators*)
+  (format t "Example of usage: (p ^ q)~%Operators: ~a ~%" *valid-operators*)
   (handler-case (loop do (princ "TRUTH-TABLE> ")
                       do (force-output)
-                      do (print-truth-table (read)))
+                      do (print-truth-table (infix-to-prefix (read))))
     (end-of-file () )
     #+sbcl (sb-sys:interactive-interrupt () nil))
 

t/test.lisp

@@ -102,4 +102,17 @@
                       '(p))
     "EQUAL EXPRESSION 2")
 
+(diag "== Infix Parsing")
+
+(is (infix-to-prefix '(~ (p v q)))
+    '(~ (v p q)))
+
+(is (infix-to-prefix '(p => q))
+    '(=> p q))
+
+(is (infix-to-prefix '((p v q) <=> ((~ p) ^ (~ q))))
+    '(<=> (v p q)
+         (^ (~ p)
+            (~ q))))
+
 (finalize)