comparison lisp/calc/calc-vec.el @ 90044:cb7f41387eb3

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-70 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-669 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-678 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-679 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-680 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-688 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-689 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-690 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-691 Update from CVS * [e-mail]--gnu-2004/gnus--rel--5.10--patch-69 Merge from emacs--cvs-trunk--0 * [e-mail]--gnu-2004/gnus--rel--5.10--patch-70 - [e-mail]--gnu-2004/gnus--rel--5.10--patch-71 Update from CVS

90043:e24e2e78deda

(defun math-read-brackets (space-sep close)
  (and space-sep (setq space-sep (not (math-check-for-commas))))
  (math-read-token)
  (while (eq exp-token 'space)
    (math-read-token))
  (if (or (equal exp-data close)
	  (eq exp-token 'end))
      (progn
	(math-read-token)
	'(vec))
    (let ((save-exp-pos exp-pos)
	  (save-exp-old-pos exp-old-pos)
	  (save-exp-token exp-token)
	  (save-exp-data exp-data)
	  (vals (let ((exp-keep-spaces space-sep))
		  (if (or (equal exp-data "\\dots")
			  (equal exp-data "\\ldots"))
		      '(vec (neg (var inf var-inf)))
		    (catch 'syntax (math-read-vector))))))
      (if (stringp vals)
	  (if space-sep
	      (let ((error-exp-pos exp-pos)
		    (error-exp-old-pos exp-old-pos)
		    vals2)
		(setq exp-pos save-exp-pos
		      exp-old-pos save-exp-old-pos
		      exp-token save-exp-token
		      exp-data save-exp-data)
		(let ((exp-keep-spaces nil))
		  (setq vals2 (catch 'syntax (math-read-vector))))
		(if (and (not (stringp vals2))
			 (or (assoc exp-data '(("\\ldots") ("\\dots") (";")))
			     (equal exp-data close)
			     (eq exp-token 'end)))
		    (setq space-sep nil
			  vals vals2)
		  (setq exp-pos error-exp-pos
			exp-old-pos error-exp-old-pos)
		  (throw 'syntax vals)))
	    (throw 'syntax vals)))
      (if (or (equal exp-data "\\dots")
	      (equal exp-data "\\ldots"))
	  (progn
	    (math-read-token)
	    (setq vals (if (> (length vals) 2)
			   (cons 'calcFunc-mul (cdr vals)) (nth 1 vals)))
	    (let ((exp2 (if (or (equal exp-data close)
				(equal exp-data ")")
				(eq exp-token 'end))
			    '(var inf var-inf)
			  (math-read-expr-level 0))))
	      (setq vals
		    (list 'intv
			  (if (equal exp-data ")") 2 3)
			  vals
			  exp2)))
	    (if (not (or (equal exp-data close)
			 (equal exp-data ")")
			 (eq exp-token 'end)))
		(throw 'syntax "Expected `]'")))
	(if (equal exp-data ";")
	    (let ((exp-keep-spaces space-sep))
	      (setq vals (cons 'vec (math-read-matrix (list vals))))))
	(if (not (or (equal exp-data close)
		     (eq exp-token 'end)))
	    (throw 'syntax "Expected `]'")))
      (or (eq exp-token 'end)
	  (math-read-token))
      vals)))

(defun math-check-for-commas (&optional balancing)
  (let ((count 0)
	(pos (1- exp-pos)))
    (while (and (>= count 0)
		(setq pos (string-match
			   (if balancing "[],[{}()<>]" "[],[{}()]")
			   exp-str (1+ pos)))
		(or (/= (aref exp-str pos) ?,) (> count 0) balancing))
      (cond ((memq (aref exp-str pos) '(?\[ ?\{ ?\( ?\<))
	     (setq count (1+ count)))
	    ((memq (aref exp-str pos) '(?\] ?\} ?\) ?\>))
	     (setq count (1- count)))))
    (if balancing
	pos
      (and pos (= (aref exp-str pos) ?,)))))

(defun math-read-vector ()
  (let* ((val (list (math-read-expr-level 0)))
	 (last val))
    (while (progn
	     (while (eq exp-token 'space)
	       (math-read-token))
	     (and (not (eq exp-token 'end))
		  (not (equal exp-data ";"))
		  (not (equal exp-data close))
		  (not (equal exp-data "\\dots"))
		  (not (equal exp-data "\\ldots"))))
      (if (equal exp-data ",")
	  (math-read-token))
      (while (eq exp-token 'space)
	(math-read-token))
      (let ((rest (list (math-read-expr-level 0))))
	(setcdr last rest)
	(setq last rest)))
    (cons 'vec val)))

(defun math-read-matrix (mat)
  (while (equal exp-data ";")
    (math-read-token)
    (while (eq exp-token 'space)
      (math-read-token))
    (setq mat (nconc mat (list (math-read-vector)))))
  mat)

;;; arch-tag: 7902a7af-ec69-440a-8635-ebb4db263402

90044:cb7f41387eb3

(defun math-read-brackets (space-sep close)
  (and space-sep (setq space-sep (not (math-check-for-commas))))
  (math-read-token)
  (while (eq math-exp-token 'space)
    (math-read-token))
  (if (or (equal math-expr-data close)
	  (eq math-exp-token 'end))
      (progn
	(math-read-token)
	'(vec))
    (let ((save-exp-pos math-exp-pos)
	  (save-exp-old-pos math-exp-old-pos)
	  (save-exp-token math-exp-token)
	  (save-exp-data math-expr-data)
	  (vals (let ((math-exp-keep-spaces space-sep))
		  (if (or (equal math-expr-data "\\dots")
			  (equal math-expr-data "\\ldots"))
		      '(vec (neg (var inf var-inf)))
		    (catch 'syntax (math-read-vector))))))
      (if (stringp vals)
	  (if space-sep
	      (let ((error-exp-pos math-exp-pos)
		    (error-exp-old-pos math-exp-old-pos)
		    vals2)
		(setq math-exp-pos save-exp-pos
		      math-exp-old-pos save-exp-old-pos
		      math-exp-token save-exp-token
		      math-expr-data save-exp-data)
		(let ((math-exp-keep-spaces nil))
		  (setq vals2 (catch 'syntax (math-read-vector))))
		(if (and (not (stringp vals2))
			 (or (assoc math-expr-data '(("\\ldots") ("\\dots") (";")))
			     (equal math-expr-data close)
			     (eq math-exp-token 'end)))
		    (setq space-sep nil
			  vals vals2)
		  (setq math-exp-pos error-exp-pos
			math-exp-old-pos error-exp-old-pos)
		  (throw 'syntax vals)))
	    (throw 'syntax vals)))
      (if (or (equal math-expr-data "\\dots")
	      (equal math-expr-data "\\ldots"))
	  (progn
	    (math-read-token)
	    (setq vals (if (> (length vals) 2)
			   (cons 'calcFunc-mul (cdr vals)) (nth 1 vals)))
	    (let ((exp2 (if (or (equal math-expr-data close)
				(equal math-expr-data ")")
				(eq math-exp-token 'end))
			    '(var inf var-inf)
			  (math-read-expr-level 0))))
	      (setq vals
		    (list 'intv
			  (if (equal math-expr-data ")") 2 3)
			  vals
			  exp2)))
	    (if (not (or (equal math-expr-data close)
			 (equal math-expr-data ")")
			 (eq math-exp-token 'end)))
		(throw 'syntax "Expected `]'")))
	(if (equal math-expr-data ";")
	    (let ((math-exp-keep-spaces space-sep))
	      (setq vals (cons 'vec (math-read-matrix (list vals))))))
	(if (not (or (equal math-expr-data close)
		     (eq math-exp-token 'end)))
	    (throw 'syntax "Expected `]'")))
      (or (eq math-exp-token 'end)
	  (math-read-token))
      vals)))

(defun math-check-for-commas (&optional balancing)
  (let ((count 0)
	(pos (1- math-exp-pos)))
    (while (and (>= count 0)
		(setq pos (string-match
			   (if balancing "[],[{}()<>]" "[],[{}()]")
			   math-exp-str (1+ pos)))
		(or (/= (aref math-exp-str pos) ?,) (> count 0) balancing))
      (cond ((memq (aref math-exp-str pos) '(?\[ ?\{ ?\( ?\<))
	     (setq count (1+ count)))
	    ((memq (aref math-exp-str pos) '(?\] ?\} ?\) ?\>))
	     (setq count (1- count)))))
    (if balancing
	pos
      (and pos (= (aref math-exp-str pos) ?,)))))

(defun math-read-vector ()
  (let* ((val (list (math-read-expr-level 0)))
	 (last val))
    (while (progn
	     (while (eq math-exp-token 'space)
	       (math-read-token))
	     (and (not (eq math-exp-token 'end))
		  (not (equal math-expr-data ";"))
		  (not (equal math-expr-data close))
		  (not (equal math-expr-data "\\dots"))
		  (not (equal math-expr-data "\\ldots"))))
      (if (equal math-expr-data ",")
	  (math-read-token))
      (while (eq math-exp-token 'space)
	(math-read-token))
      (let ((rest (list (math-read-expr-level 0))))
	(setcdr last rest)
	(setq last rest)))
    (cons 'vec val)))

(defun math-read-matrix (mat)
  (while (equal math-expr-data ";")
    (math-read-token)
    (while (eq math-exp-token 'space)
      (math-read-token))
    (setq mat (nconc mat (list (math-read-vector)))))
  mat)

;;; arch-tag: 7902a7af-ec69-440a-8635-ebb4db263402