aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMark Oteiza2017-06-27 23:59:24 -0400
committerMark Oteiza2017-06-27 23:59:24 -0400
commit5d45ba1a05bccc53d52422e867f378a0adeb8970 (patch)
treeff43de0198513d8752ec0eb16e527eb1447fd757
parente06b547e9369cb7c9c77b81041003bb120170929 (diff)
downloademacs-5d45ba1a05bccc53d52422e867f378a0adeb8970.tar.gz
emacs-5d45ba1a05bccc53d52422e867f378a0adeb8970.zip
Replace with dolist some uses of while
* lisp/calc/calc-units.el (calc-permanent-units): (math-compare-unit-names, math-simplify-units-quotient): (math-build-units-table-buffer): Use dolist to replace extra bindings and some while loops.
-rw-r--r--lisp/calc/calc-units.el72
1 files changed, 30 insertions, 42 deletions
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 0e3715eb4cf..a8074eaeb20 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -825,21 +825,18 @@ If COMP or STD is non-nil, put that in the units table instead."
825 (forward-char -1)) 825 (forward-char -1))
826 (insert ";;; Custom units stored by Calc on " (current-time-string) "\n") 826 (insert ";;; Custom units stored by Calc on " (current-time-string) "\n")
827 (if math-additional-units 827 (if math-additional-units
828 (progn 828 (let (expr)
829 (insert "(setq math-additional-units '(\n") 829 (insert "(setq math-additional-units '(\n")
830 (let ((list math-additional-units)) 830 (dolist (u math-additional-units)
831 (while list 831 (insert " (" (symbol-name (car u)) " "
832 (insert " (" (symbol-name (car (car list))) " " 832 (if (setq expr (nth 1 u))
833 (if (nth 1 (car list)) 833 (if (stringp expr)
834 (if (stringp (nth 1 (car list))) 834 (prin1-to-string expr)
835 (prin1-to-string (nth 1 (car list))) 835 (prin1-to-string (math-format-flat-expr expr 0)))
836 (prin1-to-string (math-format-flat-expr 836 "nil")
837 (nth 1 (car list)) 0))) 837 " "
838 "nil") 838 (prin1-to-string (nth 2 u))
839 " " 839 ")\n"))
840 (prin1-to-string (nth 2 (car list)))
841 ")\n")
842 (setq list (cdr list))))
843 (insert "))\n")) 840 (insert "))\n"))
844 (insert ";;; (no custom units defined)\n")) 841 (insert ";;; (no custom units defined)\n"))
845 (insert ";;; End of custom units\n") 842 (insert ";;; End of custom units\n")
@@ -916,15 +913,13 @@ If COMP or STD is non-nil, put that in the units table instead."
916(defun math-find-base-units-rec (expr pow) 913(defun math-find-base-units-rec (expr pow)
917 (let ((u (math-check-unit-name expr))) 914 (let ((u (math-check-unit-name expr)))
918 (cond (u 915 (cond (u
919 (let ((ulist (math-find-base-units u))) 916 (dolist (x (math-find-base-units u))
920 (while ulist 917 (let ((p (* (cdr x) pow))
921 (let ((p (* (cdr (car ulist)) pow)) 918 (old (assq (car x) math-fbu-base)))
922 (old (assq (car (car ulist)) math-fbu-base))) 919 (if old
923 (if old 920 (setcdr old (+ (cdr old) p))
924 (setcdr old (+ (cdr old) p)) 921 (setq math-fbu-base
925 (setq math-fbu-base 922 (cons (cons (car x) p) math-fbu-base))))))
926 (cons (cons (car (car ulist)) p) math-fbu-base))))
927 (setq ulist (cdr ulist)))))
928 ((math-scalarp expr)) 923 ((math-scalarp expr))
929 ((and (eq (car expr) '^) 924 ((and (eq (car expr) '^)
930 (integerp (nth 2 expr))) 925 (integerp (nth 2 expr)))
@@ -1377,20 +1372,15 @@ If COMP or STD is non-nil, put that in the units table instead."
1377 (if (eq pow1 1) 1372 (if (eq pow1 1)
1378 (math-to-standard-units (list '/ n d) nil) 1373 (math-to-standard-units (list '/ n d) nil)
1379 (list '^ (math-to-standard-units (list '/ n d) nil) pow1)) 1374 (list '^ (math-to-standard-units (list '/ n d) nil) pow1))
1380 (let (ud1) 1375 (setq un (nth 4 un)
1381 (setq un (nth 4 un) 1376 ud (nth 4 ud))
1382 ud (nth 4 ud)) 1377 (dolist (x un)
1383 (while un 1378 (dolist (y ud)
1384 (setq ud1 ud) 1379 (when (eq (car x) (car y))
1385 (while ud1 1380 (setq math-try-cancel-units
1386 (and (eq (car (car un)) (car (car ud1))) 1381 (+ math-try-cancel-units
1387 (setq math-try-cancel-units 1382 (- (* (cdr x) pow1)
1388 (+ math-try-cancel-units 1383 (* (cdr (car ud)) pow2))))))))))))
1389 (- (* (cdr (car un)) pow1)
1390 (* (cdr (car ud)) pow2)))))
1391 (setq ud1 (cdr ud1)))
1392 (setq un (cdr un)))
1393 nil))))))
1394 1384
1395(math-defsimplify ^ 1385(math-defsimplify ^
1396 (and math-simplifying-units 1386 (and math-simplifying-units
@@ -1578,9 +1568,8 @@ If COMP or STD is non-nil, put that in the units table instead."
1578 (insert "Calculator Units Table:\n\n") 1568 (insert "Calculator Units Table:\n\n")
1579 (insert "(All definitions are exact unless marked with an asterisk (*).)\n\n") 1569 (insert "(All definitions are exact unless marked with an asterisk (*).)\n\n")
1580 (insert "Unit Type Definition Description\n\n") 1570 (insert "Unit Type Definition Description\n\n")
1581 (while uptr 1571 (dolist (u uptr)
1582 (setq u (car uptr) 1572 (setq name (nth 2 u))
1583 name (nth 2 u))
1584 (when (eq (car u) 'm) 1573 (when (eq (car u) 'm)
1585 (setq std t)) 1574 (setq std t))
1586 (setq shadowed (and std (assq (car u) math-additional-units))) 1575 (setq shadowed (and std (assq (car u) math-additional-units)))
@@ -1618,8 +1607,7 @@ If COMP or STD is non-nil, put that in the units table instead."
1618 (insert " (redefined above)") 1607 (insert " (redefined above)")
1619 (unless (nth 1 u) 1608 (unless (nth 1 u)
1620 (insert " (base unit)"))) 1609 (insert " (base unit)")))
1621 (insert "\n") 1610 (insert "\n"))
1622 (setq uptr (cdr uptr)))
1623 (insert "\n\nUnit Prefix Table:\n\n") 1611 (insert "\n\nUnit Prefix Table:\n\n")
1624 (setq uptr math-unit-prefixes) 1612 (setq uptr math-unit-prefixes)
1625 (while uptr 1613 (while uptr