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*")) |
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 |
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)) |