Changeset 3551 for vendor/emacs-21.3.50/lisp/calc/calc-units.el
- Timestamp:
- 11/18/04 08:05:19 (4 years ago)
- Files:
-
- vendor/emacs-21.3.50/lisp/calc/calc-units.el (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
vendor/emacs-21.3.50/lisp/calc/calc-units.el
r3533 r3551 4 4 5 5 ;; Author: David Gillespie <daveg@synaptics.com> 6 ;; Maintainers: D. Goel <deego@gnufans.org> 7 ;; Colin Walters <walters@debian.org> 6 ;; Maintainer: Jay Belanger <belanger@truman.edu> 8 7 9 8 ;; This file is part of GNU Emacs. … … 941 940 (defalias 'calcFunc-usimplify 'math-simplify-units) 942 941 942 ;; The function created by math-defsimplify uses the variable 943 ;; math-simplify-expr, and so is used by functions in math-defsimplify 944 (defvar math-simplify-expr) 945 943 946 (math-defsimplify (+ -) 944 947 (and math-simplifying-units 945 (math-units-in-expr-p (nth 1 expr) nil)946 (let* ((units (math-extract-units (nth 1 expr)))948 (math-units-in-expr-p (nth 1 math-simplify-expr) nil) 949 (let* ((units (math-extract-units (nth 1 math-simplify-expr))) 947 950 (ratio (math-simplify (math-to-standard-units 948 (list '/ (nth 2 expr) units) nil))))951 (list '/ (nth 2 math-simplify-expr) units) nil)))) 949 952 (if (math-units-in-expr-p ratio nil) 950 953 (progn 951 (calc-record-why "*Inconsistent units" expr) 952 expr) 953 (list '* (math-add (math-remove-units (nth 1 expr)) 954 (if (eq (car expr) '-) (math-neg ratio) ratio)) 954 (calc-record-why "*Inconsistent units" math-simplify-expr) 955 math-simplify-expr) 956 (list '* (math-add (math-remove-units (nth 1 math-simplify-expr)) 957 (if (eq (car math-simplify-expr) '-) 958 (math-neg ratio) ratio)) 955 959 units))))) 956 960 … … 961 965 (and math-simplifying-units 962 966 calc-autorange-units 963 (Math-realp (nth 1 expr))964 (let* ((num (math-float (nth 1 expr)))967 (Math-realp (nth 1 math-simplify-expr)) 968 (let* ((num (math-float (nth 1 math-simplify-expr))) 965 969 (xpon (calcFunc-xpon num)) 966 (unitp (cdr (cdr expr)))970 (unitp (cdr (cdr math-simplify-expr))) 967 971 (unit (car unitp)) 968 (pow (if (eq (car expr) '*) 1 -1))972 (pow (if (eq (car math-simplify-expr) '*) 1 -1)) 969 973 u) 970 974 (and (eq (car-safe unit) '*) … … 1016 1020 (< xpon (+ pxpon (* (math-abs pow) 3)))) 1017 1021 (progn 1018 (setcar (cdr expr)1022 (setcar (cdr math-simplify-expr) 1019 1023 (let ((calc-prefer-frac nil)) 1020 (calcFunc-scf (nth 1 expr)1024 (calcFunc-scf (nth 1 math-simplify-expr) 1021 1025 (- uxpon pxpon)))) 1022 1026 (setcar unitp pname) 1023 expr)))))))1027 math-simplify-expr))))))) 1024 1028 1025 1029 (math-defsimplify / 1026 1030 (and math-simplifying-units 1027 (let ((np (cdr expr))1031 (let ((np (cdr math-simplify-expr)) 1028 1032 (try-cancel-units 0) 1029 1033 n nn) 1030 (setq n (if (eq (car-safe (nth 2 expr)) '*)1031 (cdr (nth 2 expr))1032 (nthcdr 2 expr)))1034 (setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*) 1035 (cdr (nth 2 math-simplify-expr)) 1036 (nthcdr 2 math-simplify-expr))) 1033 1037 (if (math-realp (car n)) 1034 1038 (progn 1035 (setcar (cdr expr) (math-mul (nth 1expr)1039 (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) 1036 1040 (let ((calc-prefer-frac nil)) 1037 1041 (math-div 1 (car n))))) 1038 1042 (setcar n 1))) 1039 1043 (while (eq (car-safe (setq n (car np))) '*) 1040 (math-simplify-units-divisor (cdr n) (cdr (cdr expr)))1044 (math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr))) 1041 1045 (setq np (cdr (cdr n)))) 1042 (math-simplify-units-divisor np (cdr (cdr expr)))1046 (math-simplify-units-divisor np (cdr (cdr math-simplify-expr))) 1043 1047 (if (eq try-cancel-units 0) 1044 1048 (let* ((math-simplifying-units nil) 1045 (base (math-simplify (math-to-standard-units expr nil)))) 1049 (base (math-simplify 1050 (math-to-standard-units math-simplify-expr nil)))) 1046 1051 (if (Math-numberp base) 1047 (setq expr base))))1048 (if (eq (car-safe expr) '/)1052 (setq math-simplify-expr base)))) 1053 (if (eq (car-safe math-simplify-expr) '/) 1049 1054 (math-simplify-units-prod)) 1050 expr)))1055 math-simplify-expr))) 1051 1056 1052 1057 (defun math-simplify-units-divisor (np dp) … … 1095 1100 (math-defsimplify ^ 1096 1101 (and math-simplifying-units 1097 (math-realp (nth 2 expr)) 1098 (if (memq (car-safe (nth 1 expr)) '(* /)) 1099 (list (car (nth 1 expr)) 1100 (list '^ (nth 1 (nth 1 expr)) (nth 2 expr)) 1101 (list '^ (nth 2 (nth 1 expr)) (nth 2 expr))) 1102 (math-simplify-units-pow (nth 1 expr) (nth 2 expr))))) 1102 (math-realp (nth 2 math-simplify-expr)) 1103 (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) 1104 (list (car (nth 1 math-simplify-expr)) 1105 (list '^ (nth 1 (nth 1 math-simplify-expr)) 1106 (nth 2 math-simplify-expr)) 1107 (list '^ (nth 2 (nth 1 math-simplify-expr)) 1108 (nth 2 math-simplify-expr))) 1109 (math-simplify-units-pow (nth 1 math-simplify-expr) 1110 (nth 2 math-simplify-expr))))) 1103 1111 1104 1112 (math-defsimplify calcFunc-sqrt 1105 1113 (and math-simplifying-units 1106 (if (memq (car-safe (nth 1 expr)) '(* /))1107 (list (car (nth 1 expr))1108 (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))1109 (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))1110 (math-simplify-units-pow (nth 1 expr) '(frac 1 2)))))1114 (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) 1115 (list (car (nth 1 math-simplify-expr)) 1116 (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr))) 1117 (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr)))) 1118 (math-simplify-units-pow (nth 1 math-simplify-expr) '(frac 1 2))))) 1111 1119 1112 1120 (math-defsimplify (calcFunc-floor … … 1121 1129 calcFunc-clean) 1122 1130 (and math-simplifying-units 1123 (= (length expr) 2)1124 (if (math-only-units-in-expr-p (nth 1 expr))1125 (nth 1 expr)1126 (if (and (memq (car-safe (nth 1 expr)) '(* /))1131 (= (length math-simplify-expr) 2) 1132 (if (math-only-units-in-expr-p (nth 1 math-simplify-expr)) 1133 (nth 1 math-simplify-expr) 1134 (if (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) 1127 1135 (or (math-only-units-in-expr-p 1128 (nth 1 (nth 1 expr)))1136 (nth 1 (nth 1 math-simplify-expr))) 1129 1137 (math-only-units-in-expr-p 1130 (nth 2 (nth 1 expr)))))1131 (list (car (nth 1 expr))1132 (cons (car expr)1133 (cons (nth 1 (nth 1 expr))1134 (cdr (cdr expr))))1135 (cons (car expr)1136 (cons (nth 2 (nth 1 expr))1137 (cdr (cdr expr)))))))))1138 (nth 2 (nth 1 math-simplify-expr))))) 1139 (list (car (nth 1 math-simplify-expr)) 1140 (cons (car math-simplify-expr) 1141 (cons (nth 1 (nth 1 math-simplify-expr)) 1142 (cdr (cdr math-simplify-expr)))) 1143 (cons (car math-simplify-expr) 1144 (cons (nth 2 (nth 1 math-simplify-expr)) 1145 (cdr (cdr math-simplify-expr))))))))) 1138 1146 1139 1147 (defun math-simplify-units-pow (a pow) … … 1158 1166 (math-defsimplify calcFunc-sin 1159 1167 (and math-simplifying-units 1160 (math-units-in-expr-p (nth 1 expr) nil)1168 (math-units-in-expr-p (nth 1 math-simplify-expr) nil) 1161 1169 (let ((rad (math-simplify-units 1162 1170 (math-evaluate-expr 1163 (math-to-standard-units (nth 1 expr) nil))))1171 (math-to-standard-units (nth 1 math-simplify-expr) nil)))) 1164 1172 (calc-angle-mode 'rad)) 1165 1173 (and (eq (car-safe rad) '*) … … 1171 1179 (math-defsimplify calcFunc-cos 1172 1180 (and math-simplifying-units 1173 (math-units-in-expr-p (nth 1 expr) nil)1181 (math-units-in-expr-p (nth 1 math-simplify-expr) nil) 1174 1182 (let ((rad (math-simplify-units 1175 1183 (math-evaluate-expr 1176 (math-to-standard-units (nth 1 expr) nil))))1184 (math-to-standard-units (nth 1 math-simplify-expr) nil)))) 1177 1185 (calc-angle-mode 'rad)) 1178 1186 (and (eq (car-safe rad) '*) … … 1184 1192 (math-defsimplify calcFunc-tan 1185 1193 (and math-simplifying-units 1186 (math-units-in-expr-p (nth 1 expr) nil)1194 (math-units-in-expr-p (nth 1 math-simplify-expr) nil) 1187 1195 (let ((rad (math-simplify-units 1188 1196 (math-evaluate-expr 1189 (math-to-standard-units (nth 1 expr) nil))))1197 (math-to-standard-units (nth 1 math-simplify-expr) nil)))) 1190 1198 (calc-angle-mode 'rad)) 1191 1199 (and (eq (car-safe rad) '*)
