fix: webserver

Author: ryukinix

fix-quicklisp.lisp

@@ -1,3 +1,10 @@
 (eval-when (:load-toplevel :execute)
   (pushnew (truename (sb-unix:posix-getcwd/)) ql:*local-project-directories* )
-  (ql:register-local-projects))
+  (ql:register-local-projects)
+
+  ;; install ultralisp if necessary
+  (unless (member "ultralisp" (ql-dist:all-dists)
+                  :key 'ql-dist:name
+                  :test 'string=)
+    (ql-dist:install-dist "http://dist.ultralisp.org/"
+                          :prompt nil)))

lisp-inference.asd

@@ -31,6 +31,7 @@
   :depends-on (:lisp-inference
                :weblocks
                :weblocks-ui
+               :clack-handler-hunchentoot
                :find-port
                :str)
   :pathname "web"

src/pratt.lisp

@@ -2,11 +2,13 @@
 
 (defparameter *binding-precedence*
   '(
-    ("^" . 80) 
+    ("^" . 80)
     ("v" . 70)
-    ("[+]" . 60) 
+    ("[+]" . 60)
     ("=>" . 50)
-    ("<=>" . 40)))
+    ("->" . 50)
+    ("<=>" . 40)
+    ("<->" . 40)))
 
 (defvar *tokens* nil)
 (defvar *pos* 0)
@@ -22,11 +24,11 @@
          ((member c '(#\Space #\Tab #\Newline)) (read-char stream) (read-token stream))
          ((alpha-char-p c)
           (let ((sym (read stream)))
-                      (list (string-downcase (string sym)))))
+            (list (string-downcase (string sym)))))
          (t
           (let ((token (with-output-to-string (out)
                          (loop for ch = (peek-char nil stream nil nil)
-                               while (and ch (find ch "<=>[+]"))
+                               while (and ch (find ch "<=>-[+]"))
                                do (write-char (read-char stream) out)))))
             (if (string= token "") (list (string (read-char stream))) (list token)))))))))
 
@@ -36,10 +38,10 @@
           while token
           append token)))
 
-(defun next-token () 
+(defun next-token ()
   (nth *pos* *tokens*))
 
-(defun advance () 
+(defun advance ()
   (prog1 (next-token) (incf *pos*)))
 
 (defun match (tok)
@@ -73,4 +75,4 @@
 (defun parse-logic (input)
   (setf *tokens* (tokenize input)
         *pos* 0)
-  (parse-expression))
+  (parse-expression))

web/webapp.lisp

@@ -22,8 +22,7 @@
 (defvar *proposition* "P => Q" "Default proposition")
 (defvar *port* (find-port:find-port))
 (defvar *notes*
-  '("My lexer doesn't work very well with parenthesis."
-    "Please, don't be evil. Use less than 10 variables."
+  '("Please, don't be evil. Use less than 10 variables."
     "Yes, [+] it's a XOR. Mathematically: p ⊕ q."
     "(=> ->) and (<=> <->) are aliases."))
 
@@ -43,24 +42,19 @@
 (defun truth-table (exp)
   (with-output-to-string (s)
     (let ((inference:*output-stream* s))
-      (inference:print-truth-table exp))))
+      (inference:print-truth-table (inference:parse-logic exp)))))
 
-(defun create-table (exp)
+(defun create-table (exp-string)
   (make-instance 'table
-                 :prop (format nil "~a" exp)
-                 :truth (truth-table exp)))
+                 :prop exp-string
+                 :truth (truth-table exp-string)))
 
 (defgeneric update-table (table exp))
 
-(defmethod update-table (table (exp list))
-  (setf (prop table) (format nil "~a" exp))
-  (setf (truth table) (truth-table exp)
-  (update table))
-
 (defmethod update-table (table (exp string))
-  (update-table
-   table
-   (inference:parse-logic exp)))
+  (setf (prop table) exp)
+  (setf (truth table) (truth-table exp))
+  (update table))
 
 (defmethod render ((table table))
   (with-html
@@ -93,7 +87,7 @@
 
 (defmethod weblocks/session:init ((app truth-table))
   (declare (ignorable app))
-  (create-table (parse-string *proposition*)))
+  (create-table *proposition*))
 
 (defun start (&optional (port *port*))
   (weblocks/debug:on)