[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/calc/calc-rewr.el
From: |
Juanma Barranquero |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/calc/calc-rewr.el |
Date: |
Tue, 04 Feb 2003 07:47:14 -0500 |
Index: emacs/lisp/calc/calc-rewr.el
diff -c emacs/lisp/calc/calc-rewr.el:1.5 emacs/lisp/calc/calc-rewr.el:1.6
*** emacs/lisp/calc/calc-rewr.el:1.5 Wed Jan 15 10:16:25 2003
--- emacs/lisp/calc/calc-rewr.el Tue Feb 4 07:47:10 2003
***************
*** 3,9 ****
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <address@hidden>
! ;; Maintainers: D. Goel <address@hidden>
;; Colin Walters <address@hidden>
;; This file is part of GNU Emacs.
--- 3,9 ----
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <address@hidden>
! ;; Maintainers: D. Goel <address@hidden>
;; Colin Walters <address@hidden>
;; This file is part of GNU Emacs.
***************
*** 1442,1455 ****
btrack nil)
(aset regs 0 expr)
(while pc
!
(and tracing
(progn (terpri) (princ (car pc))
(if (and (natnump (nth 1 (car pc)))
(< (nth 1 (car pc)) (length regs)))
(princ (format "\n part = %s"
(aref regs (nth 1 (car pc))))))))
!
(cond ((eq (setq op (car (setq inst (car pc)))) 'func)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(eq (car part)
--- 1442,1455 ----
btrack nil)
(aset regs 0 expr)
(while pc
!
(and tracing
(progn (terpri) (princ (car pc))
(if (and (natnump (nth 1 (car pc)))
(< (nth 1 (car pc)) (length regs)))
(princ (format "\n part = %s"
(aref regs (nth 1 (car pc))))))))
!
(cond ((eq (setq op (car (setq inst (car pc)))) 'func)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(eq (car part)
***************
*** 1462,1475 ****
(not (or inst part))))
(setq pc (cdr pc))
(math-rwfail)))
!
((eq op 'same)
(if (or (equal (setq part (aref regs (nth 1 inst)))
(setq mark (aref regs (nth 2 inst))))
(Math-equal part mark))
(setq pc (cdr pc))
(math-rwfail)))
!
((and (eq op 'try)
calc-matrix-mode
(not (eq calc-matrix-mode 'scalar))
--- 1462,1475 ----
(not (or inst part))))
(setq pc (cdr pc))
(math-rwfail)))
!
((eq op 'same)
(if (or (equal (setq part (aref regs (nth 1 inst)))
(setq mark (aref regs (nth 2 inst))))
(Math-equal part mark))
(setq pc (cdr pc))
(math-rwfail)))
!
((and (eq op 'try)
calc-matrix-mode
(not (eq calc-matrix-mode 'scalar))
***************
*** 1487,1493 ****
(aset mark 1 (cdr part)))
(aset mark 0 (cdr part))
(aset mark 2 0))
!
((eq op 'try)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(memq (car part) (nth 2 inst))
--- 1487,1493 ----
(aset mark 1 (cdr part)))
(aset mark 0 (cdr part))
(aset mark 2 0))
!
((eq op 'try)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(memq (car part) (nth 2 inst))
***************
*** 1545,1551 ****
(aset regs (nth 4 inst) part)
(aset mark 2 3))
(math-rwfail))))
!
((eq op 'try2)
(setq part (nth 1 inst) ; try instr
mark (nth 3 part)
--- 1545,1551 ----
(aset regs (nth 4 inst) part)
(aset mark 2 3))
(math-rwfail))))
!
((eq op 'try2)
(setq part (nth 1 inst) ; try instr
mark (nth 3 part)
***************
*** 1588,1594 ****
(car (aref mark 1)))
((eq op 3) (nth 5 part))
(t (aref mark 1)))))
!
((eq op 'select)
(setq pc (cdr pc))
(if (and (consp (setq part (aref regs (nth 1 inst))))
--- 1588,1594 ----
(car (aref mark 1)))
((eq op 3) (nth 5 part))
(t (aref mark 1)))))
!
((eq op 'select)
(setq pc (cdr pc))
(if (and (consp (setq part (aref regs (nth 1 inst))))
***************
*** 1597,1603 ****
(if math-rewrite-selections
(math-rwfail)
(aset regs (nth 2 inst) part))))
!
((eq op 'same-neg)
(if (or (equal (setq part (aref regs (nth 1 inst)))
(setq mark (math-neg
--- 1597,1603 ----
(if math-rewrite-selections
(math-rwfail)
(aset regs (nth 2 inst) part))))
!
((eq op 'same-neg)
(if (or (equal (setq part (aref regs (nth 1 inst)))
(setq mark (math-neg
***************
*** 1605,1611 ****
(Math-equal part mark))
(setq pc (cdr pc))
(math-rwfail)))
!
((eq op 'backtrack)
(setq inst (car (car btrack)) ; "try" or "alt" instr
pc (cdr (car btrack))
--- 1605,1611 ----
(Math-equal part mark))
(setq pc (cdr pc))
(math-rwfail)))
!
((eq op 'backtrack)
(setq inst (car (car btrack)) ; "try" or "alt" instr
pc (cdr (car btrack))
***************
*** 1676,1682 ****
((eq op 4)
(setq btrack (cdr btrack)))
(t (math-rwfail t))))
!
((eq op 'integer)
(if (Math-integerp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
--- 1676,1682 ----
((eq op 4)
(setq btrack (cdr btrack)))
(t (math-rwfail t))))
!
((eq op 'integer)
(if (Math-integerp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
***************
*** 1686,1692 ****
(if (Math-integerp part)
(setq pc (cdr pc))
(math-rwfail)))))
!
((eq op 'real)
(if (Math-realp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
--- 1686,1692 ----
(if (Math-integerp part)
(setq pc (cdr pc))
(math-rwfail)))))
!
((eq op 'real)
(if (Math-realp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
***************
*** 1696,1702 ****
(if (Math-realp part)
(setq pc (cdr pc))
(math-rwfail)))))
!
((eq op 'constant)
(if (math-constp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
--- 1696,1702 ----
(if (Math-realp part)
(setq pc (cdr pc))
(math-rwfail)))))
!
((eq op 'constant)
(if (math-constp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
***************
*** 1706,1712 ****
(if (math-constp part)
(setq pc (cdr pc))
(math-rwfail)))))
!
((eq op 'negative)
(if (math-looks-negp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
--- 1706,1712 ----
(if (math-constp part)
(setq pc (cdr pc))
(math-rwfail)))))
!
((eq op 'negative)
(if (math-looks-negp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
***************
*** 1716,1722 ****
(if (math-looks-negp part)
(setq pc (cdr pc))
(math-rwfail)))))
!
((eq op 'rel)
(setq part (math-compare (aref regs (nth 1 inst))
(aref regs (nth 3 inst)))
--- 1716,1722 ----
(if (math-looks-negp part)
(setq pc (cdr pc))
(math-rwfail)))))
!
((eq op 'rel)
(setq part (math-compare (aref regs (nth 1 inst))
(aref regs (nth 3 inst)))
***************
*** 1741,1747 ****
(memq part '(0 1))))
(setq pc (cdr pc))
(math-rwfail)))
!
((eq op 'func-def)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(eq (car part)
--- 1741,1747 ----
(memq part '(0 1))))
(setq pc (cdr pc))
(math-rwfail)))
!
((eq op 'func-def)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(eq (car part)
***************
*** 1831,1863 ****
(math-rwapply-replace-regs (nth 1 inst)))))
(setq pc (cdr pc))
(math-rwfail)))
!
((eq op 'let)
(aset regs (nth 1 inst)
(math-rweval
(math-normalize
(math-rwapply-replace-regs (nth 2 inst)))))
(setq pc (cdr pc)))
!
((eq op 'copy)
(aset regs (nth 2 inst) (aref regs (nth 1 inst)))
(setq pc (cdr pc)))
!
((eq op 'copy-neg)
(aset regs (nth 2 inst)
(math-rwapply-neg (aref regs (nth 1 inst))))
(setq pc (cdr pc)))
!
((eq op 'alt)
(setq btrack (cons pc btrack)
pc (nth 1 inst)))
!
((eq op 'end-alt)
(while (and btrack (not (eq (car btrack) (nth 1 inst))))
(setq btrack (cdr btrack)))
(setq btrack (cdr btrack)
pc (cdr pc)))
!
((eq op 'done)
(setq result (math-rwapply-replace-regs (nth 1 inst)))
(if (or (and (eq (car-safe result) '+)
--- 1831,1863 ----
(math-rwapply-replace-regs (nth 1 inst)))))
(setq pc (cdr pc))
(math-rwfail)))
!
((eq op 'let)
(aset regs (nth 1 inst)
(math-rweval
(math-normalize
(math-rwapply-replace-regs (nth 2 inst)))))
(setq pc (cdr pc)))
!
((eq op 'copy)
(aset regs (nth 2 inst) (aref regs (nth 1 inst)))
(setq pc (cdr pc)))
!
((eq op 'copy-neg)
(aset regs (nth 2 inst)
(math-rwapply-neg (aref regs (nth 1 inst))))
(setq pc (cdr pc)))
!
((eq op 'alt)
(setq btrack (cons pc btrack)
pc (nth 1 inst)))
!
((eq op 'end-alt)
(while (and btrack (not (eq (car btrack) (nth 1 inst))))
(setq btrack (cdr btrack)))
(setq btrack (cdr btrack)
pc (cdr pc)))
!
((eq op 'done)
(setq result (math-rwapply-replace-regs (nth 1 inst)))
(if (or (and (eq (car-safe result) '+)
***************
*** 1877,1883 ****
(if part (math-rwapply-remember expr result))
(setq rules nil))
(setq pc nil))
!
(t (error "%s is not a valid rewrite opcode" op))))))
(setq rules (cdr rules)))
result)))
--- 1877,1883 ----
(if part (math-rwapply-remember expr result))
(setq rules nil))
(setq pc nil))
!
(t (error "%s is not a valid rewrite opcode" op))))))
(setq rules (cdr rules)))
result)))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/calc/calc-rewr.el,
Juanma Barranquero <=