1 ;;; calc-lang.el --- calc language functions
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Colin Walters <walters@debian.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
12 ;; accepts responsibility to anyone for the consequences of using it
13 ;; or for whether it serves any particular purpose or works at all,
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
15 ;; License for full details.
17 ;; Everyone is granted permission to copy, modify and redistribute
18 ;; GNU Emacs, but only under the conditions described in the
19 ;; GNU Emacs General Public License. A copy of this license is
20 ;; supposed to have been given to you along with GNU Emacs so you
21 ;; can know your rights and responsibilities. It should be in a
22 ;; file named COPYING. Among other things, the copyright notice
23 ;; and this notice must be preserved on all copies.
30 ;; This file is autoloaded from calc-ext.el.
35 (defun calc-Need-calc-lang () nil
)
38 ;;; Alternate entry/display languages.
40 (defun calc-set-language (lang &optional option no-refresh
)
41 (setq math-expr-opers
(or (get lang
'math-oper-table
) math-standard-opers
)
42 math-expr-function-mapping
(get lang
'math-function-table
)
43 math-expr-variable-mapping
(get lang
'math-variable-table
)
44 calc-language-input-filter
(get lang
'math-input-filter
)
45 calc-language-output-filter
(get lang
'math-output-filter
)
46 calc-vector-brackets
(or (get lang
'math-vector-brackets
) "[]")
47 calc-complex-format
(get lang
'math-complex-format
)
48 calc-radix-formatter
(get lang
'math-radix-formatter
)
49 calc-function-open
(or (get lang
'math-function-open
) "(")
50 calc-function-close
(or (get lang
'math-function-close
) ")"))
52 (setq calc-language lang
53 calc-language-option option
)
54 (calc-change-mode '(calc-language calc-language-option
)
55 (list lang option
) t
)))
57 (defun calc-normal-language ()
60 (calc-set-language nil
)
61 (message "Normal language mode")))
63 (defun calc-flat-language ()
66 (calc-set-language 'flat
)
67 (message "Flat language mode (all stack entries shown on one line)")))
69 (defun calc-big-language ()
72 (calc-set-language 'big
)
73 (message "\"Big\" language mode")))
75 (defun calc-unformatted-language ()
78 (calc-set-language 'unform
)
79 (message "Unformatted language mode")))
82 (defun calc-c-language ()
85 (calc-set-language 'c
)
86 (message "`C' language mode")))
88 (put 'c
'math-oper-table
89 '( ( "u+" ident -
1 1000 )
91 ( "u!" calcFunc-lnot -
1 1000 )
92 ( "~" calcFunc-not -
1 1000 )
98 ( "<<" calcFunc-lsh
170 171 )
99 ( ">>" calcFunc-rsh
170 171 )
100 ( "<" calcFunc-lt
160 161 )
101 ( ">" calcFunc-gt
160 161 )
102 ( "<=" calcFunc-leq
160 161 )
103 ( ">=" calcFunc-geq
160 161 )
104 ( "==" calcFunc-eq
150 151 )
105 ( "!=" calcFunc-neq
150 151 )
106 ( "&" calcFunc-and
140 141 )
107 ( "^" calcFunc-xor
131 130 )
108 ( "|" calcFunc-or
120 121 )
109 ( "&&" calcFunc-land
110 111 )
110 ( "||" calcFunc-lor
100 101 )
111 ( "?" (math-read-if) 91 90 )
112 ( "!!!" calcFunc-pnot -
1 88 )
113 ( "&&&" calcFunc-pand
85 86 )
114 ( "|||" calcFunc-por
75 76 )
115 ( "=" calcFunc-assign
51 50 )
116 ( ":=" calcFunc-assign
51 50 )
117 ( "::" calcFunc-condition
45 46 ))) ; should support full assignments
119 (put 'c
'math-function-table
120 '( ( acos . calcFunc-arccos
)
121 ( acosh . calcFunc-arccosh
)
122 ( asin . calcFunc-arcsin
)
123 ( asinh . calcFunc-arcsinh
)
124 ( atan . calcFunc-arctan
)
125 ( atan2 . calcFunc-arctan2
)
126 ( atanh . calcFunc-arctanh
)))
128 (put 'c
'math-variable-table
132 (put 'c
'math-vector-brackets
"{}")
134 (put 'c
'math-radix-formatter
135 (function (lambda (r s
)
136 (if (= r
16) (format "0x%s" s
)
137 (if (= r
8) (format "0%s" s
)
138 (format "%d#%s" r s
))))))
141 (defun calc-pascal-language (n)
144 (and n
(setq n
(prefix-numeric-value n
)))
145 (calc-set-language 'pascal n
)
146 (message (if (and n
(/= n
0))
148 "Pascal language mode (all uppercase)"
149 "Pascal language mode (all lowercase)")
150 "Pascal language mode"))))
152 (put 'pascal
'math-oper-table
153 '( ( "not" calcFunc-lnot -
1 1000 )
156 ( "and" calcFunc-and
190 191 )
157 ( "div" calcFunc-idiv
190 191 )
159 ( "u+" ident -
1 185 )
163 ( "or" calcFunc-or
180 181 )
164 ( "xor" calcFunc-xor
180 181 )
165 ( "shl" calcFunc-lsh
180 181 )
166 ( "shr" calcFunc-rsh
180 181 )
167 ( "in" calcFunc-in
160 161 )
168 ( "<" calcFunc-lt
160 161 )
169 ( ">" calcFunc-gt
160 161 )
170 ( "<=" calcFunc-leq
160 161 )
171 ( ">=" calcFunc-geq
160 161 )
172 ( "=" calcFunc-eq
160 161 )
173 ( "<>" calcFunc-neq
160 161 )
174 ( "!!!" calcFunc-pnot -
1 85 )
175 ( "&&&" calcFunc-pand
80 81 )
176 ( "|||" calcFunc-por
75 76 )
177 ( ":=" calcFunc-assign
51 50 )
178 ( "::" calcFunc-condition
45 46 )))
180 (put 'pascal
'math-input-filter
'calc-input-case-filter
)
181 (put 'pascal
'math-output-filter
'calc-output-case-filter
)
183 (put 'pascal
'math-radix-formatter
184 (function (lambda (r s
)
185 (if (= r
16) (format "$%s" s
)
186 (format "%d#%s" r s
)))))
188 (defun calc-input-case-filter (str)
189 (cond ((or (null calc-language-option
) (= calc-language-option
0))
194 (defun calc-output-case-filter (str)
195 (cond ((or (null calc-language-option
) (= calc-language-option
0))
197 ((> calc-language-option
0)
203 (defun calc-fortran-language (n)
206 (and n
(setq n
(prefix-numeric-value n
)))
207 (calc-set-language 'fortran n
)
208 (message (if (and n
(/= n
0))
210 "FORTRAN language mode (all uppercase)"
211 "FORTRAN language mode (all lowercase)")
212 "FORTRAN language mode"))))
214 (put 'fortran
'math-oper-table
215 '( ( "u/" (math-parse-fortran-vector) -
1 1 )
216 ( "/" (math-parse-fortran-vector-end) 1 -
1 )
218 ( "u+" ident -
1 191 )
224 ( ".LT." calcFunc-lt
160 161 )
225 ( ".GT." calcFunc-gt
160 161 )
226 ( ".LE." calcFunc-leq
160 161 )
227 ( ".GE." calcFunc-geq
160 161 )
228 ( ".EQ." calcFunc-eq
160 161 )
229 ( ".NE." calcFunc-neq
160 161 )
230 ( ".NOT." calcFunc-lnot -
1 121 )
231 ( ".AND." calcFunc-land
110 111 )
232 ( ".OR." calcFunc-lor
100 101 )
233 ( "!!!" calcFunc-pnot -
1 85 )
234 ( "&&&" calcFunc-pand
80 81 )
235 ( "|||" calcFunc-por
75 76 )
236 ( "=" calcFunc-assign
51 50 )
237 ( ":=" calcFunc-assign
51 50 )
238 ( "::" calcFunc-condition
45 46 )))
240 (put 'fortran
'math-vector-brackets
"//")
242 (put 'fortran
'math-function-table
243 '( ( acos . calcFunc-arccos
)
244 ( acosh . calcFunc-arccosh
)
245 ( aimag . calcFunc-im
)
246 ( aint . calcFunc-ftrunc
)
247 ( asin . calcFunc-arcsin
)
248 ( asinh . calcFunc-arcsinh
)
249 ( atan . calcFunc-arctan
)
250 ( atan2 . calcFunc-arctan2
)
251 ( atanh . calcFunc-arctanh
)
252 ( conjg . calcFunc-conj
)
253 ( log . calcFunc-ln
)
254 ( nint . calcFunc-round
)
255 ( real . calcFunc-re
)))
257 (put 'fortran
'math-input-filter
'calc-input-case-filter
)
258 (put 'fortran
'math-output-filter
'calc-output-case-filter
)
260 (defvar math-parsing-fortran-vector nil
)
261 (defun math-parse-fortran-vector (op)
262 (let ((math-parsing-fortran-vector '(end .
"\000")))
264 (math-read-brackets t
"]")
265 (setq exp-token
(car math-parsing-fortran-vector
)
266 exp-data
(cdr math-parsing-fortran-vector
)))))
268 (defun math-parse-fortran-vector-end (x op
)
269 (if math-parsing-fortran-vector
271 (setq math-parsing-fortran-vector
(cons exp-token exp-data
)
275 (throw 'syntax
"Unmatched closing `/'")))
277 (defun math-parse-fortran-subscr (sym args
)
278 (setq sym
(math-build-var-name sym
))
280 (setq sym
(list 'calcFunc-subscr sym
(car args
))
285 (defun calc-tex-language (n)
288 (and n
(setq n
(prefix-numeric-value n
)))
289 (calc-set-language 'tex n
)
290 (message (if (and n
(/= n
0))
292 "TeX language mode with \\hbox{func}(\\hbox{var})"
293 "TeX language mode with \\func{\\hbox{var}}")
294 "TeX language mode"))))
296 (put 'tex
'math-oper-table
297 '( ( "u+" ident -
1 1000 )
299 ( "\\hat" calcFunc-hat -
1 950 )
300 ( "\\check" calcFunc-check -
1 950 )
301 ( "\\tilde" calcFunc-tilde -
1 950 )
302 ( "\\acute" calcFunc-acute -
1 950 )
303 ( "\\grave" calcFunc-grave -
1 950 )
304 ( "\\dot" calcFunc-dot -
1 950 )
305 ( "\\ddot" calcFunc-dotdot -
1 950 )
306 ( "\\breve" calcFunc-breve -
1 950 )
307 ( "\\bar" calcFunc-bar -
1 950 )
308 ( "\\vec" calcFunc-Vec -
1 950 )
309 ( "\\underline" calcFunc-under -
1 950 )
310 ( "u|" calcFunc-abs -
1 0 )
312 ( "\\lfloor" calcFunc-floor -
1 0 )
313 ( "\\rfloor" closing
0 -
1 )
314 ( "\\lceil" calcFunc-ceil -
1 0 )
315 ( "\\rceil" closing
0 -
1 )
316 ( "\\pm" sdev
300 300 )
317 ( "!" calcFunc-fact
210 -
1 )
319 ( "_" calcFunc-subscr
201 200 )
320 ( "\\times" * 191 190 )
325 ( "\\over" / 170 171 )
327 ( "\\choose" calcFunc-choose
170 171 )
328 ( "\\mod" %
170 171 )
329 ( "<" calcFunc-lt
160 161 )
330 ( ">" calcFunc-gt
160 161 )
331 ( "\\leq" calcFunc-leq
160 161 )
332 ( "\\geq" calcFunc-geq
160 161 )
333 ( "=" calcFunc-eq
160 161 )
334 ( "\\neq" calcFunc-neq
160 161 )
335 ( "\\ne" calcFunc-neq
160 161 )
336 ( "\\lnot" calcFunc-lnot -
1 121 )
337 ( "\\land" calcFunc-land
110 111 )
338 ( "\\lor" calcFunc-lor
100 101 )
339 ( "?" (math-read-if) 91 90 )
340 ( "!!!" calcFunc-pnot -
1 85 )
341 ( "&&&" calcFunc-pand
80 81 )
342 ( "|||" calcFunc-por
75 76 )
343 ( "\\gets" calcFunc-assign
51 50 )
344 ( ":=" calcFunc-assign
51 50 )
345 ( "::" calcFunc-condition
45 46 )
346 ( "\\to" calcFunc-evalto
40 41 )
347 ( "\\to" calcFunc-evalto
40 -
1 )
348 ( "=>" calcFunc-evalto
40 41 )
349 ( "=>" calcFunc-evalto
40 -
1 )))
351 (put 'tex
'math-function-table
352 '( ( \\arccos . calcFunc-arccos
)
353 ( \\arcsin . calcFunc-arcsin
)
354 ( \\arctan . calcFunc-arctan
)
355 ( \\arg . calcFunc-arg
)
356 ( \\cos . calcFunc-cos
)
357 ( \\cosh . calcFunc-cosh
)
358 ( \\det . calcFunc-det
)
359 ( \\exp . calcFunc-exp
)
360 ( \\gcd . calcFunc-gcd
)
361 ( \\ln . calcFunc-ln
)
362 ( \\log . calcFunc-log10
)
363 ( \\max . calcFunc-max
)
364 ( \\min . calcFunc-min
)
365 ( \\tan . calcFunc-tan
)
366 ( \\sin . calcFunc-sin
)
367 ( \\sinh . calcFunc-sinh
)
368 ( \\sqrt . calcFunc-sqrt
)
369 ( \\tanh . calcFunc-tanh
)
370 ( \\phi . calcFunc-totient
)
371 ( \\mu . calcFunc-moebius
)))
373 (put 'tex
'math-variable-table
375 ( \\infty . var-inf
)
376 ( \\infty . var-uinf
)
378 ( \\gamma . var-gamma
)
379 ( \\sum .
(math-parse-tex-sum calcFunc-sum
) )
380 ( \\prod .
(math-parse-tex-sum calcFunc-prod
) )))
382 (put 'tex
'math-complex-format
'i
)
384 (defun math-parse-tex-sum (f val
)
386 (or (equal exp-data
"_") (throw 'syntax
"Expected `_'"))
388 (setq save exp-old-pos
)
389 (setq low
(math-read-factor))
390 (or (eq (car-safe low
) 'calcFunc-eq
)
392 (setq exp-old-pos
(1+ save
))
393 (throw 'syntax
"Expected equation")))
394 (or (equal exp-data
"^") (throw 'syntax
"Expected `^'"))
396 (setq high
(math-read-factor))
397 (list (nth 2 f
) (math-read-factor) (nth 1 low
) (nth 2 low
) high
)))
399 (defun math-tex-input-filter (str) ; allow parsing of 123\,456\,789.
400 (while (string-match "[0-9]\\\\,[0-9]" str
)
401 (setq str
(concat (substring str
0 (1+ (match-beginning 0)))
402 (substring str
(1- (match-end 0))))))
404 (put 'tex
'math-input-filter
'math-tex-input-filter
)
407 (defun calc-eqn-language (n)
410 (calc-set-language 'eqn
)
411 (message "Eqn language mode")))
413 (put 'eqn
'math-oper-table
414 '( ( "u+" ident -
1 1000 )
416 ( "prime" (math-parse-eqn-prime) 950 -
1 )
417 ( "prime" calcFunc-Prime
950 -
1 )
418 ( "dot" calcFunc-dot
950 -
1 )
419 ( "dotdot" calcFunc-dotdot
950 -
1 )
420 ( "hat" calcFunc-hat
950 -
1 )
421 ( "tilde" calcFunc-tilde
950 -
1 )
422 ( "vec" calcFunc-Vec
950 -
1 )
423 ( "dyad" calcFunc-dyad
950 -
1 )
424 ( "bar" calcFunc-bar
950 -
1 )
425 ( "under" calcFunc-under
950 -
1 )
426 ( "sub" calcFunc-subscr
931 930 )
428 ( "sqrt" calcFunc-sqrt -
1 910 )
430 ( "u|" calcFunc-abs -
1 0 )
432 ( "left floor" calcFunc-floor -
1 0 )
433 ( "right floor" closing
0 -
1 )
434 ( "left ceil" calcFunc-ceil -
1 0 )
435 ( "right ceil" closing
0 -
1 )
436 ( "+-" sdev
300 300 )
437 ( "!" calcFunc-fact
210 -
1 )
438 ( "times" * 191 190 )
445 ( "<" calcFunc-lt
160 161 )
446 ( ">" calcFunc-gt
160 161 )
447 ( "<=" calcFunc-leq
160 161 )
448 ( ">=" calcFunc-geq
160 161 )
449 ( "=" calcFunc-eq
160 161 )
450 ( "==" calcFunc-eq
160 161 )
451 ( "!=" calcFunc-neq
160 161 )
452 ( "u!" calcFunc-lnot -
1 121 )
453 ( "&&" calcFunc-land
110 111 )
454 ( "||" calcFunc-lor
100 101 )
455 ( "?" (math-read-if) 91 90 )
456 ( "!!!" calcFunc-pnot -
1 85 )
457 ( "&&&" calcFunc-pand
80 81 )
458 ( "|||" calcFunc-por
75 76 )
459 ( "<-" calcFunc-assign
51 50 )
460 ( ":=" calcFunc-assign
51 50 )
461 ( "::" calcFunc-condition
45 46 )
462 ( "->" calcFunc-evalto
40 41 )
463 ( "->" calcFunc-evalto
40 -
1 )
464 ( "=>" calcFunc-evalto
40 41 )
465 ( "=>" calcFunc-evalto
40 -
1 )))
467 (put 'eqn
'math-function-table
468 '( ( arc\ cos . calcFunc-arccos
)
469 ( arc\ cosh . calcFunc-arccosh
)
470 ( arc\ sin . calcFunc-arcsin
)
471 ( arc\ sinh . calcFunc-arcsinh
)
472 ( arc\ tan . calcFunc-arctan
)
473 ( arc\ tanh . calcFunc-arctanh
)
474 ( GAMMA . calcFunc-gamma
)
475 ( phi . calcFunc-totient
)
476 ( mu . calcFunc-moebius
)
477 ( matrix .
(math-parse-eqn-matrix) )))
479 (put 'eqn
'math-variable-table
480 '( ( inf . var-uinf
)))
482 (put 'eqn
'math-complex-format
'i
)
484 (defun math-parse-eqn-matrix (f sym
)
486 (while (assoc exp-data
'(("ccol") ("lcol") ("rcol")))
488 (or (equal exp-data calc-function-open
)
489 (throw 'syntax
"Expected `{'"))
491 (setq vec
(cons (cons 'vec
(math-read-expr-list)) vec
))
492 (or (equal exp-data calc-function-close
)
493 (throw 'syntax
"Expected `}'"))
495 (or (equal exp-data calc-function-close
)
496 (throw 'syntax
"Expected `}'"))
498 (math-transpose (cons 'vec
(nreverse vec
)))))
500 (defun math-parse-eqn-prime (x sym
)
501 (if (eq (car-safe x
) 'var
)
502 (if (equal exp-data calc-function-open
)
505 (let ((args (if (or (equal exp-data calc-function-close
)
508 (math-read-expr-list))))
509 (if (not (or (equal exp-data calc-function-close
)
510 (eq exp-token
'end
)))
511 (throw 'syntax
"Expected `)'"))
513 (cons (intern (format "calcFunc-%s'" (nth 1 x
))) args
)))
515 (intern (concat (symbol-name (nth 1 x
)) "'"))
516 (intern (concat (symbol-name (nth 2 x
)) "'"))))
517 (list 'calcFunc-Prime x
)))
520 (defun calc-mathematica-language ()
523 (calc-set-language 'math
)
524 (message "Mathematica language mode")))
526 (put 'math
'math-oper-table
527 '( ( "[[" (math-read-math-subscr) 250 -
1 )
528 ( "!" calcFunc-fact
210 -
1 )
529 ( "!!" calcFunc-dfact
210 -
1 )
531 ( "u+" ident -
1 197 )
538 ( "<" calcFunc-lt
160 161 )
539 ( ">" calcFunc-gt
160 161 )
540 ( "<=" calcFunc-leq
160 161 )
541 ( ">=" calcFunc-geq
160 161 )
542 ( "==" calcFunc-eq
150 151 )
543 ( "!=" calcFunc-neq
150 151 )
544 ( "u!" calcFunc-lnot -
1 121 )
545 ( "&&" calcFunc-land
110 111 )
546 ( "||" calcFunc-lor
100 101 )
547 ( "!!!" calcFunc-pnot -
1 85 )
548 ( "&&&" calcFunc-pand
80 81 )
549 ( "|||" calcFunc-por
75 76 )
550 ( ":=" calcFunc-assign
51 50 )
551 ( "=" calcFunc-assign
51 50 )
552 ( "->" calcFunc-assign
51 50 )
553 ( ":>" calcFunc-assign
51 50 )
554 ( "::" calcFunc-condition
45 46 )
557 (put 'math
'math-function-table
558 '( ( Abs . calcFunc-abs
)
559 ( ArcCos . calcFunc-arccos
)
560 ( ArcCosh . calcFunc-arccosh
)
561 ( ArcSin . calcFunc-arcsin
)
562 ( ArcSinh . calcFunc-arcsinh
)
563 ( ArcTan . calcFunc-arctan
)
564 ( ArcTanh . calcFunc-arctanh
)
565 ( Arg . calcFunc-arg
)
566 ( Binomial . calcFunc-choose
)
567 ( Ceiling . calcFunc-ceil
)
568 ( Conjugate . calcFunc-conj
)
569 ( Cos . calcFunc-cos
)
570 ( Cosh . calcFunc-cosh
)
571 ( D . calcFunc-deriv
)
572 ( Dt . calcFunc-tderiv
)
573 ( Det . calcFunc-det
)
574 ( Exp . calcFunc-exp
)
575 ( EulerPhi . calcFunc-totient
)
576 ( Floor . calcFunc-floor
)
577 ( Gamma . calcFunc-gamma
)
578 ( GCD . calcFunc-gcd
)
581 ( Inverse . calcFunc-inv
)
582 ( Integrate . calcFunc-integ
)
583 ( Join . calcFunc-vconcat
)
584 ( LCM . calcFunc-lcm
)
585 ( Log . calcFunc-ln
)
586 ( Max . calcFunc-max
)
587 ( Min . calcFunc-min
)
588 ( Mod . calcFunc-mod
)
589 ( MoebiusMu . calcFunc-moebius
)
590 ( Random . calcFunc-random
)
591 ( Round . calcFunc-round
)
593 ( Sign . calcFunc-sign
)
594 ( Sin . calcFunc-sin
)
595 ( Sinh . calcFunc-sinh
)
596 ( Sqrt . calcFunc-sqrt
)
597 ( Tan . calcFunc-tan
)
598 ( Tanh . calcFunc-tanh
)
599 ( Transpose . calcFunc-trn
)
600 ( Length . calcFunc-vlen
)
603 (put 'math
'math-variable-table
607 ( GoldenRatio . var-phi
)
608 ( EulerGamma . var-gamma
)
609 ( Infinity . var-inf
)
610 ( ComplexInfinity . var-uinf
)
611 ( Indeterminate . var-nan
)
614 (put 'math
'math-vector-brackets
"{}")
615 (put 'math
'math-complex-format
'I
)
616 (put 'math
'math-function-open
"[")
617 (put 'math
'math-function-close
"]")
619 (put 'math
'math-radix-formatter
620 (function (lambda (r s
) (format "%d^^%s" r s
))))
622 (defun math-read-math-subscr (x op
)
623 (let ((idx (math-read-expr-level 0)))
624 (or (and (equal exp-data
"]")
627 (equal exp-data
"]")))
628 (throw 'syntax
"Expected ']]'"))
630 (list 'calcFunc-subscr x idx
)))
633 (defun calc-maple-language ()
636 (calc-set-language 'maple
)
637 (message "Maple language mode")))
639 (put 'maple
'math-oper-table
640 '( ( "matrix" ident -
1 300 )
641 ( "MATRIX" ident -
1 300 )
642 ( "!" calcFunc-fact
210 -
1 )
645 ( "u+" ident -
1 197 )
649 ( "intersect" calcFunc-vint
191 192 )
652 ( "union" calcFunc-vunion
180 181 )
653 ( "minus" calcFunc-vdiff
180 181 )
655 ( ".." (math-read-maple-dots) 165 165 )
656 ( "\\dots" (math-read-maple-dots) 165 165 )
657 ( "<" calcFunc-lt
160 160 )
658 ( ">" calcFunc-gt
160 160 )
659 ( "<=" calcFunc-leq
160 160 )
660 ( ">=" calcFunc-geq
160 160 )
661 ( "=" calcFunc-eq
160 160 )
662 ( "<>" calcFunc-neq
160 160 )
663 ( "not" calcFunc-lnot -
1 121 )
664 ( "and" calcFunc-land
110 111 )
665 ( "or" calcFunc-lor
100 101 )
666 ( "!!!" calcFunc-pnot -
1 85 )
667 ( "&&&" calcFunc-pand
80 81 )
668 ( "|||" calcFunc-por
75 76 )
669 ( ":=" calcFunc-assign
51 50 )
670 ( "::" calcFunc-condition
45 46 )
673 (put 'maple
'math-function-table
674 '( ( bernoulli . calcFunc-bern
)
675 ( binomial . calcFunc-choose
)
676 ( diff . calcFunc-deriv
)
677 ( GAMMA . calcFunc-gamma
)
678 ( ifactor . calcFunc-prfac
)
679 ( igcd . calcFunc-gcd
)
680 ( ilcm . calcFunc-lcm
)
681 ( int . calcFunc-integ
)
684 ( iquo . calcFunc-idiv
)
685 ( isprime . calcFunc-prime
)
686 ( length . calcFunc-vlen
)
687 ( member . calcFunc-in
)
688 ( crossprod . calcFunc-cross
)
689 ( inverse . calcFunc-inv
)
690 ( trace . calcFunc-tr
)
691 ( transpose . calcFunc-trn
)
692 ( vectdim . calcFunc-vlen
)
695 (put 'maple
'math-variable-table
699 ( infinity . var-inf
)
700 ( infinity . var-uinf
)
701 ( infinity . var-nan
)
704 (put 'maple
'math-complex-format
'I
)
706 (defun math-read-maple-dots (x op
)
707 (list 'intv
3 x
(math-read-expr-level (nth 3 op
))))
713 (defun math-read-big-rec (h1 v1 h2 v2
&optional baseline prec short
)
714 (or prec
(setq prec
0))
716 ;; Clip whitespace above or below.
717 (while (and (< v1 v2
) (math-read-big-emptyp h1 v1 h2
(1+ v1
)))
719 (while (and (< v1 v2
) (math-read-big-emptyp h1
(1- v2
) h2 v2
))
722 ;; If formula is a single line high, normal parser can handle it.
725 (> h1
(length (setq v2
(nth v1 lines
)))))
726 (math-read-big-error h1 v1
)
727 (setq the-baseline v1
730 h2
(math-read-expr (substring v2 h1
(min h2
(length v2
)))))
731 (if (eq (car-safe h2
) 'error
)
732 (math-read-big-error (+ h1
(nth 1 h2
)) v1
(nth 2 h2
))
735 ;; Clip whitespace at left or right.
736 (while (and (< h1 h2
) (math-read-big-emptyp h1 v1
(1+ h1
) v2
))
738 (while (and (< h1 h2
) (math-read-big-emptyp (1- h2
) v1 h2 v2
))
741 ;; Scan to find widest left-justified "----" in the region.
744 (lines-v1 (nthcdr v1 lines
))
748 other-char line len h
)
751 len
(min h2
(length line
)))
753 (/= (aref line h1
) ?\
)
754 (if (and (= (aref line h1
) ?\-
)
755 ;; Make sure it's not a minus sign.
756 (or (and (< (1+ h1
) len
) (= (aref line
(1+ h1
)) ?\-
))
757 (/= (math-read-big-char h1
(1- v
)) ?\
)
758 (/= (math-read-big-char h1
(1+ v
)) ?\
)))
761 (while (and (< (setq h
(1+ h
)) len
)
762 (= (aref line h
) ?\-
)))
766 (or other-v
(setq other-v v other-char
(aref line h1
)))))
770 (cond ((not (setq v other-v
))
771 (math-read-big-error h1 v1
)) ; Should never happen!
777 (let ((num (math-read-big-rec h1 v1 h v
))
778 (den (math-read-big-rec h1
(1+ v
) h v2
)))
779 (setq p
(if (and (math-integerp num
) (math-integerp den
))
780 (math-make-frac num den
)
781 (list '/ num den
)))))
785 (or (= (math-read-big-char (1+ h1
) v
) ?\|
)
786 (math-read-big-error (1+ h1
) v
"Malformed root sign"))
787 (math-read-big-emptyp h1 v1
(1+ h1
) v nil t
)
788 (while (= (math-read-big-char (1+ h1
) (setq v
(1- v
))) ?\|
))
789 (or (= (math-read-big-char (setq h
(+ h1
2)) v
) ?\_
)
790 (math-read-big-error h v
"Malformed root sign"))
791 (while (= (math-read-big-char (setq h
(1+ h
)) v
) ?\_
))
792 (math-read-big-emptyp h1 v1
(1+ h1
) v nil t
)
793 (math-read-big-emptyp h1
(1+ other-v
) h v2 nil t
)
794 (setq p
(list 'calcFunc-sqrt
(math-read-big-rec
796 h
(1+ other-v
) baseline
))
799 ;; Small radical sign.
800 ((and (= other-char ?V
)
801 (= (math-read-big-char (1+ h1
) (1- v
)) ?\_
))
803 (math-read-big-emptyp h1 v1 h
(1- v
) nil t
)
804 (math-read-big-emptyp h1
(1+ v
) h v2 nil t
)
805 (math-read-big-emptyp h1 v1
(1+ h1
) v nil t
)
806 (while (= (math-read-big-char (setq h
(1+ h
)) (1- v
)) ?\_
))
807 (setq p
(list 'calcFunc-sqrt
(math-read-big-rec
808 (1+ h1
) v h
(1+ v
) t
))
811 ;; Binomial coefficient.
812 ((and (= other-char ?\
()
813 (= (math-read-big-char (1+ h1
) v
) ?\
)
814 (= (string-match "( *)" (nth v lines
) h1
) h1
))
815 (setq h
(match-end 0))
816 (math-read-big-emptyp h1 v1
(1+ h1
) v nil t
)
817 (math-read-big-emptyp h1
(1+ v
) (1+ h1
) v2 nil t
)
818 (math-read-big-emptyp (1- h
) v1 h v nil t
)
819 (math-read-big-emptyp (1- h
) (1+ v
) h v2 nil t
)
820 (setq p
(list 'calcFunc-choose
821 (math-read-big-rec (1+ h1
) v1
(1- h
) v
)
822 (math-read-big-rec (1+ h1
) (1+ v
)
827 (setq p
(list 'neg
(math-read-big-rec (1+ h1
) v1 h2 v2 v
250 t
))
833 (math-read-big-emptyp h1 v1
(1+ h1
) v nil t
)
834 (math-read-big-emptyp h1
(1+ v
) (1+ h1
) v2 nil t
)
835 (setq h
(math-read-big-balance (1+ h1
) v
"(" t
))
836 (math-read-big-emptyp (1- h
) v1 h v nil t
)
837 (math-read-big-emptyp (1- h
) (1+ v
) h v2 nil t
)
838 (let ((sep (math-read-big-char (1- h
) v
))
843 (math-read-big-error (1- h
) v
"Expected `)'"))
845 (setq p
(math-read-big-rec (1+ h1
) v1
(1- h
) v2 v
))
846 (setq hmid
(math-read-big-balance h v
"(")
847 p
(list p
(math-read-big-rec h v1
(1- hmid
) v2 v
))
850 (setq p
(cons 'intv
(cons (if (= (math-read-big-char
855 ((= (math-read-big-char (1- h
) v
) ?\
])
856 (math-read-big-error (1- h
) v
"Expected `)'"))
858 (or (and (math-realp (car p
)) (math-realp (nth 1 p
)))
860 h1 v
"Complex components must be real"))
861 (setq p
(cons 'cplx p
)))
863 (or (and (math-realp (car p
)) (math-anglep (nth 1 p
)))
865 h1 v
"Complex components must be real"))
866 (setq p
(cons 'polar p
)))))))
869 ((and (= other-char ?\
[)
870 (or (= (math-read-big-char (setq h h1
) (1+ v
)) ?\
[)
871 (= (math-read-big-char (setq h
(1+ h
)) v
) ?\
[)
872 (and (= (math-read-big-char h v
) ?\
)
873 (= (math-read-big-char (setq h
(1+ h
)) v
) ?\
[)))
874 (= (math-read-big-char h
(1+ v
)) ?\
[))
875 (math-read-big-emptyp h1 v1 h v nil t
)
881 (setq h
(math-read-big-balance (1+ hleft
) v
"["))
884 (math-read-big-error hright v
"Expected `]'"))
886 (setq p
(cons (math-read-big-rec
887 hleft v h
(1+ v
)) p
))
888 (and (memq (math-read-big-char h v
) '(?\ ?\
,))
889 (= (math-read-big-char hleft
(1+ v
)) ?\
[)))
893 (if (= (math-read-big-char h v
) ?\
)
895 (and (= (math-read-big-char h v
) ?\
])
897 (math-read-big-error (1- h
) v
"Expected `]'"))
898 (if (= (math-read-big-char h vtop
) ?\
,)
900 (math-read-big-emptyp h1
(1+ v
) (1- h
) v2 nil t
)
901 (setq v
(+ vtop
(/ (- v vtop
) 2))
902 p
(cons 'vec
(nreverse p
)))))
906 (math-read-big-emptyp h1 v1
(1+ h1
) v nil t
)
907 (math-read-big-emptyp h1
(1+ v
) (1+ h1
) v2 nil t
)
911 (setq widest
(math-read-big-balance h v
"[" t
))
912 (math-read-big-emptyp (1- h
) v1 h v nil t
)
913 (math-read-big-emptyp (1- h
) (1+ v
) h v2 nil t
)
914 (setq p
(cons (math-read-big-rec
915 h v1
(1- widest
) v2 v
) p
)
917 (= (math-read-big-char (1- h
) v
) ?\
,)))
918 (setq widest
(math-read-big-char (1- h
) v
))
919 (if (or (memq widest
'(?\
; ?\)))
920 (and (eq widest ?\.
) (cdr p
)))
921 (math-read-big-error (1- h
) v
"Expected `]'"))
924 widest
(math-read-big-balance h v
"[")
925 p
(nconc p
(list (math-read-big-big-rec
926 h v1
(1- widest
) v2 v
)))
928 p
(cons 'intv
(cons (if (= (math-read-big-char (1- h
) v
)
932 (setq p
(cons 'vec
(nreverse p
)))))
936 (setq line
(nth v lines
))
937 (string-match ">" line h1
)
938 (setq h
(match-end 0))
939 (math-read-big-emptyp h1 v1 h v nil t
)
940 (math-read-big-emptyp h1
(1+ v
) h v2 nil t
)
941 (setq p
(math-read-big-rec h1 v h
(1+ v
) v
)))
943 ;; Variable name or function call.
944 ((or (and (>= other-char ?a
) (<= other-char ?z
))
945 (and (>= other-char ?A
) (<= other-char ?Z
)))
946 (setq line
(nth v lines
))
947 (string-match "\\([a-zA-Z'_]+\\) *" line h1
)
948 (setq h
(match-end 1)
950 p
(math-match-substring line
1))
951 (math-read-big-emptyp h1 v1 h v nil t
)
952 (math-read-big-emptyp h1
(1+ v
) h v2 nil t
)
953 (if (= (math-read-big-char widest v
) ?\
()
955 (setq line
(if (string-match "-" p
)
957 (intern (concat "calcFunc-" p
)))
960 (math-read-big-emptyp widest v1 h v nil t
)
961 (math-read-big-emptyp widest
(1+ v
) h v2 nil t
)
963 (setq widest
(math-read-big-balance h v
"(" t
))
964 (math-read-big-emptyp (1- h
) v1 h v nil t
)
965 (math-read-big-emptyp (1- h
) (1+ v
) h v2 nil t
)
966 (setq p
(cons (math-read-big-rec
967 h v1
(1- widest
) v2 v
) p
)
969 (= (math-read-big-char (1- h
) v
) ?\
,)))
970 (or (= (math-read-big-char (1- h
) v
) ?\
))
971 (math-read-big-error (1- h
) v
"Expected `)'"))
972 (setq p
(cons line
(nreverse p
))))
974 (intern (math-remove-dashes p
))
975 (if (string-match "-" p
)
977 (intern (concat "var-" p
)))))))
981 (setq line
(nth v lines
))
982 (or (= (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\([0-9]+\\(#\\|\\^\\^\\)[0-9a-zA-Z:]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" line h1
) h1
)
983 (math-read-big-error h v
"Expected a number"))
984 (setq h
(match-end 0)
985 p
(math-read-number (math-match-substring line
0)))
986 (math-read-big-emptyp h1 v1 h v nil t
)
987 (math-read-big-emptyp h1
(1+ v
) h v2 nil t
)))
989 ;; Now left term is bounded by h1, v1, h, v2; baseline = v.
992 (math-read-big-error h1 v
"Inconsistent baseline in formula"))
995 ;; Look for superscripts or subscripts.
996 (setq line
(nth baseline lines
)
997 len
(min h2
(length line
))
999 (while (and (< widest len
)
1000 (= (aref line widest
) ?\
))
1001 (setq widest
(1+ widest
)))
1002 (and (>= widest len
) (setq widest h2
))
1003 (if (math-read-big-emptyp h v widest v2
)
1004 (if (math-read-big-emptyp h v1 widest v
)
1006 (setq p
(list '^ p
(math-read-big-rec h v1 widest v
))
1008 (if (math-read-big-emptyp h v1 widest v
)
1009 (setq p
(list 'calcFunc-subscr p
1010 (math-read-big-rec h v widest v2
))
1013 ;; Look for an operator name and grab additional terms.
1014 (while (and (< h len
)
1015 (if (setq widest
(and (math-read-big-emptyp
1017 (math-read-big-emptyp
1019 (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h
)
1020 (assoc (math-match-substring line
0)
1021 math-standard-opers
)))
1022 (and (>= (nth 2 widest
) prec
)
1023 (setq h
(match-end 0)))
1024 (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h
)
1026 (setq widest
'("2x" * 196 195)))))
1027 (cond ((eq (nth 3 widest
) -
1)
1028 (setq p
(list (nth 1 widest
) p
)))
1029 ((equal (car widest
) "?")
1030 (let ((y (math-read-big-rec h v1 h2 v2 baseline nil t
)))
1031 (or (= (math-read-big-char the-h2 baseline
) ?\
:)
1032 (math-read-big-error the-h2 baseline
"Expected `:'"))
1033 (setq p
(list (nth 1 widest
) p y
1034 (math-read-big-rec (1+ the-h2
) v1 h2 v2
1035 baseline
(nth 3 widest
) t
))
1038 (setq p
(list (nth 1 widest
) p
1039 (math-read-big-rec h v1 h2 v2
1040 baseline
(nth 3 widest
) t
))
1043 ;; Return all relevant information to caller.
1044 (setq the-baseline baseline
1046 (or short
(= the-h2 h2
)
1047 (math-read-big-error h baseline
))
1050 (defun math-read-big-char (h v
)
1055 (let ((line (nth v lines
)))
1061 (defun math-read-big-emptyp (eh1 ev1 eh2 ev2
&optional what error
)
1062 (and (< ev1 v1
) (setq ev1 v1
))
1063 (and (< eh1 h1
) (setq eh1 h1
))
1064 (and (> ev2 v2
) (setq ev2 v2
))
1065 (and (> eh2 h2
) (setq eh2 h2
))
1066 (or what
(setq what ?\
))
1067 (let ((p (nthcdr ev1 lines
))
1069 (while (and (< ev1 ev2
)
1071 (setq h
(min eh2
(length (car p
))))
1072 (while (and (>= (setq h
(1- h
)) eh1
)
1073 (= (aref (car p
) h
) what
)))
1074 (and error
(>= h eh1
)
1075 (math-read-big-error h ev1
(if (stringp error
)
1077 "Whitespace expected")))
1083 (defun math-read-big-error (h v
&optional msg
)
1087 (setq pos
(+ pos
1 (length (car p
)))
1090 (setq h
(+ pos
(min h
(length (car p
))))
1091 err-msg
(list 'error h
(or msg
"Syntax error")))
1092 (throw 'syntax nil
)))
1094 (defun math-read-big-balance (h v what
&optional commas
)
1095 (let* ((line (nth v lines
))
1096 (len (min h2
(length line
)))
1101 (math-read-big-error h1 v
(format "Unmatched `%s'" what
))
1103 (if (memq (aref line h
) '(?\
( ?\
[))
1104 (setq count
(1+ count
))
1105 (if (if (and commas
(= count
1))
1106 (or (memq (aref line h
) '(?\
) ?\
] ?\
, ?\
;))
1107 (and (eq (aref line h
) ?\.
)
1109 (eq (aref line
(1+ h
)) ?\.
)))
1110 (memq (aref line h
) '(?\
) ?\
])))
1111 (setq count
(1- count
))))
1115 ;;; calc-lang.el ends here