/[emacs]/emacs/lisp/calc/calc-rewr.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-rewr.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6.4.2 by miles, Wed Oct 27 05:42:03 2004 UTC revision 1.6.4.3 by miles, Fri Nov 12 02:53:01 2004 UTC
# Line 166  Line 166 
166    
167    
168    
169  (defun math-rewrite (whole-expr rules &optional mmt-many)  (defun math-rewrite (whole-expr rules &optional math-mt-many)
170    (let ((crules (math-compile-rewrites rules))    (let ((crules (math-compile-rewrites rules))
171          (heads (math-rewrite-heads whole-expr))          (heads (math-rewrite-heads whole-expr))
172          (trace-buffer (get-buffer "*Trace*"))          (trace-buffer (get-buffer "*Trace*"))
# Line 176  Line 176 
176          (calc-line-numbering nil)          (calc-line-numbering nil)
177          (calc-show-selections t)          (calc-show-selections t)
178          (calc-why nil)          (calc-why nil)
179          (mmt-func (function          (math-mt-func (function
180                     (lambda (x)                         (lambda (x)
181                       (let ((result (math-apply-rewrites x (cdr crules)                           (let ((result (math-apply-rewrites x (cdr crules)
182                                                          heads crules)))                                                              heads crules)))
183                         (if result                             (if result
184                             (progn                                 (progn
185                               (if trace-buffer                                   (if trace-buffer
186                                   (let ((fmt (math-format-stack-value                                       (let ((fmt (math-format-stack-value
187                                               (list result nil nil))))                                                   (list result nil nil))))
188                                     (save-excursion                                         (save-excursion
189                                       (set-buffer trace-buffer)                                           (set-buffer trace-buffer)
190                                       (insert "\nrewrite to\n" fmt "\n"))))                                           (insert "\nrewrite to\n" fmt "\n"))))
191                               (setq heads (math-rewrite-heads result heads t))))                                   (setq heads (math-rewrite-heads result heads t))))
192                         result)))))                             result)))))
193      (if trace-buffer      (if trace-buffer
194          (let ((fmt (math-format-stack-value (list whole-expr nil nil))))          (let ((fmt (math-format-stack-value (list whole-expr nil nil))))
195            (save-excursion            (save-excursion
# Line 197  Line 197 
197              (setq truncate-lines t)              (setq truncate-lines t)
198              (goto-char (point-max))              (goto-char (point-max))
199              (insert "\n\nBegin rewriting\n" fmt "\n"))))              (insert "\n\nBegin rewriting\n" fmt "\n"))))
200      (or mmt-many (setq mmt-many (or (nth 1 (car crules))      (or math-mt-many (setq math-mt-many (or (nth 1 (car crules))
201                                      math-rewrite-default-iters)))                                      math-rewrite-default-iters)))
202      (if (equal mmt-many '(var inf var-inf)) (setq mmt-many 1000000))      (if (equal math-mt-many '(var inf var-inf)) (setq math-mt-many 1000000))
203      (if (equal mmt-many '(neg (var inf var-inf))) (setq mmt-many -1000000))      (if (equal math-mt-many '(neg (var inf var-inf))) (setq math-mt-many -1000000))
204      (math-rewrite-phase (nth 3 (car crules)))      (math-rewrite-phase (nth 3 (car crules)))
205      (if trace-buffer      (if trace-buffer
206          (let ((fmt (math-format-stack-value (list whole-expr nil nil))))          (let ((fmt (math-format-stack-value (list whole-expr nil nil))))
207            (save-excursion            (save-excursion
208              (set-buffer trace-buffer)              (set-buffer trace-buffer)
209              (insert "\nDone rewriting"              (insert "\nDone rewriting"
210                      (if (= mmt-many 0) " (reached iteration limit)" "")                      (if (= math-mt-many 0) " (reached iteration limit)" "")
211                      ":\n" fmt "\n"))))                      ":\n" fmt "\n"))))
212      whole-expr))      whole-expr))
213    
214  (defun math-rewrite-phase (sched)  (defun math-rewrite-phase (sched)
215    (while (and sched (/= mmt-many 0))    (while (and sched (/= math-mt-many 0))
216      (if (listp (car sched))      (if (listp (car sched))
217          (while (let ((save-expr whole-expr))          (while (let ((save-expr whole-expr))
218                   (math-rewrite-phase (car sched))                   (math-rewrite-phase (car sched))

Legend:
Removed from v.1.6.4.2  
changed lines
  Added in v.1.6.4.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26