+Negatives work after a comma
authorAlex Klinkhamer <grencez@gmail.com>
Mon, 7 Jul 2008 14:20:58 +0000 (7 10:20 -0400)
committerAlex Klinkhamer <grencez@gmail.com>
Mon, 7 Jul 2008 14:20:58 +0000 (7 10:20 -0400)
src/infix-parser.lisp

index 680071e..05b7504 100644 (file)
@@ -82,7 +82,9 @@
       (funcall *unwind-rank-fn*
                +base-rank+ *last-read*))))
 
-(defmacro opern-climber-fn
+;;; This is a generic construct for a closure
+;;; which will be stored as *unwind-rank-fn*
+(defmacro opern-climber-lambda
   ((this-rank op-rank val) . body)
   `(lambda (,op-rank ,val)
      (unless ,val
         this-unwind-rank-fn)
     (setq
       this-unwind-rank-fn
-      (opern-climber-fn
+      (opern-climber-lambda
         (prev-rank op-rank val)
         (if (and (< prev-rank op-rank)
                  (< +multn-rank+ op-rank))
       *unwind-rank-fn* this-unwind-rank-fn)
     (throw 'fn-scope (values))))
 
-;;; An operator is parsed.
+;;; A binary operator is parsed.
 (defun parsed-opern (this-rank this-op-fn)
   (declare (special *unwind-rank-fn* *last-read*))
   (unless *last-read*
     (setq
       *last-read* nil
       this-unwind-rank-fn
-      (opern-climber-fn
+      (opern-climber-lambda
         (this-rank op-rank val)
         (cond
           ((= this-rank op-rank)
       *unwind-rank-fn* this-unwind-rank-fn)
     nil))
 
-
 (defun parse-function-scope (strm this-fn)
   (declare (special *unwind-rank-fn* *last-read*))
   (do () ((not (char= #\Space (peek-char nil strm))))
     (setq
       *last-read* nil
       this-unwind-rank-fn
-      (opern-climber-fn
+      (opern-climber-lambda
         (+fn-rank+ op-rank val)
         (cond
           ((< op-rank +fn-rank+)
     (setq
       *last-read* nil
       this-unwind-rank-fn
-      (opern-climber-fn
+      (opern-climber-lambda
         (+paren-rank+ op-rank val)
         (cond
           ((< op-rank +paren-rank+)
     (setq
       *last-read* nil
       this-unwind-rank-fn
-      (lambda (op-rank val)
+      (opern-climber-lambda
+        (+comma-rank+ op-rank val)
         (cond
           ((= +comma-rank+ op-rank)
            (setq
       (declare (ignore strm ch))
       (parsed-opern this-rank this-op-fn))))
 
-(defun process-infix-from-stream (strm)
-  (let ((*readtable* (copy-readtable))
-        (*unwind-rank-fn*
-          (lambda (op-rank val)
-            (declare (ignore op-rank))
-            (throw 'end-result val)))
-        *last-read*)
-    (declare (special *unwind-rank-fn* *last-read*))
+(defparameter *infix-readtable* (copy-readtable))
+
+(let ((*readtable* *infix-readtable*))
     (setf (readtable-case *readtable*) :preserve)
     (set-macro-character #\( #'open-paren-reader)
     (set-macro-character #\) #'close-paren-reader)
     (set-opern-reader #\- +subtrn-rank+ #'subtrn)
     (set-opern-reader #\* +multn-rank+ #'multn)
     (set-opern-reader #\/ +divisn-rank+ #'divisn)
-    (set-opern-reader #\^ +exptn-rank+ #'exptn)
+    (set-opern-reader #\^ +exptn-rank+ #'exptn))
+
+
+(defun process-infix-from-stream (strm)
+  (let ((*readtable* *infix-readtable*)
+        (*unwind-rank-fn*
+          (lambda (op-rank val)
+            (declare (ignore op-rank))
+            (throw 'end-result val)))
+        *last-read*)
+    (declare (special *unwind-rank-fn* *last-read*))
     (handler-case
       (catch 'over-ex
              (catch 'end-result
   (with-input-from-string (strm text)
     (process-input-from-stream strm infixp)))
 
-