From: Alex Klinkhamer <grencez@gmail.com>
Date: Tue, 9 Sep 2008 21:06:15 +0000 (-0400)
Subject: +Infix parser converts to s-expressions now
X-Git-Url: https://repo.or.cz/w/lineal.git/commitdiff_plain/7ecfeb9a45bf80a194367e9c39b534e7a94a2476

+Infix parser converts to s-expressions now

Not tested very well.
---

diff --git a/src/infix-parser.lisp b/src/infix-parser.lisp
index ab7f27a..59bfaa7 100644
--- a/src/infix-parser.lisp
+++ b/src/infix-parser.lisp
@@ -56,7 +56,7 @@
     ;; Implicit multiplication, two
     ;; values were seperated by a space.
     (catch 'fn-scope
-           (parsed-opern +multn-rank+ #'multn))))
+           (parsed-opern +multn-rank+ 'multn))))
 
 ;;; See if /parsed-thing/ can be interpreted
 ;;; in any way. If so, call success-fn, then
@@ -72,9 +72,8 @@
         (if (symbolp val)
           ;; A symbol representing a function
           ;; was read, change scope.
-          (parse-function-scope
-            (symbol-function val))
-          (setq *last-read* val))))
+          (parse-function-scope val) ;(symbol-function val)
+          (setq *last-read* parsed-thing))))
     (progn
       ;; The reader thinks it's something other
       ;; than a symbol, parser doesn't need to worry.
@@ -183,7 +182,7 @@
                        this-unwind-rank-fn)
                  val)
           (funcall prev-unwind-rank-fn op-rank
-                   (funcall this-op-fn val))))
+                   (list this-op-fn val))))
       *unwind-rank-fn* this-unwind-rank-fn)
     (throw 'fn-scope (values))))
 
@@ -216,7 +215,7 @@
           (t
             (rplacd tail (cons val nil))
             (funcall prev-unwind-rank-fn op-rank
-                     (apply this-op-fn args)))))
+                     (cons this-op-fn args)))))
       *unwind-rank-fn* this-unwind-rank-fn)
     nil))
 
@@ -227,11 +226,11 @@
   (unless *last-read*
     ;; Make sure any negatives are applied.
     (funcall *unwind-rank-fn*
-             #'lineal.overload::over-factorial nil))
+             'lineal.overload::over-factorial nil))
   (setq *last-read*
-        (lineal.overload::factorial
-          (funcall *unwind-rank-fn*
-                   +factorial-rank+ *last-read*)))
+        (list 'lineal.overload::factorial
+              (funcall *unwind-rank-fn*
+                       +factorial-rank+ *last-read*)))
   nil)
 
 ;;; Specialized function to gobble whitespace
@@ -260,8 +259,10 @@
     (paren-scope t)
     (setq *last-read*
           (if (consp *last-read*)
-            (apply this-fn *last-read*)
-            (funcall this-fn *last-read*)))
+            ;V (apply this-fn *last-read*) V
+            (cons this-fn *last-read*)
+            ;V (funcall this-fn *last-read*) V
+            (list this-fn *last-read*)))
     (return-from parse-function-scope (values)))
   (when (closed-paren-peekp)
     ;; Using notation like (f*g)(x)
@@ -280,14 +281,14 @@
            ;; Breaking from parens or program.
            (funcall prev-unwind-rank-fn
                     op-rank (if (consp val)
-                              (apply this-fn val)
-                              (funcall this-fn val))))
+                              (cons this-fn val)
+                              (list this-fn val))))
           ((= op-rank +fn-rank+)
            ;; Return from the function scope.
            (setq *unwind-rank-fn* prev-unwind-rank-fn
                  *last-read* (if (consp val)
-                               (apply this-fn val)
-                               (funcall this-fn val)))
+                               (cons this-fn val)
+                               (list this-fn val)))
            (throw 'break-fn-scope (values)))
           (t ;V Stay in the function scope.V
             (setq *unwind-rank-fn* this-unwind-rank-fn)
@@ -341,7 +342,7 @@
     ;; Convert the list into a tuple
     ;; since it's not a function's parameters.
     (setq *last-read*
-          (lineal.overload::vcat-list *last-read*))))
+          (cons 'lineal.overload::over-vcat *last-read*))))
 
 ;;; A parenthesis has been opened!
 (defun open-paren-reader (strm ch)
@@ -371,7 +372,7 @@
          (parse-infix))
   (when (consp *last-read*)
     (setq *last-read*
-          (lineal.overload::cat-list *last-read*)))
+          (cons 'lineal.overload::over-cat *last-read*)))
   nil)
 
 ;;; If *last-read* is nil, an operator
@@ -434,14 +435,14 @@
     (set-macro-character #\] #'close-paren-reader)
     (set-macro-character #\Space #'space-reader)
     (set-macro-character #\, #'comma-reader)
-    (set-opern-reader #\+ +addn-rank+ #'addn)
-    (set-opern-reader #\- +subtrn-rank+ #'subtrn)
-    (set-opern-reader #\* +multn-rank+ #'multn)
-    (set-opern-reader #\/ +divisn-rank+ #'divisn)
+    (set-opern-reader #\+ +addn-rank+ 'addn)
+    (set-opern-reader #\- +subtrn-rank+ 'subtrn)
+    (set-opern-reader #\* +multn-rank+ 'multn)
+    (set-opern-reader #\/ +divisn-rank+ 'divisn)
     (set-macro-character #\! #'factorial-reader)
-    (set-opern-reader #\^ +exptn-rank+ #'exptn))
+    (set-opern-reader #\^ +exptn-rank+ 'exptn))
 
-(defun process-infix-from-stream (strm)
+(defun parse-infix-from-stream (strm)
   (let ((*readtable* *infix-readtable*)
         (*parse-strm* strm);< Stream to parse.
         *parse-next*;< Temporary buffer if we overparsed.
@@ -473,6 +474,9 @@
           nil "Evaluation flopped, perhaps bad input?~%~
           Debug info: ~A~%" condit)))))
 
+(defun process-infix-from-stream (strm)
+  (eval-parsed (parse-infix-from-stream strm)))
+
 (defun process-input-from-stream
   (strm &optional (infixp t))
   (let ((*read-default-float-format* 'double-float)