emacs-diffs
[Top][All Lists]
Advanced

[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)))




reply via email to

[Prev in Thread] Current Thread [Next in Thread]