+Implied infix multiplication, no space required
authorAlex Klinkhamer <grencez@gmail.com>
Tue, 8 Jul 2008 03:27:32 +0000 (7 23:27 -0400)
committerAlex Klinkhamer <grencez@gmail.com>
Tue, 8 Jul 2008 03:27:32 +0000 (7 23:27 -0400)
And also fixed the messages about vector dimensions being wrong.

doc/infix_specifics.txt
src/infix-parser.lisp
src/overload/tuples.lisp

index 9e5df98..e145210 100644 (file)
@@ -13,12 +13,12 @@ Infix notation is obviously more natural for mathematics; it provides
 some shortcuts as well. First and foremost, a blank space generally
 implies multiplication.
 
- a b = a*b
+ a b = ab = a*b
  2 3 = 2*3 = 6; though it's ugly without the operator.
 
 A space can also imply a function call.
 
- rref A = rref(A)
+ rref A = rref(A) = rrefA
 
 ------------------------------------------------------------------------
 
@@ -38,6 +38,8 @@ determinant function and give its image for the 5x5 matrix /A/.
 
  det (A 2) = |2A| = 96
 
+ det2A = detA2 = 6
+
 More to come.
 
 ------------------------------------------------------------------------
index 05b7504..e98f888 100644 (file)
@@ -1,5 +1,8 @@
 
-;;;; Here is the dreaded infix parser.
+;;;; I suggest you move along to another file,
+;;;; this one is terribly coded and in constant change.
+;;;; But if you care to look around - good luck.
+
 ;;;; Heavily commented so I remember what happens here.
 ;
 ; General setup:
 ; is DIFFERENT between the two. Function scope is notably more
 ; complex because I don't require ONE function parameter to be
 ; enclosed in parentheses, multiple parameters require them.
-;
-; TODO: overhaul parser to read 2a as 2*a
-; This will be a big change, optionally giving functions
-; control of the reader to parse their arguments.
 
 (in-package :lineal)
 
+;;; Should probably handle this more dynamically at compile-time.
 ;V Set precedence ranks.V
 (defconstant +base-rank+ 0)
 (defconstant +paren-rank+ 1)
     (catch 'fn-scope
            (parsed-opern +multn-rank+ #'multn))))
 
+;;; See if /parsed-thing/ can be interpreted
+;;; in any way. If so, call success-fn, then
+;;; finish interpreting.
+(defun interpret-parsed
+  (parsed-thing &optional (success-fn #'values))
+  (declare (special *last-read*))
+  (multn-if-last-read);< Check for implied multiplication.
+  (if (symbolp parsed-thing)
+    (when (boundp parsed-thing)
+      (let ((val (symbol-value parsed-thing)))
+        (funcall success-fn)
+        (if (symbolp val)
+          ;; A symbol representing a function
+          ;; was read, change scope.
+          (parse-function-scope
+            (symbol-function val))
+          (setq *last-read* val))))
+    (progn
+      ;; The reader thinks it's something other
+      ;; than a symbol, parser doesn't need to worry.
+      (funcall success-fn)
+      (setq *last-read* parsed-thing))))
+
+;;; An invalid symbol was read,
+;;; could be something like "34x"
+(defun parse-compact (&optional sym &aux arrlen)
+  (declare (special *parse-next* *last-read*))
+  (if sym
+    ;; Must create *parse-next* from a symbol
+    (let ((sym-str (symbol-name sym)))
+      (setq arrlen (length sym-str)
+            *parse-next*
+            (make-array arrlen
+                        :element-type 'character
+                        :fill-pointer (1- arrlen)
+                        :displaced-to sym-str)))
+    (setq arrlen (length *parse-next*)))
+  (loop
+    :for index :from (fill-pointer *parse-next*) :downto 1
+    :do
+    (let (successp)
+      (setf (fill-pointer *parse-next*) index)
+      (interpret-parsed
+        (let ((*package* (find-package :lineal.client-vars)))
+          (read-from-string *parse-next*))
+        (lambda ()
+          ;; We found valid input.
+          (setf successp t)
+          (if (= index arrlen)
+            (setf *parse-next* nil)
+            (setf
+              (fill-pointer *parse-next*) arrlen
+              *parse-next*
+              (make-array (- arrlen index)
+                          :element-type 'character
+                          :fill-pointer t
+                          :displaced-to *parse-next*
+                          :displaced-index-offset index)))))
+      (when successp (return)))
+    :finally
+    ;; Nothing matched; quit trying.
+    (setf (fill-pointer *parse-next*) arrlen)
+    (signal 'unbound-variable :name *parse-next*)))
+
+
 ;;; Everything in the file calls this
 ;;; read function on the infix stream.
-(defun read-next-infix (strm)
-  (declare (special *unwind-rank-fn* *last-read*))
-  (handler-case
-    (let (this-read)
-      (let ((*package* (find-package
-                         :lineal.client-vars)))
-        ;; Actually read from the stream,
-        ;; sometimes an exception is thrown and
-        ;; control breaks to the current "read loop"
-        (setq this-read (read strm)))
-      (when this-read
-        ;; Did not just read an operator.
-        (multn-if-last-read);< Check for implied multiplication.
-        (if (symbolp this-read)
-          (let ((val (symbol-value this-read)))
-            ;; Don't bother checking boundp,
-            ;; there's a condition catch in
-            ;; process-infix-from-stream
-            (if (symbolp val)
-              ;; A symbol representing a function
-              ;; was read, change scope.
-              (parse-function-scope
-                strm (symbol-function val))
-              (setq *last-read* val)))
-          (setq *last-read* this-read))))
-    (end-of-file
-      (condit)
-      (declare (ignore condit))
-      ;; Don't check for unclosed parentheses,
-      ;; be like the TI-83
-      (funcall *unwind-rank-fn*
-               +base-rank+ *last-read*))))
+(defun read-next-infix ()
+  (declare (special *unwind-rank-fn* *last-read*
+                    *parse-strm* *parse-next*))
+  (if *parse-next* (parse-compact)
+    (handler-case
+      (let (this-read)
+        (let ((*package* (find-package
+                           :lineal.client-vars)))
+          ;; Sometimes an exception is thrown and
+          ;; control breaks to the current "read loop"
+          (setq this-read (read *parse-strm*)))
+        (when (and this-read
+                   ;; Did not just read an operator.
+                   (let (successp)
+                     (interpret-parsed
+                       this-read
+                       (lambda () (setf successp t)))
+                     (not successp)))
+          ;; We have no idea wtf was just read.
+          (parse-compact this-read)))
+      (end-of-file
+        (condit)
+        (declare (ignore condit))
+        ;; Don't check for unclosed parentheses,
+        ;; be like the TI-83
+        (funcall *unwind-rank-fn*
+                 +base-rank+ *last-read*)))))
 
 ;;; This is a generic construct for a closure
 ;;; which will be stored as *unwind-rank-fn*
       *unwind-rank-fn* this-unwind-rank-fn)
     nil))
 
-(defun parse-function-scope (strm this-fn)
+(defun open-paren-after-whitespace-peekp ()
+  (declare (special *parse-strm* *parse-next*))
+  (unless *parse-next*
+    (do () ((not (char= #\Space (peek-char nil *parse-strm*)))
+            (char=  #\( (peek-char nil *parse-strm*)))
+      (read-char *parse-strm*))))
+
+(defun closed-paren-peekp ()
+  (declare (special *parse-strm* *parse-next*))
+  (unless *parse-next*
+    (char= #\) (peek-char nil *parse-strm*))))
+
+(defun parse-function-scope (this-fn)
   (declare (special *unwind-rank-fn* *last-read*))
-  (do () ((not (char= #\Space (peek-char nil strm))))
-    (read-char strm))
-  (when (char= #\( (peek-char nil strm))
+  (when (open-paren-after-whitespace-peekp)
     ;; User chose to enclose the
     ;; argument(s) in parentheses.
-    (read-next-infix strm)
+    (read-next-infix)
     (setq *last-read*
           (if (consp *last-read*)
             (apply this-fn *last-read*)
             (funcall this-fn *last-read*)))
     (return-from parse-function-scope (values)))
-  (when (char= #\) (peek-char nil strm))
+  (when (closed-paren-peekp)
     ;; Using notation like (f*g)(x)
     ;; (unimplemented)
     (setq *last-read* this-fn)
       'break-fn-scope
       (do () (nil)
         (catch 'fn-scope
-               (read-next-infix strm))))
+               (read-next-infix))))
     (funcall *unwind-rank-fn*
              +fn-rank+ *last-read*)))
 
 ;;; "read-eval" loop used by process-infix-from-stream
 ;;; and open-paren-reader
-(defun parse-infix (strm)
+(defun parse-infix ()
   (declare (special *unwind-rank-fn* *last-read*))
   (let ((prev-unwind-rank-fn *unwind-rank-fn*)
         this-unwind-rank-fn)
         'break-fn-scope
         (catch
           'fn-scope
-          (read-next-infix strm))))))
+          (read-next-infix))))))
 
 (defun open-paren-reader (strm ch)
-  (declare (ignore ch))
+  (declare (ignore strm ch))
   (multn-if-last-read)
   (catch 'break-paren-scope
-         (parse-infix strm))
+         (parse-infix))
   nil)
 
 ;;; Unwind the operation stack.
     (set-opern-reader #\/ +divisn-rank+ #'divisn)
     (set-opern-reader #\^ +exptn-rank+ #'exptn))
 
-
 (defun process-infix-from-stream (strm)
   (let ((*readtable* *infix-readtable*)
+        (*parse-strm* strm);< Stream to parse.
+        *parse-next*;< Temporary buffer if we overparsed.
         (*unwind-rank-fn*
           (lambda (op-rank val)
             (declare (ignore op-rank))
             (throw 'end-result val)))
         *last-read*)
-    (declare (special *unwind-rank-fn* *last-read*))
+    (declare (special
+               *parse-strm* *parse-next*
+               *unwind-rank-fn* *last-read*))
     (handler-case
       (catch 'over-ex
              (catch 'end-result
-                    (parse-infix strm)))
+                    (parse-infix)))
       (control-error
         (condit)
         (declare (ignore condit))
         (format
           nil "Likely too many parens! ~
           (as if there were such a thing)~%"))
+      (unbound-variable
+        (condit)
+        (format nil "I don't understand: ~A~%"
+                (cell-error-name condit)))
       (error
         (condit)
         (format
index 60e5fa4..b0b2e9d 100644 (file)
@@ -5,13 +5,15 @@
   (dim 0 :type (integer 0 *))
   (elems nil :type list))
 
+;;; Make sure tuple /u/ is represented by a cons.
+;;; Optionally do dimension checking.
 (defmacro ensure-tuple-is-cons
   (u &optional dim str)
   (if dim
     `(if (consp ,u)
        (unless (= (length ,u) ,dim)
          (throw 'over-ex ,str))
-       (if (= (tuple-dim ,u) 3)
+       (if (= (tuple-dim ,u) ,dim)
          (setq ,u (tuple-elems ,u))
          (throw 'over-ex ,str)))
     `(unless (consp ,u)