From 10c197c8685ada06e062bd13b9c08ca1f3e3ecc0 Mon Sep 17 00:00:00 2001 From: Alex Klinkhamer Date: Mon, 7 Jul 2008 23:27:32 -0400 Subject: [PATCH] +Implied infix multiplication, no space required And also fixed the messages about vector dimensions being wrong. --- doc/infix_specifics.txt | 6 +- src/infix-parser.lisp | 179 +++++++++++++++++++++++++++++++++-------------- src/overload/tuples.lisp | 4 +- 3 files changed, 135 insertions(+), 54 deletions(-) diff --git a/doc/infix_specifics.txt b/doc/infix_specifics.txt index 9e5df98..e145210 100644 --- a/doc/infix_specifics.txt +++ b/doc/infix_specifics.txt @@ -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. ------------------------------------------------------------------------ diff --git a/src/infix-parser.lisp b/src/infix-parser.lisp index 05b7504..e98f888 100644 --- a/src/infix-parser.lisp +++ b/src/infix-parser.lisp @@ -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: @@ -19,13 +22,10 @@ ; 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) @@ -47,40 +47,100 @@ (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* @@ -149,20 +209,30 @@ *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) @@ -196,13 +266,13 @@ '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) @@ -229,13 +299,13 @@ '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. @@ -312,25 +382,32 @@ (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 diff --git a/src/overload/tuples.lisp b/src/overload/tuples.lisp index 60e5fa4..b0b2e9d 100644 --- a/src/overload/tuples.lisp +++ b/src/overload/tuples.lisp @@ -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) -- 2.11.4.GIT