From 79a689c72b69aff8a84f769a199e2226bd2028b8 Mon Sep 17 00:00:00 2001
From: Alex Klinkhamer <grencez@gmail.com>
Date: Mon, 7 Jul 2008 10:20:58 -0400
Subject: [PATCH] +Negatives work after a comma

---
 src/infix-parser.lisp | 42 ++++++++++++++++++++++++------------------
 1 file changed, 24 insertions(+), 18 deletions(-)

diff --git a/src/infix-parser.lisp b/src/infix-parser.lisp
index 680071e..05b7504 100644
--- a/src/infix-parser.lisp
+++ b/src/infix-parser.lisp
@@ -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
@@ -102,7 +104,7 @@
         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))
@@ -114,7 +116,7 @@
       *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*
@@ -128,7 +130,7 @@
     (setq
       *last-read* nil
       this-unwind-rank-fn
-      (opern-climber-fn
+      (opern-climber-lambda
         (this-rank op-rank val)
         (cond
           ((= this-rank op-rank)
@@ -147,7 +149,6 @@
       *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))))
@@ -171,7 +172,7 @@
     (setq
       *last-read* nil
       this-unwind-rank-fn
-      (opern-climber-fn
+      (opern-climber-lambda
         (+fn-rank+ op-rank val)
         (cond
           ((< op-rank +fn-rank+)
@@ -208,7 +209,7 @@
     (setq
       *last-read* nil
       this-unwind-rank-fn
-      (opern-climber-fn
+      (opern-climber-lambda
         (+paren-rank+ op-rank val)
         (cond
           ((< op-rank +paren-rank+)
@@ -268,7 +269,8 @@
     (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
@@ -296,14 +298,9 @@
       (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)
@@ -313,7 +310,17 @@
     (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
@@ -342,4 +349,3 @@
   (with-input-from-string (strm text)
     (process-input-from-stream strm infixp)))
 
-    
-- 
2.11.4.GIT