annotate lisp/calc/calc-rewr.el @ 76856:2fae574a2382

Release ERC 5.2. I have updated the version of ERC to 5.2, since it fixes a bug with C-c C-SPC being bound globally by default. For the full list of changes in this version, see etc/ERC-NEWS. Revision: emacs@sv.gnu.org/emacs--devo--0--patch-687 Creator: Michael Olson <mwolson@gnu.org>
author Miles Bader <miles@gnu.org>
date Sun, 01 Apr 2007 13:36:38 +0000
parents 497d17a80bb8
children 1154f082efd9 c0409ee15cee
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
1 ;;; calc-rewr.el --- rewriting functions for Calc
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
2
64325
1db49616ce05 Update copyright information.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 62442
diff changeset
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
75346
7a3f13e2dd57 Add 2007 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 72038
diff changeset
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
5
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
6 ;; Author: David Gillespie <daveg@synaptics.com>
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
7 ;; Maintainer: Jay Belanger <belanger@truman.edu>
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
8
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
10
76595
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
14 ;; any later version.
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
15
76595
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
19 ;; GNU General Public License for more details.
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
20
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
21 ;; You should have received a copy of the GNU General Public License
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 75346
diff changeset
24 ;; Boston, MA 02110-1301, USA.
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
25
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
26 ;;; Commentary:
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
27
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
28 ;;; Code:
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
29
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
30 ;; This file is autoloaded from calc-ext.el.
58669
28d7c9f8d013 Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58333
diff changeset
31
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
32 (require 'calc-ext)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
33 (require 'calc-macs)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
34
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
35 (defvar math-rewrite-default-iters 100)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
36
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
37 ;; The variable calc-rewr-sel is local to calc-rewrite-selection and
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
38 ;; calc-rewrite, but is used by calc-locate-selection-marker.
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
39 (defvar calc-rewr-sel)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
40
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
41 (defun calc-rewrite-selection (rules-str &optional many prefix)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
42 (interactive "sRewrite rule(s): \np")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
43 (calc-slow-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
44 (calc-preserve-point)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
45 (let* ((num (max 1 (calc-locate-cursor-element (point))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
46 (reselect t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
47 (pop-rules nil)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
48 rules
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
49 (entry (calc-top num 'entry))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
50 (expr (car entry))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
51 (calc-rewr-sel (calc-auto-selection entry))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
52 (math-rewrite-selections t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
53 (math-rewrite-default-iters 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
54 (if (or (null rules-str) (equal rules-str "") (equal rules-str "$"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
55 (if (= num 1)
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
56 (error "Can't use same stack entry for formula and rules")
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
57 (setq rules (calc-top-n 1 t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
58 pop-rules t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
59 (setq rules (if (stringp rules-str)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
60 (math-read-exprs rules-str) rules-str))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
61 (if (eq (car-safe rules) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
62 (error "Bad format in expression: %s" (nth 1 rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
63 (if (= (length rules) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
64 (setq rules (car rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
65 (setq rules (cons 'vec rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
66 (or (memq (car-safe rules) '(vec var calcFunc-assign
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
67 calcFunc-condition))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
68 (let ((rhs (math-read-expr
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
69 (read-string (concat "Rewrite from: " rules-str
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
70 " to: ")))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
71 (if (eq (car-safe rhs) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
72 (error "Bad format in expression: %s" (nth 1 rhs)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
73 (setq rules (list 'calcFunc-assign rules rhs))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
74 (or (eq (car-safe rules) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
75 (calc-record rules "rule")))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
76 (if (eq many 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
77 (setq many '(var inf var-inf))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
78 (if many (setq many (prefix-numeric-value many))))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
79 (if calc-rewr-sel
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
80 (setq expr (calc-replace-sub-formula (car entry)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
81 calc-rewr-sel
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
82 (list 'calcFunc-select calc-rewr-sel)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
83 (setq expr (car entry)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
84 reselect nil
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
85 math-rewrite-selections nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
86 (setq expr (calc-encase-atoms
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
87 (calc-normalize
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
88 (math-rewrite
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
89 (calc-normalize expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
90 rules many)))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
91 calc-rewr-sel nil
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
92 expr (calc-locate-select-marker expr))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
93 (or (consp calc-rewr-sel) (setq calc-rewr-sel nil))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
94 (if pop-rules (calc-pop-stack 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
95 (calc-pop-push-record-list 1 (or prefix "rwrt") (list expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
96 (- num (if pop-rules 1 0))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
97 (list (and reselect calc-rewr-sel))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
98 (calc-handle-whys)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
99
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
100 (defun calc-locate-select-marker (expr)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
101 (if (Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
102 expr
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
103 (if (and (eq (car expr) 'calcFunc-select)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
104 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
105 (progn
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
106 (setq calc-rewr-sel (if calc-rewr-sel t (nth 1 expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
107 (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
108 (cons (car expr)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
109 (mapcar 'calc-locate-select-marker (cdr expr))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
110
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
111
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
112
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
113 (defun calc-rewrite (rules-str many)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
114 (interactive "sRewrite rule(s): \nP")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
115 (calc-slow-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
116 (let (n rules expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
117 (if (or (null rules-str) (equal rules-str "") (equal rules-str "$"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
118 (setq expr (calc-top-n 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
119 rules (calc-top-n 1 t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
120 n 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
121 (setq rules (if (stringp rules-str)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
122 (math-read-exprs rules-str) rules-str))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
123 (if (eq (car-safe rules) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
124 (error "Bad format in expression: %s" (nth 1 rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
125 (if (= (length rules) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
126 (setq rules (car rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
127 (setq rules (cons 'vec rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
128 (or (memq (car-safe rules) '(vec var calcFunc-assign
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
129 calcFunc-condition))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
130 (let ((rhs (math-read-expr
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
131 (read-string (concat "Rewrite from: " rules-str
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
132 " to: ")))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
133 (if (eq (car-safe rhs) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
134 (error "Bad format in expression: %s" (nth 1 rhs)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
135 (setq rules (list 'calcFunc-assign rules rhs))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
136 (or (eq (car-safe rules) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
137 (calc-record rules "rule"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
138 (setq expr (calc-top-n 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
139 n 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
140 (if (eq many 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
141 (setq many '(var inf var-inf))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
142 (if many (setq many (prefix-numeric-value many))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
143 (setq expr (calc-normalize (math-rewrite expr rules many)))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
144 (let (calc-rewr-sel)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
145 (setq expr (calc-locate-select-marker expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
146 (calc-pop-push-record-list n "rwrt" (list expr)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
147 (calc-handle-whys)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
148
57712
dc42d2f96245 (calc-match): Use an extra argument instead of `interactive-p'.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 52401
diff changeset
149 (defun calc-match (pat &optional interactive)
dc42d2f96245 (calc-match): Use an extra argument instead of `interactive-p'.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 52401
diff changeset
150 (interactive "sPattern: \np")
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
151 (calc-slow-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
152 (let (n expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
153 (if (or (null pat) (equal pat "") (equal pat "$"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
154 (setq expr (calc-top-n 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
155 pat (calc-top-n 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
156 n 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
157 (setq pat (if (stringp pat) (math-read-expr pat) pat))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
158 (if (eq (car-safe pat) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
159 (error "Bad format in expression: %s" (nth 1 pat)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
160 (if (not (eq (car-safe pat) 'var))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
161 (calc-record pat "pat"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
162 (setq expr (calc-top-n 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
163 n 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
164 (or (math-vectorp expr) (error "Argument must be a vector"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
165 (if (calc-is-inverse)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
166 (calc-enter-result n "mtcn" (math-match-patterns pat expr t))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
167 (calc-enter-result n "mtch" (math-match-patterns pat expr nil))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
168
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
169
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
170 (defvar math-mt-many)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
171
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
172 ;; The variable math-rewrite-whole-expr is local to math-rewrite,
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
173 ;; but is used by math-rewrite-phase
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
174 (defvar math-rewrite-whole-expr)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
175
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
176 (defun math-rewrite (math-rewrite-whole-expr rules &optional math-mt-many)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
177 (let* ((crules (math-compile-rewrites rules))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
178 (heads (math-rewrite-heads math-rewrite-whole-expr))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
179 (trace-buffer (get-buffer "*Trace*"))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
180 (calc-display-just 'center)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
181 (calc-display-origin 39)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
182 (calc-line-breaking 78)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
183 (calc-line-numbering nil)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
184 (calc-show-selections t)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
185 (calc-why nil)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
186 (math-mt-func (function
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
187 (lambda (x)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
188 (let ((result (math-apply-rewrites x (cdr crules)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
189 heads crules)))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
190 (if result
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
191 (progn
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
192 (if trace-buffer
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
193 (let ((fmt (math-format-stack-value
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
194 (list result nil nil))))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
195 (save-excursion
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
196 (set-buffer trace-buffer)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
197 (insert "\nrewrite to\n" fmt "\n"))))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
198 (setq heads (math-rewrite-heads result heads t))))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
199 result)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
200 (if trace-buffer
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
201 (let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
202 (save-excursion
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
203 (set-buffer trace-buffer)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
204 (setq truncate-lines t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
205 (goto-char (point-max))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
206 (insert "\n\nBegin rewriting\n" fmt "\n"))))
58105
bd86240a57e9 (math-rewrite, math-rewrite-phase): Use declared variable math-mt-many.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 57712
diff changeset
207 (or math-mt-many (setq math-mt-many (or (nth 1 (car crules))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
208 math-rewrite-default-iters)))
58105
bd86240a57e9 (math-rewrite, math-rewrite-phase): Use declared variable math-mt-many.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 57712
diff changeset
209 (if (equal math-mt-many '(var inf var-inf)) (setq math-mt-many 1000000))
bd86240a57e9 (math-rewrite, math-rewrite-phase): Use declared variable math-mt-many.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 57712
diff changeset
210 (if (equal math-mt-many '(neg (var inf var-inf))) (setq math-mt-many -1000000))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
211 (math-rewrite-phase (nth 3 (car crules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
212 (if trace-buffer
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
213 (let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
214 (save-excursion
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
215 (set-buffer trace-buffer)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
216 (insert "\nDone rewriting"
58105
bd86240a57e9 (math-rewrite, math-rewrite-phase): Use declared variable math-mt-many.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 57712
diff changeset
217 (if (= math-mt-many 0) " (reached iteration limit)" "")
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
218 ":\n" fmt "\n"))))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
219 math-rewrite-whole-expr))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
220
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
221 (defun math-rewrite-phase (sched)
58105
bd86240a57e9 (math-rewrite, math-rewrite-phase): Use declared variable math-mt-many.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 57712
diff changeset
222 (while (and sched (/= math-mt-many 0))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
223 (if (listp (car sched))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
224 (while (let ((save-expr math-rewrite-whole-expr))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
225 (math-rewrite-phase (car sched))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
226 (not (equal math-rewrite-whole-expr save-expr))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
227 (if (symbolp (car sched))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
228 (progn
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
229 (setq math-rewrite-whole-expr
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
230 (math-normalize (list (car sched) math-rewrite-whole-expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
231 (if trace-buffer
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
232 (let ((fmt (math-format-stack-value
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
233 (list math-rewrite-whole-expr nil nil))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
234 (save-excursion
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
235 (set-buffer trace-buffer)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
236 (insert "\ncall "
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
237 (substring (symbol-name (car sched)) 9)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
238 ":\n" fmt "\n")))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
239 (let ((math-rewrite-phase (car sched)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
240 (if trace-buffer
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
241 (save-excursion
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
242 (set-buffer trace-buffer)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
243 (insert (format "\n(Phase %d)\n" math-rewrite-phase))))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
244 (while (let ((save-expr math-rewrite-whole-expr))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
245 (setq math-rewrite-whole-expr (math-normalize
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
246 (math-map-tree-rec math-rewrite-whole-expr)))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
247 (not (equal math-rewrite-whole-expr save-expr)))))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
248 (setq sched (cdr sched))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
249
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
250 (defun calcFunc-rewrite (expr rules &optional many)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
251 (or (null many) (integerp many)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
252 (equal many '(var inf var-inf)) (equal many '(neg (var inf var-inf)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
253 (math-reject-arg many 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
254 (condition-case err
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
255 (math-rewrite expr rules (or many 1))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
256 (error (math-reject-arg rules (nth 1 err)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
257
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
258 (defun calcFunc-match (pat vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
259 (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
260 (condition-case err
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
261 (math-match-patterns pat vec nil)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
262 (error (math-reject-arg pat (nth 1 err)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
263
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
264 (defun calcFunc-matchnot (pat vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
265 (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
266 (condition-case err
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
267 (math-match-patterns pat vec t)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
268 (error (math-reject-arg pat (nth 1 err)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
269
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
270 (defun math-match-patterns (pat vec &optional not-flag)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
271 (let ((newvec nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
272 (crules (math-compile-patterns pat)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
273 (while (setq vec (cdr vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
274 (if (eq (not (math-apply-rewrites (car vec) crules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
275 not-flag)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
276 (setq newvec (cons (car vec) newvec))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
277 (cons 'vec (nreverse newvec))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
278
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
279 (defun calcFunc-matches (expr pat)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
280 (condition-case err
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
281 (if (math-apply-rewrites expr (math-compile-patterns pat))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
282 1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
283 0)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
284 (error (math-reject-arg pat (nth 1 err)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
285
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
286 (defun calcFunc-vmatches (expr pat)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
287 (condition-case err
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
288 (or (math-apply-rewrites expr (math-compile-patterns pat))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
289 0)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
290 (error (math-reject-arg pat (nth 1 err)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
291
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
292
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
293
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
294 ;;; A compiled rule set is an a-list of entries whose cars are functors,
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
295 ;;; and whose cdrs are lists of rules. If there are rules with no
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
296 ;;; well-defined head functor, they are included on all lists and also
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
297 ;;; on an extra list whose car is nil.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
298 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
299 ;;; The first entry in the a-list is of the form (schedule A B C ...).
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
300 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
301 ;;; Rule list entries take the form (regs prog head phases), where:
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
302 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
303 ;;; regs is a vector of match registers.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
304 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
305 ;;; prog is a match program (see below).
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
306 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
307 ;;; head is a rare function name appearing in the rule body (but not the
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
308 ;;; head of the whole rule), or nil if none.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
309 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
310 ;;; phases is a list of phase numbers for which the rule is enabled.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
311 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
312 ;;; A match program is a list of match instructions.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
313 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
314 ;;; In the following, "part" is a register number that contains the
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
315 ;;; subexpression to be operated on.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
316 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
317 ;;; Register 0 is the whole expression being matched. The others are
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
318 ;;; meta-variables in the pattern, temporaries used for matching and
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
319 ;;; backtracking, and constant expressions.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
320 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
321 ;;; (same part reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
322 ;;; The selected part must be math-equal to the contents of "reg".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
323 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
324 ;;; (same-neg part reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
325 ;;; The selected part must be math-equal to the negative of "reg".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
326 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
327 ;;; (copy part reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
328 ;;; The selected part is copied into "reg". (Rarely used.)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
329 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
330 ;;; (copy-neg part reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
331 ;;; The negative of the selected part is copied into "reg".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
332 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
333 ;;; (integer part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
334 ;;; The selected part must be an integer.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
335 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
336 ;;; (real part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
337 ;;; The selected part must be a real.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
338 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
339 ;;; (constant part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
340 ;;; The selected part must be a constant.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
341 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
342 ;;; (negative part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
343 ;;; The selected part must "look" negative.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
344 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
345 ;;; (rel part op reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
346 ;;; The selected part must satisfy "part op reg", where "op"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
347 ;;; is one of the 6 relational ops, and "reg" is a register.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
348 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
349 ;;; (mod part modulo value)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
350 ;;; The selected part must satisfy "part % modulo = value", where
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
351 ;;; "modulo" and "value" are constants.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
352 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
353 ;;; (func part head reg1 reg2 ... regn)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
354 ;;; The selected part must be an n-ary call to function "head".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
355 ;;; The arguments are stored in "reg1" through "regn".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
356 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
357 ;;; (func-def part head defs reg1 reg2 ... regn)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
358 ;;; The selected part must be an n-ary call to function "head".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
359 ;;; "Defs" is a list of value/register number pairs for default args.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
360 ;;; If a match, assign default values to registers and then skip
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
361 ;;; immediately over any following "func-def" instructions and
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
362 ;;; the following "func" instruction. If wrong number of arguments,
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
363 ;;; proceed to the following "func-def" or "func" instruction.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
364 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
365 ;;; (func-opt part head defs reg1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
366 ;;; Like func-def with "n=1", except that if the selected part is
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
367 ;;; not a call to "head", then the part itself successfully matches
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
368 ;;; "reg1" (and the defaults are assigned).
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
369 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
370 ;;; (try part heads mark reg1 [def])
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
371 ;;; The selected part must be a function of the correct type which is
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
372 ;;; associative and/or commutative. "Heads" is a list of acceptable
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
373 ;;; types. An initial assignment of arguments to "reg1" is tried.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
374 ;;; If the program later fails, it backtracks to this instruction
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
375 ;;; and tries other assignments of arguments to "reg1".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
376 ;;; If "def" exists and normal matching fails, backtrack and assign
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
377 ;;; "part" to "reg1", and "def" to "reg2" in the following "try2".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
378 ;;; The "mark" is a vector of size 5; only "mark[3-4]" are initialized.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
379 ;;; "mark[0]" points to the argument list; "mark[1]" points to the
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
380 ;;; current argument; "mark[2]" is 0 if there are two arguments,
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
381 ;;; 1 if reg1 is matching single arguments, 2 if reg2 is matching
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
382 ;;; single arguments (a+b+c+d is never split as (a+b)+(c+d)), or
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
383 ;;; 3 if reg2 is matching "def"; "mark[3]" is 0 if the function must
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
384 ;;; have two arguments, 1 if phase-2 can be skipped, 2 if full
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
385 ;;; backtracking is necessary; "mark[4]" is t if the arguments have
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
386 ;;; been switched from the order given in the original pattern.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
387 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
388 ;;; (try2 try reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
389 ;;; Every "try" will be followed by a "try2" whose "try" field is
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
390 ;;; a pointer to the corresponding "try". The arguments which were
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
391 ;;; not stored in "reg1" by that "try" are now stored in "reg2".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
392 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
393 ;;; (alt instr nil mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
394 ;;; Basic backtracking. Execute the instruction sequence "instr".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
395 ;;; If this fails, back up and execute following the "alt" instruction.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
396 ;;; The "mark" must be the vector "[nil nil 4]". The "instr" sequence
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
397 ;;; should execute "end-alt" at the end.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
398 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
399 ;;; (end-alt ptr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
400 ;;; Register success of the first alternative of a previous "alt".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
401 ;;; "Ptr" is a pointer to the next instruction following that "alt".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
402 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
403 ;;; (apply part reg1 reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
404 ;;; The selected part must be a function call. The functor
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
405 ;;; (as a variable name) is stored in "reg1"; the arguments
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
406 ;;; (as a vector) are stored in "reg2".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
407 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
408 ;;; (cons part reg1 reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
409 ;;; The selected part must be a nonempty vector. The first element
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
410 ;;; of the vector is stored in "reg1"; the rest of the vector
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
411 ;;; (as another vector) is stored in "reg2".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
412 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
413 ;;; (rcons part reg1 reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
414 ;;; The selected part must be a nonempty vector. The last element
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
415 ;;; of the vector is stored in "reg2"; the rest of the vector
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
416 ;;; (as another vector) is stored in "reg1".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
417 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
418 ;;; (select part reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
419 ;;; If the selected part is a unary call to function "select", its
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
420 ;;; argument is stored in "reg"; otherwise (provided this is an `a r'
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
421 ;;; and not a `g r' command) the selected part is stored in "reg".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
422 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
423 ;;; (cond expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
424 ;;; The "expr", with registers substituted, must simplify to
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
425 ;;; a non-zero value.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
426 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
427 ;;; (let reg expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
428 ;;; Evaluate "expr" and store the result in "reg". Always succeeds.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
429 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
430 ;;; (done rhs remember)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
431 ;;; Rewrite the expression to "rhs", with register substituted.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
432 ;;; Normalize; if the result is different from the original
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
433 ;;; expression, the match has succeeded. This is the last
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
434 ;;; instruction of every program. If "remember" is non-nil,
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
435 ;;; record the result of the match as a new literal rule.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
436
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
437
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
438 ;;; Pseudo-functions related to rewrites:
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
439 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
440 ;;; In patterns: quote, plain, condition, opt, apply, cons, select
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
441 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
442 ;;; In righthand sides: quote, plain, eval, evalsimp, evalextsimp,
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
443 ;;; apply, cons, select
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
444 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
445 ;;; In conditions: let + same as for righthand sides
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
446
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
447 ;;; Some optimizations that would be nice to have:
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
448 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
449 ;;; * Merge registers with disjoint lifetimes.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
450 ;;; * Merge constant registers with equivalent values.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
451 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
452 ;;; * If an argument of a commutative op math-depends neither on the
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
453 ;;; rest of the pattern nor on any of the conditions, then no backtracking
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
454 ;;; should be done for that argument. (This won't apply to very many
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
455 ;;; cases.)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
456 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
457 ;;; * If top functor is "select", and its argument is a unique function,
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
458 ;;; add the rule to the lists for both "select" and that function.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
459 ;;; (Currently rules like this go on the "nil" list.)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
460 ;;; Same for "func-opt" functions. (Though not urgent for these.)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
461 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
462 ;;; * Shouldn't evaluate a "let" condition until the end, or until it
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
463 ;;; would enable another condition to be evaluated.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
464 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
465
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
466 ;;; Some additional features to add / things to think about:
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
467 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
468 ;;; * Figure out what happens to "a +/- b" and "a +/- opt(b)".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
469 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
470 ;;; * Same for interval forms.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
471 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
472 ;;; * Have a name(v,pat) pattern which matches pat, and gives the
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
473 ;;; whole match the name v. Beware of circular structures!
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
474 ;;;
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
475
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
476 (defun math-compile-patterns (pats)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
477 (if (and (eq (car-safe pats) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
478 (calc-var-value (nth 2 pats)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
479 (let ((prop (get (nth 2 pats) 'math-pattern-cache)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
480 (or prop
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
481 (put (nth 2 pats) 'math-pattern-cache (setq prop (list nil))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
482 (or (eq (car prop) (symbol-value (nth 2 pats)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
483 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
484 (setcdr prop (math-compile-patterns
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
485 (symbol-value (nth 2 pats))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
486 (setcar prop (symbol-value (nth 2 pats)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
487 (cdr prop))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
488 (let ((math-rewrite-whole t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
489 (cdr (math-compile-rewrites (cons
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
490 'vec
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
491 (mapcar (function (lambda (x)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
492 (list 'vec x t)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
493 (if (eq (car-safe pats) 'vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
494 (cdr pats)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
495 (list pats)))))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
496
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
497 (defvar math-rewrite-whole nil)
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
498 (defvar math-make-import-list nil)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
499
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
500 ;; The variable math-import-list is local to part of math-compile-rewrites,
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
501 ;; but is also used in a different part, and so the local version could
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
502 ;; be affected by the non-local version when math-compile-rewrites calls itself.
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
503 (defvar math-import-list nil)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
504
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
505 ;; The variables math-regs, math-num-regs, math-prog-last, math-bound-vars,
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
506 ;; math-conds, math-copy-neg, math-rhs, math-pattern, math-remembering and
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
507 ;; math-aliased-vars are local to math-compile-rewrites,
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
508 ;; but are used by many functions math-rwcomp-*, which are called by
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
509 ;; math-compile-rewrites.
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
510 (defvar math-regs)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
511 (defvar math-num-regs)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
512 (defvar math-prog-last)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
513 (defvar math-bound-vars)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
514 (defvar math-conds)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
515 (defvar math-copy-neg)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
516 (defvar math-rhs)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
517 (defvar math-pattern)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
518 (defvar math-remembering)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
519 (defvar math-aliased-vars)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
520
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
521 (defun math-compile-rewrites (rules &optional name)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
522 (if (eq (car-safe rules) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
523 (let ((prop (get (nth 2 rules) 'math-rewrite-cache))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
524 (math-import-list nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
525 (math-make-import-list t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
526 p)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
527 (or (calc-var-value (nth 2 rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
528 (error "Rules variable %s has no stored value" (nth 1 rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
529 (or prop
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
530 (put (nth 2 rules) 'math-rewrite-cache
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
531 (setq prop (list (list (cons (nth 2 rules) nil))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
532 (setq p (car prop))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
533 (while (and p (eq (symbol-value (car (car p))) (cdr (car p))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
534 (setq p (cdr p)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
535 (or (null p)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
536 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
537 (message "Compiling rule set %s..." (nth 1 rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
538 (setcdr prop (math-compile-rewrites
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
539 (symbol-value (nth 2 rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
540 (nth 2 rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
541 (message "Compiling rule set %s...done" (nth 1 rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
542 (setcar prop (cons (cons (nth 2 rules)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
543 (symbol-value (nth 2 rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
544 math-import-list))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
545 (cdr prop))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
546 (if (or (not (eq (car-safe rules) 'vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
547 (and (memq (length rules) '(3 4))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
548 (let ((p rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
549 (while (and (setq p (cdr p))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
550 (memq (car-safe (car p))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
551 '(vec
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
552 calcFunc-assign
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
553 calcFunc-condition
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
554 calcFunc-import
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
555 calcFunc-phase
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
556 calcFunc-schedule
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
557 calcFunc-iterations))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
558 p)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
559 (setq rules (list rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
560 (setq rules (cdr rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
561 (if (assq 'calcFunc-import rules)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
562 (let ((pp (setq rules (copy-sequence rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
563 p part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
564 (while (setq p (car (cdr pp)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
565 (if (eq (car-safe p) 'calcFunc-import)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
566 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
567 (setcdr pp (cdr (cdr pp)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
568 (or (and (eq (car-safe (nth 1 p)) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
569 (setq part (calc-var-value (nth 2 (nth 1 p))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
570 (memq (car-safe part) '(vec
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
571 calcFunc-assign
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
572 calcFunc-condition)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
573 (error "Argument of import() must be a rules variable"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
574 (if math-make-import-list
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
575 (setq math-import-list
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
576 (cons (cons (nth 2 (nth 1 p))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
577 (symbol-value (nth 2 (nth 1 p))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
578 math-import-list)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
579 (while (setq p (cdr (cdr p)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
580 (or (cdr p)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
581 (error "import() must have odd number of arguments"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
582 (setq part (math-rwcomp-substitute part
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
583 (car p) (nth 1 p))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
584 (if (eq (car-safe part) 'vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
585 (setq part (cdr part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
586 (setq part (list part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
587 (setcdr pp (append part (cdr pp))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
588 (setq pp (cdr pp))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
589 (let ((rule-set nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
590 (all-heads nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
591 (nil-rules nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
592 (rule-count 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
593 (math-schedule nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
594 (math-iterations nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
595 (math-phases nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
596 (math-all-phases nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
597 (math-remembering nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
598 math-pattern math-rhs math-conds)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
599 (while rules
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
600 (cond
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
601 ((and (eq (car-safe (car rules)) 'calcFunc-iterations)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
602 (= (length (car rules)) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
603 (or (integerp (nth 1 (car rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
604 (equal (nth 1 (car rules)) '(var inf var-inf))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
605 (equal (nth 1 (car rules)) '(neg (var inf var-inf)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
606 (error "Invalid argument for iterations(n)"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
607 (or math-iterations
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
608 (setq math-iterations (nth 1 (car rules)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
609 ((eq (car-safe (car rules)) 'calcFunc-schedule)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
610 (or math-schedule
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
611 (setq math-schedule (math-parse-schedule (cdr (car rules))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
612 ((eq (car-safe (car rules)) 'calcFunc-phase)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
613 (setq math-phases (cdr (car rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
614 (if (equal math-phases '((var all var-all)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
615 (setq math-phases nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
616 (let ((p math-phases))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
617 (while p
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
618 (or (integerp (car p))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
619 (error "Phase numbers must be small integers"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
620 (or (memq (car p) math-all-phases)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
621 (setq math-all-phases (cons (car p) math-all-phases)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
622 (setq p (cdr p)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
623 ((or (and (eq (car-safe (car rules)) 'vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
624 (cdr (cdr (car rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
625 (not (nthcdr 4 (car rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
626 (setq math-conds (nth 3 (car rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
627 math-rhs (nth 2 (car rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
628 math-pattern (nth 1 (car rules))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
629 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
630 (setq math-conds nil
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
631 math-pattern (car rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
632 (while (and (eq (car-safe math-pattern) 'calcFunc-condition)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
633 (= (length math-pattern) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
634 (let ((cond (nth 2 math-pattern)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
635 (setq math-conds (if math-conds
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
636 (list 'calcFunc-land math-conds cond)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
637 cond)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
638 math-pattern (nth 1 math-pattern))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
639 (and (eq (car-safe math-pattern) 'calcFunc-assign)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
640 (= (length math-pattern) 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
641 (setq math-rhs (nth 2 math-pattern)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
642 math-pattern (nth 1 math-pattern)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
643 (let* ((math-prog (list nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
644 (math-prog-last math-prog)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
645 (math-num-regs 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
646 (math-regs (list (list nil 0 nil nil)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
647 (math-bound-vars nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
648 (math-aliased-vars nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
649 (math-copy-neg nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
650 (setq math-conds (and math-conds (math-flatten-lands math-conds)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
651 (math-rwcomp-pattern math-pattern 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
652 (while math-conds
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
653 (let ((expr (car math-conds)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
654 (setq math-conds (cdr math-conds))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
655 (math-rwcomp-cond-instr expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
656 (math-rwcomp-instr 'done
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
657 (if (eq math-rhs t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
658 (cons 'vec
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
659 (delq
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
660 nil
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
661 (nreverse
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
662 (mapcar
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
663 (function
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
664 (lambda (v)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
665 (and (car v)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
666 (list
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
667 'calcFunc-assign
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
668 (math-build-var-name
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
669 (car v))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
670 (math-rwcomp-register-expr
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
671 (nth 1 v))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
672 math-regs))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
673 (math-rwcomp-match-vars math-rhs))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
674 math-remembering)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
675 (setq math-prog (cdr math-prog))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
676 (let* ((heads (math-rewrite-heads math-pattern))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
677 (rule (list (vconcat
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
678 (nreverse
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
679 (mapcar (function (lambda (x) (nth 3 x)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
680 math-regs)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
681 math-prog
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
682 heads
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
683 math-phases))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
684 (head (and (not (Math-primp math-pattern))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
685 (not (and (eq (car (car math-prog)) 'try)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
686 (nth 5 (car math-prog))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
687 (not (memq (car (car math-prog)) '(func-opt
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
688 apply
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
689 select
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
690 alt)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
691 (if (memq (car (car math-prog)) '(func
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
692 func-def))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
693 (nth 2 (car math-prog))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
694 (if (eq (car math-pattern) 'calcFunc-quote)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
695 (car-safe (nth 1 math-pattern))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
696 (car math-pattern))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
697 (let (found)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
698 (while heads
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
699 (if (setq found (assq (car heads) all-heads))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
700 (setcdr found (1+ (cdr found)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
701 (setq all-heads (cons (cons (car heads) 1) all-heads)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
702 (setq heads (cdr heads))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
703 (if (eq head '-) (setq head '+))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
704 (if (memq head '(calcFunc-cons calcFunc-rcons)) (setq head 'vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
705 (if head
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
706 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
707 (nconc (or (assq head rule-set)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
708 (car (setq rule-set (cons (cons head
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
709 (copy-sequence
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
710 nil-rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
711 rule-set))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
712 (list rule))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
713 (if (eq head '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
714 (nconc (or (assq '/ rule-set)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
715 (car (setq rule-set (cons (cons
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
716 '/
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
717 (copy-sequence
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
718 nil-rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
719 rule-set))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
720 (list rule))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
721 (setq nil-rules (nconc nil-rules (list rule)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
722 (let ((ptr rule-set))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
723 (while ptr
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
724 (nconc (car ptr) (list rule))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
725 (setq ptr (cdr ptr))))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
726 (t
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
727 (error "Rewrite rule set must be a vector of A := B rules")))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
728 (setq rules (cdr rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
729 (if nil-rules
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
730 (setq rule-set (cons (cons nil nil-rules) rule-set)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
731 (setq all-heads (mapcar 'car
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
732 (sort all-heads (function
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
733 (lambda (x y)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
734 (< (cdr x) (cdr y)))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
735 (let ((set rule-set)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
736 rule heads ptr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
737 (while set
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
738 (setq rule (cdr (car set)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
739 (while rule
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
740 (if (consp (setq heads (nth 2 (car rule))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
741 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
742 (setq heads (delq (car (car set)) heads)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
743 ptr all-heads)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
744 (while (and ptr (not (memq (car ptr) heads)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
745 (setq ptr (cdr ptr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
746 (setcar (nthcdr 2 (car rule)) (car ptr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
747 (setq rule (cdr rule)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
748 (setq set (cdr set))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
749 (let ((plus (assq '+ rule-set)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
750 (if plus
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
751 (setq rule-set (cons (cons '- (cdr plus)) rule-set))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
752 (cons (list 'schedule math-iterations name
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
753 (or math-schedule
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
754 (sort math-all-phases '<)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
755 (list 1)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
756 rule-set))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
757
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
758 (defun math-flatten-lands (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
759 (if (eq (car-safe expr) 'calcFunc-land)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
760 (append (math-flatten-lands (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
761 (math-flatten-lands (nth 2 expr)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
762 (list expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
763
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
764 ;; The variables math-rewrite-heads-heads (i.e.; heads for math-rewrite-heads)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
765 ;; math-rewrite-heads-blanks and math-rewrite-heads-skips are local to
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
766 ;; math-rewrite-heads, but used by math-rewrite-heads-rec, which is called by
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
767 ;; math-rewrite-heads.
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
768 (defvar math-rewrite-heads-heads)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
769 (defvar math-rewrite-heads-skips)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
770 (defvar math-rewrite-heads-blanks)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
771
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
772 (defun math-rewrite-heads (expr &optional more all)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
773 (let ((math-rewrite-heads-heads more)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
774 (math-rewrite-heads-skips (and (not all)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
775 '(calcFunc-apply calcFunc-condition calcFunc-opt
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
776 calcFunc-por calcFunc-pnot)))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
777 (math-rewrite-heads-blanks (and (not all)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
778 '(calcFunc-quote calcFunc-plain calcFunc-select
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
779 calcFunc-cons calcFunc-rcons
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
780 calcFunc-pand))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
781 (or (Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
782 (math-rewrite-heads-rec expr))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
783 math-rewrite-heads-heads))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
784
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
785 (defun math-rewrite-heads-rec (expr)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
786 (or (memq (car expr) math-rewrite-heads-skips)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
787 (progn
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
788 (or (memq (car expr) math-rewrite-heads-heads)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
789 (memq (car expr) math-rewrite-heads-blanks)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
790 (memq 'algebraic (get (car expr) 'math-rewrite-props))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
791 (setq math-rewrite-heads-heads (cons (car expr) math-rewrite-heads-heads)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
792 (while (setq expr (cdr expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
793 (or (Math-primp (car expr))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
794 (math-rewrite-heads-rec (car expr)))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
795
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
796 (defun math-parse-schedule (sched)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
797 (mapcar (function
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
798 (lambda (s)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
799 (if (integerp s)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
800 s
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
801 (if (math-vectorp s)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
802 (math-parse-schedule (cdr s))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
803 (if (eq (car-safe s) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
804 (math-var-to-calcFunc s)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
805 (error "Improper component in rewrite schedule"))))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
806 sched))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
807
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
808 (defun math-rwcomp-match-vars (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
809 (if (Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
810 (if (eq (car-safe expr) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
811 (let ((entry (assq (nth 2 expr) math-regs)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
812 (if entry
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
813 (math-rwcomp-register-expr (nth 1 entry))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
814 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
815 expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
816 (if (and (eq (car expr) 'calcFunc-quote)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
817 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
818 (math-rwcomp-match-vars (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
819 (if (and (eq (car expr) 'calcFunc-plain)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
820 (= (length expr) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
821 (not (Math-primp (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
822 (list (car expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
823 (cons (car (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
824 (mapcar 'math-rwcomp-match-vars (cdr (nth 1 expr)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
825 (cons (car expr)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
826 (mapcar 'math-rwcomp-match-vars (cdr expr)))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
827
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
828 (defun math-rwcomp-register-expr (num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
829 (let ((entry (nth (1- (- math-num-regs num)) math-regs)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
830 (if (nth 2 entry)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
831 (list 'neg (list 'calcFunc-register (nth 1 entry)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
832 (list 'calcFunc-register (nth 1 entry)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
833
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
834 ;; The variables math-rwcomp-subst-old, math-rwcomp-subst-new,
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
835 ;; math-rwcomp-subst-old-func and math-rwcomp-subst-new-func
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
836 ;; are local to math-rwcomp-substitute, but are used by
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
837 ;; math-rwcomp-subst-rec, which is called by math-rwcomp-substitute.
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
838 (defvar math-rwcomp-subst-new)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
839 (defvar math-rwcomp-subst-old)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
840 (defvar math-rwcomp-subst-new-func)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
841 (defvar math-rwcomp-subst-old-func)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
842
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
843 (defun math-rwcomp-substitute (expr math-rwcomp-subst-old math-rwcomp-subst-new)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
844 (if (and (eq (car-safe math-rwcomp-subst-old) 'var)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
845 (memq (car-safe math-rwcomp-subst-new) '(var calcFunc-lambda)))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
846 (let ((math-rwcomp-subst-old-func (math-var-to-calcFunc math-rwcomp-subst-old))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
847 (math-rwcomp-subst-new-func (math-var-to-calcFunc math-rwcomp-subst-new)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
848 (math-rwcomp-subst-rec expr))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
849 (let ((math-rwcomp-subst-old-func nil))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
850 (math-rwcomp-subst-rec expr))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
851
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
852 (defun math-rwcomp-subst-rec (expr)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
853 (cond ((equal expr math-rwcomp-subst-old) math-rwcomp-subst-new)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
854 ((Math-primp expr) expr)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
855 (t (if (eq (car expr) math-rwcomp-subst-old-func)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
856 (math-build-call math-rwcomp-subst-new-func
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
857 (mapcar 'math-rwcomp-subst-rec
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
858 (cdr expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
859 (cons (car expr)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
860 (mapcar 'math-rwcomp-subst-rec (cdr expr)))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
861
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
862 (defvar math-rwcomp-tracing nil)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
863
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
864 (defun math-rwcomp-trace (instr)
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
865 (when math-rwcomp-tracing
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
866 (terpri) (princ instr))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
867 instr)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
868
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
869 (defun math-rwcomp-instr (&rest instr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
870 (setcdr math-prog-last
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
871 (setq math-prog-last (list (math-rwcomp-trace instr)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
872
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
873 (defun math-rwcomp-multi-instr (tail &rest instr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
874 (setcdr math-prog-last
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
875 (setq math-prog-last (list (math-rwcomp-trace (append instr tail))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
876
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
877 (defun math-rwcomp-bind-var (reg var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
878 (setcar (math-rwcomp-reg-entry reg) (nth 2 var))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
879 (setq math-bound-vars (cons (nth 2 var) math-bound-vars))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
880 (math-rwcomp-do-conditions))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
881
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
882 (defun math-rwcomp-unbind-vars (mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
883 (while (not (eq math-bound-vars mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
884 (setcar (assq (car math-bound-vars) math-regs) nil)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
885 (setq math-bound-vars (cdr math-bound-vars))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
886
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
887 (defun math-rwcomp-do-conditions ()
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
888 (let ((cond math-conds))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
889 (while cond
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
890 (if (math-rwcomp-all-regs-done (car cond))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
891 (let ((expr (car cond)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
892 (setq math-conds (delq (car cond) math-conds))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
893 (setcar cond 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
894 (math-rwcomp-cond-instr expr)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
895 (setq cond (cdr cond)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
896
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
897 (defun math-rwcomp-cond-instr (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
898 (let (op arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
899 (cond ((and (eq (car-safe expr) 'calcFunc-matches)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
900 (= (length expr) 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
901 (eq (car-safe (setq arg (math-rwcomp-match-vars (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
902 'calcFunc-register))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
903 (math-rwcomp-pattern (nth 2 expr) (nth 1 arg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
904 ((math-numberp (setq expr (math-rwcomp-match-vars expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
905 (if (Math-zerop expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
906 (math-rwcomp-instr 'backtrack)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
907 ((and (eq (car expr) 'calcFunc-let)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
908 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
909 (let ((reg (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
910 (math-rwcomp-instr 'let reg (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
911 (math-rwcomp-pattern (nth 1 expr) reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
912 ((and (eq (car expr) 'calcFunc-let)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
913 (= (length expr) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
914 (eq (car-safe (nth 1 expr)) 'calcFunc-assign)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
915 (= (length (nth 1 expr)) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
916 (let ((reg (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
917 (math-rwcomp-instr 'let reg (nth 2 (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
918 (math-rwcomp-pattern (nth 1 (nth 1 expr)) reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
919 ((and (setq op (cdr (assq (car-safe expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
920 '( (calcFunc-integer . integer)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
921 (calcFunc-real . real)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
922 (calcFunc-constant . constant)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
923 (calcFunc-negative . negative) ))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
924 (= (length expr) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
925 (or (and (eq (car-safe (nth 1 expr)) 'neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
926 (memq op '(integer real constant))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
927 (setq arg (nth 1 (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
928 (setq arg (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
929 (eq (car-safe (setq arg (nth 1 expr))) 'calcFunc-register))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
930 (math-rwcomp-instr op (nth 1 arg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
931 ((and (assq (car-safe expr) calc-tweak-eqn-table)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
932 (= (length expr) 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
933 (eq (car-safe (nth 1 expr)) 'calcFunc-register))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
934 (if (math-constp (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
935 (let ((reg (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
936 (setcar (nthcdr 3 (car math-regs)) (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
937 (math-rwcomp-instr 'rel (nth 1 (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
938 (car expr) reg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
939 (if (eq (car (nth 2 expr)) 'calcFunc-register)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
940 (math-rwcomp-instr 'rel (nth 1 (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
941 (car expr) (nth 1 (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
942 (math-rwcomp-instr 'cond expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
943 ((and (eq (car-safe expr) 'calcFunc-eq)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
944 (= (length expr) 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
945 (eq (car-safe (nth 1 expr)) '%)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
946 (eq (car-safe (nth 1 (nth 1 expr))) 'calcFunc-register)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
947 (math-constp (nth 2 (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
948 (math-constp (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
949 (math-rwcomp-instr 'mod (nth 1 (nth 1 (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
950 (nth 2 (nth 1 expr)) (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
951 ((equal expr '(var remember var-remember))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
952 (setq math-remembering 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
953 ((and (eq (car-safe expr) 'calcFunc-remember)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
954 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
955 (setq math-remembering (if math-remembering
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
956 (list 'calcFunc-lor
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
957 math-remembering (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
958 (nth 1 expr))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
959 (t (math-rwcomp-instr 'cond expr)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
960
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
961 (defun math-rwcomp-same-instr (reg1 reg2 neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
962 (math-rwcomp-instr (if (eq (eq (nth 2 (math-rwcomp-reg-entry reg1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
963 (nth 2 (math-rwcomp-reg-entry reg2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
964 neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
965 'same-neg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
966 'same)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
967 reg1 reg2))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
968
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
969 (defun math-rwcomp-copy-instr (reg1 reg2 neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
970 (if (eq (eq (nth 2 (math-rwcomp-reg-entry reg1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
971 (nth 2 (math-rwcomp-reg-entry reg2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
972 neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
973 (math-rwcomp-instr 'copy-neg reg1 reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
974 (or (eq reg1 reg2)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
975 (math-rwcomp-instr 'copy reg1 reg2))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
976
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
977 (defun math-rwcomp-reg ()
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
978 (prog1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
979 math-num-regs
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
980 (setq math-regs (cons (list nil math-num-regs nil 0) math-regs)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
981 math-num-regs (1+ math-num-regs))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
982
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
983 (defun math-rwcomp-reg-entry (num)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
984 (nth (1- (- math-num-regs num)) math-regs))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
985
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
986
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
987 (defun math-rwcomp-pattern (expr part &optional not-direct)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
988 (cond ((or (math-rwcomp-no-vars expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
989 (and (eq (car expr) 'calcFunc-quote)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
990 (= (length expr) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
991 (setq expr (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
992 (if (eq (car-safe expr) 'calcFunc-register)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
993 (math-rwcomp-same-instr part (nth 1 expr) nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
994 (let ((reg (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
995 (setcar (nthcdr 3 (car math-regs)) expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
996 (math-rwcomp-same-instr part reg nil))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
997 ((eq (car expr) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
998 (let ((entry (assq (nth 2 expr) math-regs)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
999 (if entry
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1000 (math-rwcomp-same-instr part (nth 1 entry) nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1001 (if not-direct
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1002 (let ((reg (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1003 (math-rwcomp-pattern expr reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1004 (math-rwcomp-copy-instr part reg nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1005 (if (setq entry (assq (nth 2 expr) math-aliased-vars))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1006 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1007 (setcar (math-rwcomp-reg-entry (nth 1 entry))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1008 (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1009 (setcar entry nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1010 (math-rwcomp-copy-instr part (nth 1 entry) nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1011 (math-rwcomp-bind-var part expr))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1012 ((and (eq (car expr) 'calcFunc-select)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1013 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1014 (let ((reg (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1015 (math-rwcomp-instr 'select part reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1016 (math-rwcomp-pattern (nth 1 expr) reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1017 ((and (eq (car expr) 'calcFunc-opt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1018 (memq (length expr) '(2 3)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1019 (error "opt( ) occurs in context where it is not allowed"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1020 ((eq (car expr) 'neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1021 (if (eq (car (nth 1 expr)) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1022 (let ((entry (assq (nth 2 (nth 1 expr)) math-regs)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1023 (if entry
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1024 (math-rwcomp-same-instr part (nth 1 entry) t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1025 (if math-copy-neg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1026 (let ((reg (math-rwcomp-best-reg (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1027 (math-rwcomp-copy-instr part reg t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1028 (math-rwcomp-pattern (nth 1 expr) reg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1029 (setcar (cdr (cdr (math-rwcomp-reg-entry part))) t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1030 (math-rwcomp-pattern (nth 1 expr) part))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1031 (if (math-rwcomp-is-algebraic (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1032 (math-rwcomp-cond-instr (list 'calcFunc-eq
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1033 (math-rwcomp-register-expr part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1034 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1035 (let ((reg (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1036 (math-rwcomp-instr 'func part 'neg reg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1037 (math-rwcomp-pattern (nth 1 expr) reg)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1038 ((and (eq (car expr) 'calcFunc-apply)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1039 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1040 (let ((reg1 (math-rwcomp-reg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1041 (reg2 (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1042 (math-rwcomp-instr 'apply part reg1 reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1043 (math-rwcomp-pattern (nth 1 expr) reg1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1044 (math-rwcomp-pattern (nth 2 expr) reg2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1045 ((and (eq (car expr) 'calcFunc-cons)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1046 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1047 (let ((reg1 (math-rwcomp-reg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1048 (reg2 (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1049 (math-rwcomp-instr 'cons part reg1 reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1050 (math-rwcomp-pattern (nth 1 expr) reg1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1051 (math-rwcomp-pattern (nth 2 expr) reg2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1052 ((and (eq (car expr) 'calcFunc-rcons)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1053 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1054 (let ((reg1 (math-rwcomp-reg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1055 (reg2 (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1056 (math-rwcomp-instr 'rcons part reg1 reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1057 (math-rwcomp-pattern (nth 1 expr) reg1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1058 (math-rwcomp-pattern (nth 2 expr) reg2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1059 ((and (eq (car expr) 'calcFunc-condition)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1060 (>= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1061 (math-rwcomp-pattern (nth 1 expr) part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1062 (setq expr (cdr expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1063 (while (setq expr (cdr expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1064 (let ((cond (math-flatten-lands (car expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1065 (while cond
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1066 (if (math-rwcomp-all-regs-done (car cond))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1067 (math-rwcomp-cond-instr (car cond))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1068 (setq math-conds (cons (car cond) math-conds)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1069 (setq cond (cdr cond))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1070 ((and (eq (car expr) 'calcFunc-pand)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1071 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1072 (math-rwcomp-pattern (nth 1 expr) part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1073 (math-rwcomp-pattern (nth 2 expr) part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1074 ((and (eq (car expr) 'calcFunc-por)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1075 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1076 (math-rwcomp-instr 'alt nil nil [nil nil 4])
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1077 (let ((math-conds nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1078 (head math-prog-last)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1079 (mark math-bound-vars)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1080 (math-copy-neg t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1081 (math-rwcomp-pattern (nth 1 expr) part t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1082 (let ((amark math-aliased-vars)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1083 (math-aliased-vars math-aliased-vars)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1084 (tail math-prog-last)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1085 (p math-bound-vars)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1086 entry)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1087 (while (not (eq p mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1088 (setq entry (assq (car p) math-regs)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1089 math-aliased-vars (cons (list (car p) (nth 1 entry) nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1090 math-aliased-vars)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1091 p (cdr p))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1092 (setcar (math-rwcomp-reg-entry (nth 1 entry)) nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1093 (setcar (cdr (car head)) (cdr head))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1094 (setcdr head nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1095 (setq math-prog-last head)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1096 (math-rwcomp-pattern (nth 2 expr) part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1097 (math-rwcomp-instr 'same 0 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1098 (setcdr tail math-prog-last)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1099 (setq p math-aliased-vars)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1100 (while (not (eq p amark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1101 (if (car (car p))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1102 (setcar (math-rwcomp-reg-entry (nth 1 (car p)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1103 (car (car p))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1104 (setq p (cdr p)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1105 (math-rwcomp-do-conditions))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1106 ((and (eq (car expr) 'calcFunc-pnot)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1107 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1108 (math-rwcomp-instr 'alt nil nil [nil nil 4])
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1109 (let ((head math-prog-last)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1110 (mark math-bound-vars))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1111 (math-rwcomp-pattern (nth 1 expr) part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1112 (math-rwcomp-unbind-vars mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1113 (math-rwcomp-instr 'end-alt head)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1114 (math-rwcomp-instr 'backtrack)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1115 (setcar (cdr (car head)) (cdr head))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1116 (setcdr head nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1117 (setq math-prog-last head)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1118 (t (let ((props (get (car expr) 'math-rewrite-props)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1119 (if (and (eq (car expr) 'calcFunc-plain)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1120 (= (length expr) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1121 (not (math-primp (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1122 (setq expr (nth 1 expr))) ; but "props" is still nil
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1123 (if (and (memq 'algebraic props)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1124 (math-rwcomp-is-algebraic expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1125 (math-rwcomp-cond-instr (list 'calcFunc-eq
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1126 (math-rwcomp-register-expr part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1127 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1128 (if (and (memq 'commut props)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1129 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1130 (let ((arg1 (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1131 (arg2 (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1132 try1 def code head (flip nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1133 (if (eq (car expr) '-)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1134 (setq arg2 (math-rwcomp-neg arg2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1135 (setq arg1 (cons arg1 (math-rwcomp-best-reg arg1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1136 arg2 (cons arg2 (math-rwcomp-best-reg arg2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1137 (or (math-rwcomp-order arg1 arg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1138 (setq def arg1 arg1 arg2 arg2 def flip t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1139 (if (math-rwcomp-optional-arg (car expr) arg1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1140 (error "Too many opt( ) arguments in this context"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1141 (setq def (math-rwcomp-optional-arg (car expr) arg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1142 head (if (memq (car expr) '(+ -))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1143 '(+ -)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1144 (if (eq (car expr) '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1145 '(* /)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1146 (list (car expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1147 code (if (math-rwcomp-is-constrained
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1148 (car arg1) head)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1149 (if (math-rwcomp-is-constrained
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1150 (car arg2) head)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1151 0 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1152 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1153 (math-rwcomp-multi-instr (and def (list def))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1154 'try part head
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1155 (vector nil nil nil code flip)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1156 (cdr arg1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1157 (setq try1 (car math-prog-last))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1158 (math-rwcomp-pattern (car arg1) (cdr arg1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1159 (math-rwcomp-instr 'try2 try1 (cdr arg2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1160 (if (and (= part 0) (not def) (not math-rewrite-whole)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1161 (not (eq math-rhs t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1162 (setq def (get (car expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1163 'math-rewrite-default)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1164 (let ((reg1 (math-rwcomp-reg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1165 (reg2 (math-rwcomp-reg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1166 (if (= (aref (nth 3 try1) 3) 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1167 (aset (nth 3 try1) 3 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1168 (math-rwcomp-instr 'try (cdr arg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1169 (if (equal head '(* /))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1170 '(*) head)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1171 (vector nil nil nil
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1172 (if (= code 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1173 1 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1174 nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1175 reg1 def)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1176 (setq try1 (car math-prog-last))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1177 (math-rwcomp-pattern (car arg2) reg1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1178 (math-rwcomp-instr 'try2 try1 reg2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1179 (setq math-rhs (list (if (eq (car expr) '-)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1180 '+ (car expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1181 math-rhs
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1182 (list 'calcFunc-register
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1183 reg2))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1184 (math-rwcomp-pattern (car arg2) (cdr arg2))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1185 (let* ((args (mapcar (function
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1186 (lambda (x)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1187 (cons x (math-rwcomp-best-reg x))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1188 (cdr expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1189 (args2 (copy-sequence args))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1190 (argp (reverse args2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1191 (defs nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1192 (num 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1193 (while argp
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1194 (let ((def (math-rwcomp-optional-arg (car expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1195 (car argp))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1196 (if def
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1197 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1198 (setq args2 (delq (car argp) args2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1199 defs (cons (cons def (cdr (car argp)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1200 defs))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1201 (math-rwcomp-multi-instr
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1202 (mapcar 'cdr args2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1203 (if (or (and (memq 'unary1 props)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1204 (= (length args2) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1205 (eq (car args2) (car args)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1206 (and (memq 'unary2 props)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1207 (= (length args) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1208 (eq (car args2) (nth 1 args))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1209 'func-opt
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1210 'func-def)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1211 part (car expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1212 defs))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1213 (setq argp (cdr argp)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1214 (math-rwcomp-multi-instr (mapcar 'cdr args)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1215 'func part (car expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1216 (setq args (sort args 'math-rwcomp-order))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1217 (while args
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1218 (math-rwcomp-pattern (car (car args)) (cdr (car args)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1219 (setq num (1+ num)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1220 args (cdr args))))))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1221
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1222 (defun math-rwcomp-best-reg (x)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1223 (or (and (eq (car-safe x) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1224 (let ((entry (assq (nth 2 x) math-aliased-vars)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1225 (and entry
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1226 (not (nth 2 entry))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1227 (not (nth 2 (math-rwcomp-reg-entry (nth 1 entry))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1228 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1229 (setcar (cdr (cdr entry)) t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1230 (nth 1 entry)))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1231 (math-rwcomp-reg)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1232
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1233 (defun math-rwcomp-all-regs-done (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1234 (if (Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1235 (or (not (eq (car-safe expr) 'var))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1236 (assq (nth 2 expr) math-regs)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1237 (eq (nth 2 expr) 'var-remember)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1238 (math-const-var expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1239 (if (and (eq (car expr) 'calcFunc-let)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1240 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1241 (math-rwcomp-all-regs-done (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1242 (if (and (eq (car expr) 'calcFunc-let)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1243 (= (length expr) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1244 (eq (car-safe (nth 1 expr)) 'calcFunc-assign)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1245 (= (length (nth 1 expr)) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1246 (math-rwcomp-all-regs-done (nth 2 (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1247 (while (and (setq expr (cdr expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1248 (math-rwcomp-all-regs-done (car expr))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1249 (null expr)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1250
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1251 (defun math-rwcomp-no-vars (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1252 (if (Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1253 (or (not (eq (car-safe expr) 'var))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1254 (math-const-var expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1255 (and (not (memq (car expr) '(calcFunc-condition
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1256 calcFunc-select calcFunc-quote
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1257 calcFunc-plain calcFunc-opt
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1258 calcFunc-por calcFunc-pand
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1259 calcFunc-pnot calcFunc-apply
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1260 calcFunc-cons calcFunc-rcons)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1261 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1262 (while (and (setq expr (cdr expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1263 (math-rwcomp-no-vars (car expr))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1264 (null expr)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1265
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1266 (defun math-rwcomp-is-algebraic (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1267 (if (Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1268 (or (not (eq (car-safe expr) 'var))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1269 (math-const-var expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1270 (assq (nth 2 expr) math-regs))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1271 (and (memq 'algebraic (get (car expr) 'math-rewrite-props))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1272 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1273 (while (and (setq expr (cdr expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1274 (math-rwcomp-is-algebraic (car expr))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1275 (null expr)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1276
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1277 (defun math-rwcomp-is-constrained (expr not-these)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1278 (if (Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1279 (not (eq (car-safe expr) 'var))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1280 (if (eq (car expr) 'calcFunc-plain)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1281 (math-rwcomp-is-constrained (nth 1 expr) not-these)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1282 (not (or (memq (car expr) '(neg calcFunc-select))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1283 (memq (car expr) not-these)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1284 (and (memq 'commut (get (car expr) 'math-rewrite-props))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1285 (or (eq (car-safe (nth 1 expr)) 'calcFunc-opt)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1286 (eq (car-safe (nth 2 expr)) 'calcFunc-opt))))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1287
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1288 (defun math-rwcomp-optional-arg (head argp)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1289 (let ((arg (car argp)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1290 (if (eq (car-safe arg) 'calcFunc-opt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1291 (and (memq (length arg) '(2 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1292 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1293 (or (eq (car-safe (nth 1 arg)) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1294 (error "First argument of opt( ) must be a variable"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1295 (setcar argp (nth 1 arg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1296 (if (= (length arg) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1297 (or (get head 'math-rewrite-default)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1298 (error "opt( ) must include a default in this context"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1299 (nth 2 arg))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1300 (and (eq (car-safe arg) 'neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1301 (let* ((part (list (nth 1 arg)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1302 (partp (math-rwcomp-optional-arg head part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1303 (and partp
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1304 (setcar argp (math-rwcomp-neg (car part)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1305 (math-neg partp)))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1306
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1307 (defun math-rwcomp-neg (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1308 (if (memq (car-safe expr) '(* /))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1309 (if (eq (car-safe (nth 1 expr)) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1310 (list (car expr) (list 'neg (nth 1 expr)) (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1311 (if (eq (car-safe (nth 2 expr)) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1312 (list (car expr) (nth 1 expr) (list 'neg (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1313 (math-neg expr)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1314 (math-neg expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1315
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1316 (defun math-rwcomp-assoc-args (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1317 (if (and (eq (car-safe (nth 1 expr)) (car expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1318 (= (length (nth 1 expr)) 3))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1319 (math-rwcomp-assoc-args (nth 1 expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1320 (if (and (eq (car-safe (nth 2 expr)) (car expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1321 (= (length (nth 2 expr)) 3))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1322 (math-rwcomp-assoc-args (nth 2 expr))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1323
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1324 (defun math-rwcomp-addsub-args (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1325 (if (memq (car-safe (nth 1 expr)) '(+ -))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1326 (math-rwcomp-addsub-args (nth 1 expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1327 (if (eq (car expr) '-)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1328 ()
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1329 (if (eq (car-safe (nth 2 expr)) '+)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1330 (math-rwcomp-addsub-args (nth 2 expr)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1331
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1332 (defun math-rwcomp-order (a b)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1333 (< (math-rwcomp-priority (car a))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1334 (math-rwcomp-priority (car b))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1335
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1336 ;;; Order of priority: 0 Constants and other exact matches (first)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1337 ;;; 10 Functions (except below)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1338 ;;; 20 Meta-variables which occur more than once
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1339 ;;; 30 Algebraic functions
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1340 ;;; 40 Commutative/associative functions
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1341 ;;; 50 Meta-variables which occur only once
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1342 ;;; +100 for every "!!!" (pnot) in the pattern
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1343 ;;; 10000 Optional arguments (last)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1344
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1345 (defun math-rwcomp-priority (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1346 (+ (math-rwcomp-count-pnots expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1347 (cond ((eq (car-safe expr) 'calcFunc-opt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1348 10000)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1349 ((math-rwcomp-no-vars expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1350 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1351 ((eq (car expr) 'calcFunc-quote)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1352 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1353 ((eq (car expr) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1354 (if (assq (nth 2 expr) math-regs)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1355 0
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1356 (if (= (math-rwcomp-count-refs expr) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1357 50
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1358 20)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1359 (t (let ((props (get (car expr) 'math-rewrite-props)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1360 (if (or (memq 'commut props)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1361 (memq 'assoc props))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1362 40
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1363 (if (memq 'algebraic props)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1364 30
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1365 10)))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1366
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1367 (defun math-rwcomp-count-refs (var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1368 (let ((count (or (math-expr-contains-count math-pattern var) 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1369 (p math-conds))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1370 (while p
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1371 (if (eq (car-safe (car p)) 'calcFunc-let)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1372 (if (= (length (car p)) 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1373 (setq count (+ count
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1374 (or (math-expr-contains-count (nth 2 (car p)) var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1375 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1376 (if (and (= (length (car p)) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1377 (eq (car-safe (nth 1 (car p))) 'calcFunc-assign)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1378 (= (length (nth 1 (car p))) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1379 (setq count (+ count
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1380 (or (math-expr-contains-count
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1381 (nth 2 (nth 1 (car p))) var) 0))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1382 (setq p (cdr p)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1383 count))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1384
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1385 (defun math-rwcomp-count-pnots (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1386 (if (Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1387 0
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1388 (if (eq (car expr) 'calcFunc-pnot)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1389 100
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1390 (let ((count 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1391 (while (setq expr (cdr expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1392 (setq count (+ count (math-rwcomp-count-pnots (car expr)))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1393 count))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1394
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1395 ;;; In the current implementation, all associative functions must
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1396 ;;; also be commutative.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1397
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1398 (put '+ 'math-rewrite-props '(algebraic assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1399 (put '- 'math-rewrite-props '(algebraic assoc commut)) ; see below
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1400 (put '* 'math-rewrite-props '(algebraic assoc commut)) ; see below
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1401 (put '/ 'math-rewrite-props '(algebraic unary1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1402 (put '^ 'math-rewrite-props '(algebraic unary1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1403 (put '% 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1404 (put 'neg 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1405 (put 'calcFunc-idiv 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1406 (put 'calcFunc-abs 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1407 (put 'calcFunc-sign 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1408 (put 'calcFunc-round 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1409 (put 'calcFunc-rounde 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1410 (put 'calcFunc-roundu 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1411 (put 'calcFunc-trunc 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1412 (put 'calcFunc-floor 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1413 (put 'calcFunc-ceil 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1414 (put 'calcFunc-re 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1415 (put 'calcFunc-im 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1416 (put 'calcFunc-conj 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1417 (put 'calcFunc-arg 'math-rewrite-props '(algebraic))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1418 (put 'calcFunc-and 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1419 (put 'calcFunc-or 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1420 (put 'calcFunc-xor 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1421 (put 'calcFunc-eq 'math-rewrite-props '(commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1422 (put 'calcFunc-neq 'math-rewrite-props '(commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1423 (put 'calcFunc-land 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1424 (put 'calcFunc-lor 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1425 (put 'calcFunc-beta 'math-rewrite-props '(commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1426 (put 'calcFunc-gcd 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1427 (put 'calcFunc-lcm 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1428 (put 'calcFunc-max 'math-rewrite-props '(algebraic assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1429 (put 'calcFunc-min 'math-rewrite-props '(algebraic assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1430 (put 'calcFunc-vunion 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1431 (put 'calcFunc-vint 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1432 (put 'calcFunc-vxor 'math-rewrite-props '(assoc commut))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1433
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1434 ;;; Note: "*" is not commutative for matrix args, but we pretend it is.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1435 ;;; Also, "-" is not commutative but the code tweaks things so that it is.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1436
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1437 (put '+ 'math-rewrite-default 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1438 (put '- 'math-rewrite-default 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1439 (put '* 'math-rewrite-default 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1440 (put '/ 'math-rewrite-default 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1441 (put '^ 'math-rewrite-default 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1442 (put 'calcFunc-land 'math-rewrite-default 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1443 (put 'calcFunc-lor 'math-rewrite-default 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1444 (put 'calcFunc-vunion 'math-rewrite-default '(vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1445 (put 'calcFunc-vint 'math-rewrite-default '(vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1446 (put 'calcFunc-vdiff 'math-rewrite-default '(vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1447 (put 'calcFunc-vxor 'math-rewrite-default '(vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1448
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1449 (defmacro math-rwfail (&optional back)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1450 (list 'setq 'pc
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1451 (list 'and
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1452 (if back
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1453 '(setq btrack (cdr btrack))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1454 'btrack)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1455 ''((backtrack)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1456
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1457 ;;; This monstrosity is necessary because the use of static vectors of
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1458 ;;; registers makes rewrite rules non-reentrant. Yucko!
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1459 (defmacro math-rweval (form)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1460 (list 'let '((orig (car rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1461 '(setcar rules (quote (nil nil nil no-phase)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1462 (list 'unwind-protect
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1463 form
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1464 '(setcar rules orig))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1465
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1466 (defvar math-rewrite-phase 1)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1467
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1468 ;; The variable math-apply-rw-regs is local to math-apply-rewrites,
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1469 ;; but is used by math-rwapply-replace-regs and math-rwapply-reg-looks-negp
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1470 ;; which are called by math-apply-rewrites.
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1471 (defvar math-apply-rw-regs)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1472
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1473 ;; The variable math-apply-rw-ruleset is local to math-apply-rewrites,
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1474 ;; but is used by math-rwapply-remember.
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1475 (defvar math-apply-rw-ruleset)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1476
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1477 (defun math-apply-rewrites (expr rules &optional heads math-apply-rw-ruleset)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1478 (and
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1479 (setq rules (cdr (or (assq (car-safe expr) rules)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1480 (assq nil rules))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1481 (let ((result nil)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1482 op math-apply-rw-regs inst part pc mark btrack
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1483 (tracing math-rwcomp-tracing)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1484 (phase math-rewrite-phase))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1485 (while rules
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1486 (or
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1487 (and (setq part (nth 2 (car rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1488 heads
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1489 (not (memq part heads)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1490 (and (setq part (nth 3 (car rules)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1491 (not (memq phase part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1492 (progn
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1493 (setq math-apply-rw-regs (car (car rules))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1494 pc (nth 1 (car rules))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1495 btrack nil)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1496 (aset math-apply-rw-regs 0 expr)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1497 (while pc
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1498
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1499 (and tracing
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1500 (progn (terpri) (princ (car pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1501 (if (and (natnump (nth 1 (car pc)))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1502 (< (nth 1 (car pc)) (length math-apply-rw-regs)))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1503 (princ
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1504 (format "\n part = %s"
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1505 (aref math-apply-rw-regs (nth 1 (car pc))))))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1506
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1507 (cond ((eq (setq op (car (setq inst (car pc)))) 'func)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1508 (if (and (consp
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1509 (setq part (aref math-apply-rw-regs (car (cdr inst)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1510 (eq (car part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1511 (car (setq inst (cdr (cdr inst)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1512 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1513 (while (and (setq inst (cdr inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1514 part (cdr part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1515 inst)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1516 (aset math-apply-rw-regs (car inst) (car part)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1517 (not (or inst part))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1518 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1519 (math-rwfail)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1520
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1521 ((eq op 'same)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1522 (if (or (equal (setq part (aref math-apply-rw-regs (nth 1 inst)))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1523 (setq mark (aref math-apply-rw-regs (nth 2 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1524 (Math-equal part mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1525 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1526 (math-rwfail)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1527
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1528 ((and (eq op 'try)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1529 calc-matrix-mode
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1530 (not (eq calc-matrix-mode 'scalar))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1531 (eq (car (nth 2 inst)) '*)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1532 (consp (setq part (aref math-apply-rw-regs (car (cdr inst)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1533 (eq (car part) '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1534 (not (math-known-scalarp part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1535 (setq mark (nth 3 inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1536 pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1537 (if (aref mark 4)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1538 (progn
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1539 (aset math-apply-rw-regs (nth 4 inst) (nth 2 part))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1540 (aset mark 1 (cdr (cdr part))))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1541 (aset math-apply-rw-regs (nth 4 inst) (nth 1 part))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1542 (aset mark 1 (cdr part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1543 (aset mark 0 (cdr part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1544 (aset mark 2 0))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1545
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1546 ((eq op 'try)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1547 (if (and (consp (setq part
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1548 (aref math-apply-rw-regs (car (cdr inst)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1549 (memq (car part) (nth 2 inst))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1550 (= (length part) 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1551 (or (not (eq (car part) '/))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1552 (Math-objectp (nth 2 part))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1553 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1554 (setq op nil
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1555 mark (car (cdr (setq inst (cdr (cdr inst))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1556 (and
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1557 (memq 'assoc (get (car part) 'math-rewrite-props))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1558 (not (= (aref mark 3) 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1559 (while (if (and (consp (nth 1 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1560 (memq (car (nth 1 part)) (car inst)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1561 (setq op (cons (if (eq (car part) '-)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1562 (math-rwapply-neg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1563 (nth 2 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1564 (nth 2 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1565 op)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1566 part (nth 1 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1567 (if (and (consp (nth 2 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1568 (memq (car (nth 2 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1569 (car inst))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1570 (not (eq (car (nth 2 part)) '-)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1571 (setq op (cons (nth 1 part) op)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1572 part (nth 2 part))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1573 (setq op (cons (nth 1 part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1574 (cons (if (eq (car part) '-)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1575 (math-rwapply-neg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1576 (nth 2 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1577 (if (eq (car part) '/)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1578 (math-rwapply-inv
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1579 (nth 2 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1580 (nth 2 part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1581 op))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1582 btrack (cons pc btrack)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1583 pc (cdr pc))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1584 (aset math-apply-rw-regs (nth 2 inst) (car op))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1585 (aset mark 0 op)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1586 (aset mark 1 op)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1587 (aset mark 2 (if (cdr (cdr op)) 1 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1588 (if (nth 5 inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1589 (if (and (consp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1590 (eq (car part) 'neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1591 (eq (car (nth 2 inst)) '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1592 (eq (nth 5 inst) 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1593 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1594 (setq mark (nth 3 inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1595 pc (cdr pc))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1596 (aset math-apply-rw-regs (nth 4 inst) (nth 1 part))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1597 (aset mark 1 -1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1598 (aset mark 2 4))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1599 (setq mark (nth 3 inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1600 pc (cdr pc))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1601 (aset math-apply-rw-regs (nth 4 inst) part)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1602 (aset mark 2 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1603 (math-rwfail))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1604
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1605 ((eq op 'try2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1606 (setq part (nth 1 inst) ; try instr
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1607 mark (nth 3 part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1608 op (aref mark 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1609 pc (cdr pc))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1610 (aset math-apply-rw-regs (nth 2 inst)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1611 (cond
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1612 ((eq op 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1613 (if (eq (aref mark 0) (aref mark 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1614 (nth 1 (aref mark 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1615 (car (aref mark 0))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1616 ((eq op 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1617 (setq mark (delq (car (aref mark 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1618 (copy-sequence (aref mark 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1619 op (car (nth 2 part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1620 (if (eq op '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1621 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1622 (setq mark (nreverse mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1623 part (list '* (nth 1 mark) (car mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1624 mark (cdr mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1625 (while (setq mark (cdr mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1626 (setq part (list '* (car mark) part))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1627 (setq part (car mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1628 mark (cdr mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1629 part (if (and (eq op '+)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1630 (consp (car mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1631 (eq (car (car mark)) 'neg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1632 (list '- part
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1633 (nth 1 (car mark)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1634 (list op part (car mark))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1635 (while (setq mark (cdr mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1636 (setq part (if (and (eq op '+)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1637 (consp (car mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1638 (eq (car (car mark)) 'neg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1639 (list '- part
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1640 (nth 1 (car mark)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1641 (list op part (car mark))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1642 part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1643 ((eq op 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1644 (car (aref mark 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1645 ((eq op 3) (nth 5 part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1646 (t (aref mark 1)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1647
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1648 ((eq op 'select)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1649 (setq pc (cdr pc))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1650 (if (and (consp (setq part (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1651 (eq (car part) 'calcFunc-select))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1652 (aset math-apply-rw-regs (nth 2 inst) (nth 1 part))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1653 (if math-rewrite-selections
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1654 (math-rwfail)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1655 (aset math-apply-rw-regs (nth 2 inst) part))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1656
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1657 ((eq op 'same-neg)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1658 (if (or (equal (setq part (aref math-apply-rw-regs (nth 1 inst)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1659 (setq mark (math-neg
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1660 (aref math-apply-rw-regs (nth 2 inst)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1661 (Math-equal part mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1662 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1663 (math-rwfail)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1664
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1665 ((eq op 'backtrack)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1666 (setq inst (car (car btrack)) ; "try" or "alt" instr
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1667 pc (cdr (car btrack))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1668 mark (or (nth 3 inst) [nil nil 4])
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1669 op (aref mark 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1670 (cond ((eq op 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1671 (if (setq op (cdr (aref mark 1)))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1672 (aset math-apply-rw-regs (nth 4 inst)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1673 (car (aset mark 1 op)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1674 (if (nth 5 inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1675 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1676 (aset mark 2 3)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1677 (aset math-apply-rw-regs (nth 4 inst)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1678 (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1679 (math-rwfail t))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1680 ((eq op 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1681 (if (setq op (cdr (aref mark 1)))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1682 (aset math-apply-rw-regs (nth 4 inst)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1683 (car (aset mark 1 op)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1684 (if (= (aref mark 3) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1685 (if (nth 5 inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1686 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1687 (aset mark 2 3)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1688 (aset math-apply-rw-regs (nth 4 inst)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1689 (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1690 (math-rwfail t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1691 (aset mark 2 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1692 (aset mark 1 (cons nil (aref mark 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1693 (math-rwfail))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1694 ((eq op 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1695 (if (setq op (cdr (aref mark 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1696 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1697 (setq mark (delq (car (aset mark 1 op))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1698 (copy-sequence
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1699 (aref mark 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1700 op (car (nth 2 inst)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1701 (if (eq op '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1702 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1703 (setq mark (nreverse mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1704 part (list '* (nth 1 mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1705 (car mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1706 mark (cdr mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1707 (while (setq mark (cdr mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1708 (setq part (list '* (car mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1709 part))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1710 (setq part (car mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1711 mark (cdr mark)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1712 part (if (and (eq op '+)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1713 (consp (car mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1714 (eq (car (car mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1715 'neg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1716 (list '- part
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1717 (nth 1 (car mark)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1718 (list op part (car mark))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1719 (while (setq mark (cdr mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1720 (setq part (if (and (eq op '+)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1721 (consp (car mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1722 (eq (car (car mark))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1723 'neg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1724 (list '- part
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1725 (nth 1 (car mark)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1726 (list op part (car mark))))))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1727 (aset math-apply-rw-regs (nth 4 inst) part))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1728 (if (nth 5 inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1729 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1730 (aset mark 2 3)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1731 (aset math-apply-rw-regs (nth 4 inst)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1732 (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1733 (math-rwfail t))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1734 ((eq op 4)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1735 (setq btrack (cdr btrack)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1736 (t (math-rwfail t))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1737
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1738 ((eq op 'integer)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1739 (if (Math-integerp (setq part
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1740 (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1741 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1742 (if (Math-primp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1743 (math-rwfail)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1744 (setq part (math-rweval (math-simplify part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1745 (if (Math-integerp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1746 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1747 (math-rwfail)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1748
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1749 ((eq op 'real)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1750 (if (Math-realp (setq part (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1751 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1752 (if (Math-primp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1753 (math-rwfail)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1754 (setq part (math-rweval (math-simplify part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1755 (if (Math-realp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1756 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1757 (math-rwfail)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1758
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1759 ((eq op 'constant)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1760 (if (math-constp (setq part (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1761 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1762 (if (Math-primp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1763 (math-rwfail)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1764 (setq part (math-rweval (math-simplify part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1765 (if (math-constp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1766 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1767 (math-rwfail)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1768
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1769 ((eq op 'negative)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1770 (if (math-looks-negp (setq part
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1771 (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1772 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1773 (if (Math-primp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1774 (math-rwfail)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1775 (setq part (math-rweval (math-simplify part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1776 (if (math-looks-negp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1777 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1778 (math-rwfail)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1779
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1780 ((eq op 'rel)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1781 (setq part (math-compare (aref math-apply-rw-regs (nth 1 inst))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1782 (aref math-apply-rw-regs (nth 3 inst)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1783 op (nth 2 inst))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1784 (if (= part 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1785 (setq part (math-rweval
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1786 (math-simplify
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1787 (calcFunc-sign
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1788 (math-sub
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1789 (aref math-apply-rw-regs (nth 1 inst))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1790 (aref math-apply-rw-regs (nth 3 inst))))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1791 (if (cond ((eq op 'calcFunc-eq)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1792 (eq part 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1793 ((eq op 'calcFunc-neq)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1794 (memq part '(-1 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1795 ((eq op 'calcFunc-lt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1796 (eq part -1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1797 ((eq op 'calcFunc-leq)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1798 (memq part '(-1 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1799 ((eq op 'calcFunc-gt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1800 (eq part 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1801 ((eq op 'calcFunc-geq)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1802 (memq part '(0 1))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1803 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1804 (math-rwfail)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1805
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1806 ((eq op 'func-def)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1807 (if (and
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1808 (consp (setq part (aref math-apply-rw-regs (car (cdr inst)))))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1809 (eq (car part)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1810 (car (setq inst (cdr (cdr inst))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1811 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1812 (setq inst (cdr inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1813 mark (car inst))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1814 (while (and (setq inst (cdr inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1815 part (cdr part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1816 inst)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1817 (aset math-apply-rw-regs (car inst) (car part)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1818 (if (or inst part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1819 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1820 (while (eq (car (car (setq pc (cdr pc))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1821 'func-def))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1822 (setq pc (cdr pc)) ; skip over "func"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1823 (while mark
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1824 (aset math-apply-rw-regs (cdr (car mark)) (car (car mark)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1825 (setq mark (cdr mark)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1826 (math-rwfail)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1827
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1828 ((eq op 'func-opt)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1829 (if (or (not
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1830 (and
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1831 (consp
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1832 (setq part (aref math-apply-rw-regs (car (cdr inst)))))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1833 (eq (car part) (nth 2 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1834 (and (= (length part) 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1835 (setq part (nth 1 part))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1836 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1837 (setq mark (nth 3 inst))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1838 (aset math-apply-rw-regs (nth 4 inst) part)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1839 (while (eq (car (car (setq pc (cdr pc)))) 'func-def))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1840 (setq pc (cdr pc)) ; skip over "func"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1841 (while mark
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1842 (aset math-apply-rw-regs (cdr (car mark)) (car (car mark)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1843 (setq mark (cdr mark))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1844 (setq pc (cdr pc))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1845
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1846 ((eq op 'mod)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1847 (if (if (Math-zerop
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1848 (setq part (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1849 (Math-zerop (nth 3 inst))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1850 (and (not (Math-zerop (nth 2 inst)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1851 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1852 (setq part (math-mod part (nth 2 inst)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1853 (or (Math-numberp part)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1854 (setq part (math-rweval
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1855 (math-simplify part))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1856 (Math-equal part (nth 3 inst)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1857 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1858 (math-rwfail)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1859
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1860 ((eq op 'apply)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1861 (if (and (consp
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1862 (setq part (aref math-apply-rw-regs (car (cdr inst)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1863 (not (Math-objvecp part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1864 (not (eq (car part) 'var)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1865 (progn
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1866 (aset math-apply-rw-regs (nth 2 inst)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1867 (math-calcFunc-to-var (car part)))
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1868 (aset math-apply-rw-regs (nth 3 inst)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1869 (cons 'vec (cdr part)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1870 (setq pc (cdr pc)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1871 (math-rwfail)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1872
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1873 ((eq op 'cons)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1874 (if (and (consp
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1875 (setq part (aref math-apply-rw-regs (car (cdr inst)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1876 (eq (car part) 'vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1877 (cdr part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1878 (progn
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1879 (aset math-apply-rw-regs (nth 2 inst) (nth 1 part))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1880 (aset math-apply-rw-regs (nth 3 inst)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1881 (cons 'vec (cdr (cdr part))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1882 (setq pc (cdr pc)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1883 (math-rwfail)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1884
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1885 ((eq op 'rcons)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1886 (if (and (consp
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1887 (setq part (aref math-apply-rw-regs (car (cdr inst)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1888 (eq (car part) 'vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1889 (cdr part))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1890 (progn
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1891 (aset math-apply-rw-regs (nth 2 inst) (calcFunc-rhead part))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1892 (aset math-apply-rw-regs (nth 3 inst) (calcFunc-rtail part))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1893 (setq pc (cdr pc)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1894 (math-rwfail)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1895
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1896 ((eq op 'cond)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1897 (if (math-is-true
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1898 (math-rweval
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1899 (math-simplify
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1900 (math-rwapply-replace-regs (nth 1 inst)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1901 (setq pc (cdr pc))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1902 (math-rwfail)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1903
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1904 ((eq op 'let)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1905 (aset math-apply-rw-regs (nth 1 inst)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1906 (math-rweval
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1907 (math-normalize
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1908 (math-rwapply-replace-regs (nth 2 inst)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1909 (setq pc (cdr pc)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1910
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1911 ((eq op 'copy)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1912 (aset math-apply-rw-regs (nth 2 inst)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1913 (aref math-apply-rw-regs (nth 1 inst)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1914 (setq pc (cdr pc)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1915
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1916 ((eq op 'copy-neg)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1917 (aset math-apply-rw-regs (nth 2 inst)
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1918 (math-rwapply-neg (aref math-apply-rw-regs (nth 1 inst))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1919 (setq pc (cdr pc)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1920
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1921 ((eq op 'alt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1922 (setq btrack (cons pc btrack)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1923 pc (nth 1 inst)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1924
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1925 ((eq op 'end-alt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1926 (while (and btrack (not (eq (car btrack) (nth 1 inst))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1927 (setq btrack (cdr btrack)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1928 (setq btrack (cdr btrack)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1929 pc (cdr pc)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1930
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1931 ((eq op 'done)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1932 (setq result (math-rwapply-replace-regs (nth 1 inst)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1933 (if (or (and (eq (car-safe result) '+)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1934 (eq (nth 2 result) 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1935 (and (eq (car-safe result) '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1936 (eq (nth 2 result) 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1937 (setq result (nth 1 result)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1938 (setq part (and (nth 2 inst)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1939 (math-is-true
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1940 (math-rweval
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1941 (math-simplify
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1942 (math-rwapply-replace-regs
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1943 (nth 2 inst)))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1944 (if (or (equal result expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1945 (equal (setq result (math-normalize result)) expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1946 (setq result nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1947 (if part (math-rwapply-remember expr result))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1948 (setq rules nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1949 (setq pc nil))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49263
diff changeset
1950
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1951 (t (error "%s is not a valid rewrite opcode" op))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1952 (setq rules (cdr rules)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1953 result)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1954
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1955 (defun math-rwapply-neg (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1956 (if (and (consp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1957 (memq (car expr) '(* /)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1958 (if (Math-objectp (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1959 (list (car expr) (nth 1 expr) (math-neg (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1960 (list (car expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1961 (if (Math-objectp (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1962 (math-neg (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1963 (list '* -1 (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1964 (nth 2 expr)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1965 (math-neg expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1966
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1967 (defun math-rwapply-inv (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1968 (if (and (Math-integerp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1969 calc-prefer-frac)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1970 (math-make-frac 1 expr)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1971 (list '/ 1 expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1972
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1973 (defun math-rwapply-replace-regs (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1974 (cond ((Math-primp expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1975 expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1976 ((eq (car expr) 'calcFunc-register)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
1977 (setq expr (aref math-apply-rw-regs (nth 1 expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1978 (if (eq (car-safe expr) '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1979 (if (eq (nth 1 expr) -1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1980 (math-neg (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1981 (if (eq (nth 1 expr) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1982 (nth 2 expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1983 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1984 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1985 ((and (eq (car expr) 'calcFunc-eval)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1986 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1987 (calc-with-default-simplification
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1988 (math-normalize (math-rwapply-replace-regs (nth 1 expr)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1989 ((and (eq (car expr) 'calcFunc-evalsimp)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1990 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1991 (math-simplify (math-rwapply-replace-regs (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1992 ((and (eq (car expr) 'calcFunc-evalextsimp)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1993 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1994 (math-simplify-extended (math-rwapply-replace-regs (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1995 ((and (eq (car expr) 'calcFunc-apply)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1996 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1997 (let ((func (math-rwapply-replace-regs (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1998 (args (math-rwapply-replace-regs (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1999 call)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2000 (if (and (math-vectorp args)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2001 (not (eq (car-safe (setq call (math-build-call
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2002 (math-var-to-calcFunc func)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2003 (cdr args))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2004 'calcFunc-call)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2005 call
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2006 (list 'calcFunc-apply func args))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2007 ((and (eq (car expr) 'calcFunc-cons)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2008 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2009 (let ((head (math-rwapply-replace-regs (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2010 (tail (math-rwapply-replace-regs (nth 2 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2011 (if (math-vectorp tail)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2012 (cons 'vec (cons head (cdr tail)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2013 (list 'calcFunc-cons head tail))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2014 ((and (eq (car expr) 'calcFunc-rcons)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2015 (= (length expr) 3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2016 (let ((head (math-rwapply-replace-regs (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2017 (tail (math-rwapply-replace-regs (nth 2 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2018 (if (math-vectorp head)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2019 (append head (list tail))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2020 (list 'calcFunc-rcons head tail))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2021 ((and (eq (car expr) 'neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2022 (math-rwapply-reg-looks-negp (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2023 (math-rwapply-reg-neg (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2024 ((and (eq (car expr) 'neg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2025 (eq (car-safe (nth 1 expr)) 'calcFunc-register)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
2026 (math-scalarp (aref math-apply-rw-regs (nth 1 (nth 1 expr)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2027 (math-neg (math-rwapply-replace-regs (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2028 ((and (eq (car expr) '+)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2029 (math-rwapply-reg-looks-negp (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2030 (list '- (math-rwapply-replace-regs (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2031 (math-rwapply-reg-neg (nth 1 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2032 ((and (eq (car expr) '+)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2033 (math-rwapply-reg-looks-negp (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2034 (list '- (math-rwapply-replace-regs (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2035 (math-rwapply-reg-neg (nth 2 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2036 ((and (eq (car expr) '-)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2037 (math-rwapply-reg-looks-negp (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2038 (list '+ (math-rwapply-replace-regs (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2039 (math-rwapply-reg-neg (nth 2 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2040 ((eq (car expr) '*)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2041 (cond ((eq (nth 1 expr) -1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2042 (if (math-rwapply-reg-looks-negp (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2043 (math-rwapply-reg-neg (nth 2 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2044 (math-neg (math-rwapply-replace-regs (nth 2 expr)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2045 ((eq (nth 1 expr) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2046 (math-rwapply-replace-regs (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2047 ((eq (nth 2 expr) -1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2048 (if (math-rwapply-reg-looks-negp (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2049 (math-rwapply-reg-neg (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2050 (math-neg (math-rwapply-replace-regs (nth 1 expr)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2051 ((eq (nth 2 expr) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2052 (math-rwapply-replace-regs (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2053 (t
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2054 (let ((arg1 (math-rwapply-replace-regs (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2055 (arg2 (math-rwapply-replace-regs (nth 2 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2056 (cond ((and (eq (car-safe arg1) '/)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2057 (eq (nth 1 arg1) 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2058 (list '/ arg2 (nth 2 arg1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2059 ((and (eq (car-safe arg2) '/)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2060 (eq (nth 1 arg2) 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2061 (list '/ arg1 (nth 2 arg2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2062 (t (list '* arg1 arg2)))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2063 ((eq (car expr) '/)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2064 (let ((arg1 (math-rwapply-replace-regs (nth 1 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2065 (arg2 (math-rwapply-replace-regs (nth 2 expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2066 (if (eq (car-safe arg2) '/)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2067 (list '/ (list '* arg1 (nth 2 arg2)) (nth 1 arg2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2068 (list '/ arg1 arg2))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2069 ((and (eq (car expr) 'calcFunc-plain)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2070 (= (length expr) 2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2071 (if (Math-primp (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2072 (nth 1 expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2073 (if (eq (car (nth 1 expr)) 'calcFunc-register)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
2074 (aref math-apply-rw-regs (nth 1 (nth 1 expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2075 (cons (car (nth 1 expr)) (mapcar 'math-rwapply-replace-regs
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2076 (cdr (nth 1 expr)))))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
2077 (t (cons (car expr) (mapcar 'math-rwapply-replace-regs (cdr expr))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2078
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2079 (defun math-rwapply-reg-looks-negp (expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2080 (if (eq (car-safe expr) 'calcFunc-register)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
2081 (math-looks-negp (aref math-apply-rw-regs (nth 1 expr)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2082 (if (memq (car-safe expr) '(* /))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2083 (or (math-rwapply-reg-looks-negp (nth 1 expr))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
2084 (math-rwapply-reg-looks-negp (nth 2 expr))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2085
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2086 (defun math-rwapply-reg-neg (expr) ; expr must satisfy rwapply-reg-looks-negp
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2087 (if (eq (car expr) 'calcFunc-register)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2088 (math-neg (math-rwapply-replace-regs expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2089 (if (math-rwapply-reg-looks-negp (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2090 (math-rwapply-replace-regs (list (car expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2091 (math-rwapply-reg-neg (nth 1 expr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2092 (nth 2 expr)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2093 (math-rwapply-replace-regs (list (car expr)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2094 (nth 1 expr)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
2095 (math-rwapply-reg-neg (nth 2 expr)))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2096
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2097 (defun math-rwapply-remember (old new)
58333
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
2098 (let ((varval (symbol-value (nth 2 (car math-apply-rw-ruleset))))
285e9f39fa7d (calc-rewrite-selection): Make rules a local variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58105
diff changeset
2099 (rules (assq (car-safe old) math-apply-rw-ruleset)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2100 (if (and (eq (car-safe varval) 'vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2101 (not (memq (car-safe old) '(nil schedule + -)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2102 rules)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2103 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2104 (setcdr varval (cons (list 'calcFunc-assign
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2105 (if (math-rwcomp-no-vars old)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2106 old
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2107 (list 'calcFunc-quote old))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2108 new)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2109 (cdr varval)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2110 (setcdr rules (cons (list (vector nil old)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2111 (list (list 'same 0 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2112 (list 'done new nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
2113 nil nil)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
2114 (cdr rules)))))))
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
2115
58669
28d7c9f8d013 Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58333
diff changeset
2116 (provide 'calc-rewr)
28d7c9f8d013 Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58333
diff changeset
2117
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 49598
diff changeset
2118 ;;; arch-tag: ca8d7b7d-bff1-4535-90f3-e2241f5e786b
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
2119 ;;; calc-rewr.el ends here