1 ;;; calc-lang.el --- calc language functions
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
6 ;; Author: David Gillespie <daveg@synaptics.com>
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; This file is autoloaded from calc-ext.el.
34 ;; Declare functions which are defined elsewhere.
35 (declare-function math-compose-vector
"calccomp" (a sep prec
))
36 (declare-function math-compose-var
"calccomp" (a))
37 (declare-function math-tex-expr-is-flat
"calccomp" (a))
38 (declare-function math-read-factor
"calc-aent" ())
39 (declare-function math-read-expr-level
"calc-aent" (exp-prec &optional exp-term
))
41 ;; Declare variables which are defined elsewhere.
42 (defvar calc-lang-slash-idiv
)
43 (defvar calc-lang-allow-underscores
)
44 (defvar calc-lang-allow-percentsigns
)
45 (defvar math-comp-left-bracket
)
46 (defvar math-comp-right-bracket
)
47 (defvar math-comp-comma
)
48 (defvar math-comp-vector-prec
)
50 ;;; Alternate entry/display languages.
52 (defun calc-set-language (lang &optional option no-refresh
)
53 (setq math-expr-opers
(or (get lang
'math-oper-table
) (math-standard-ops))
54 math-expr-function-mapping
(get lang
'math-function-table
)
55 math-expr-variable-mapping
(get lang
'math-variable-table
)
56 calc-language-input-filter
(get lang
'math-input-filter
)
57 calc-language-output-filter
(get lang
'math-output-filter
)
58 calc-vector-brackets
(or (get lang
'math-vector-brackets
) "[]")
59 calc-complex-format
(get lang
'math-complex-format
)
60 calc-radix-formatter
(get lang
'math-radix-formatter
)
61 calc-function-open
(or (get lang
'math-function-open
) "(")
62 calc-function-close
(or (get lang
'math-function-close
) ")"))
64 (setq calc-language lang
65 calc-language-option option
)
66 (calc-change-mode '(calc-language calc-language-option
)
67 (list lang option
) t
)))
69 (defun calc-normal-language ()
72 (calc-set-language nil
)
73 (message "Normal language mode")))
75 (defun calc-flat-language ()
78 (calc-set-language 'flat
)
79 (message "Flat language mode (all stack entries shown on one line)")))
81 (defun calc-big-language ()
84 (calc-set-language 'big
)
85 (message "\"Big\" language mode")))
87 (defun calc-unformatted-language ()
90 (calc-set-language 'unform
)
91 (message "Unformatted language mode")))
94 (defun calc-c-language ()
97 (calc-set-language 'c
)
98 (message "`C' language mode")))
100 (put 'c
'math-oper-table
101 '( ( "u!" calcFunc-lnot -
1 1000 )
102 ( "~" calcFunc-not -
1 1000 )
103 ( "u+" ident -
1 197 )
110 ( "<<" calcFunc-lsh
170 171 )
111 ( ">>" calcFunc-rsh
170 171 )
112 ( "<" calcFunc-lt
160 161 )
113 ( ">" calcFunc-gt
160 161 )
114 ( "<=" calcFunc-leq
160 161 )
115 ( ">=" calcFunc-geq
160 161 )
116 ( "==" calcFunc-eq
150 151 )
117 ( "!=" calcFunc-neq
150 151 )
118 ( "&" calcFunc-and
140 141 )
119 ( "^" calcFunc-xor
131 130 )
120 ( "|" calcFunc-or
120 121 )
121 ( "&&" calcFunc-land
110 111 )
122 ( "||" calcFunc-lor
100 101 )
123 ( "?" (math-read-if) 91 90 )
124 ( "!!!" calcFunc-pnot -
1 88 )
125 ( "&&&" calcFunc-pand
85 86 )
126 ( "|||" calcFunc-por
75 76 )
127 ( "=" calcFunc-assign
51 50 )
128 ( ":=" calcFunc-assign
51 50 )
129 ( "::" calcFunc-condition
45 46 ))) ; should support full assignments
131 (put 'c
'math-function-table
132 '( ( acos . calcFunc-arccos
)
133 ( acosh . calcFunc-arccosh
)
134 ( asin . calcFunc-arcsin
)
135 ( asinh . calcFunc-arcsinh
)
136 ( atan . calcFunc-arctan
)
137 ( atan2 . calcFunc-arctan2
)
138 ( atanh . calcFunc-arctanh
)))
140 (put 'c
'math-variable-table
144 (put 'c
'math-vector-brackets
"{}")
146 (put 'c
'math-radix-formatter
147 (function (lambda (r s
)
148 (if (= r
16) (format "0x%s" s
)
149 (if (= r
8) (format "0%s" s
)
150 (format "%d#%s" r s
))))))
152 (put 'c
'math-compose-subscr
155 (let ((args (cdr (cdr a
))))
157 (math-compose-expr (nth 1 a
) 1000)
159 (math-compose-vector args
", " 0)
162 (add-to-list 'calc-lang-slash-idiv
'c
)
163 (add-to-list 'calc-lang-allow-underscores
'c
)
164 (add-to-list 'calc-lang-c-type-hex
'c
)
165 (add-to-list 'calc-lang-brackets-are-subscripts
'c
)
167 (defun calc-pascal-language (n)
170 (and n
(setq n
(prefix-numeric-value n
)))
171 (calc-set-language 'pascal n
)
172 (message (if (and n
(/= n
0))
174 "Pascal language mode (all uppercase)"
175 "Pascal language mode (all lowercase)")
176 "Pascal language mode"))))
178 (put 'pascal
'math-oper-table
179 '( ( "not" calcFunc-lnot -
1 1000 )
182 ( "and" calcFunc-and
190 191 )
183 ( "div" calcFunc-idiv
190 191 )
185 ( "u+" ident -
1 185 )
189 ( "or" calcFunc-or
180 181 )
190 ( "xor" calcFunc-xor
180 181 )
191 ( "shl" calcFunc-lsh
180 181 )
192 ( "shr" calcFunc-rsh
180 181 )
193 ( "in" calcFunc-in
160 161 )
194 ( "<" calcFunc-lt
160 161 )
195 ( ">" calcFunc-gt
160 161 )
196 ( "<=" calcFunc-leq
160 161 )
197 ( ">=" calcFunc-geq
160 161 )
198 ( "=" calcFunc-eq
160 161 )
199 ( "<>" calcFunc-neq
160 161 )
200 ( "!!!" calcFunc-pnot -
1 85 )
201 ( "&&&" calcFunc-pand
80 81 )
202 ( "|||" calcFunc-por
75 76 )
203 ( ":=" calcFunc-assign
51 50 )
204 ( "::" calcFunc-condition
45 46 )))
206 (put 'pascal
'math-input-filter
'calc-input-case-filter
)
207 (put 'pascal
'math-output-filter
'calc-output-case-filter
)
209 (put 'pascal
'math-radix-formatter
210 (function (lambda (r s
)
211 (if (= r
16) (format "$%s" s
)
212 (format "%d#%s" r s
)))))
214 (put 'pascal
'math-lang-read-symbol
217 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Zα-ωΑ-Ω]\\)"
218 math-exp-str math-exp-pos
)
220 (setq math-exp-token
'number
221 math-expr-data
(math-match-substring math-exp-str
1)
222 math-exp-pos
(match-end 1)))))
224 (put 'pascal
'math-compose-subscr
227 (let ((args (cdr (cdr a
))))
228 (while (eq (car-safe (nth 1 a
)) 'calcFunc-subscr
)
229 (setq args
(append (cdr (cdr (nth 1 a
))) args
)
232 (math-compose-expr (nth 1 a
) 1000)
234 (math-compose-vector args
", " 0)
237 (add-to-list 'calc-lang-allow-underscores
'pascal
)
238 (add-to-list 'calc-lang-brackets-are-subscripts
'pascal
)
240 (defun calc-input-case-filter (str)
241 (cond ((or (null calc-language-option
) (= calc-language-option
0))
246 (defun calc-output-case-filter (str)
247 (cond ((or (null calc-language-option
) (= calc-language-option
0))
249 ((> calc-language-option
0)
255 (defun calc-fortran-language (n)
258 (and n
(setq n
(prefix-numeric-value n
)))
259 (calc-set-language 'fortran n
)
260 (message (if (and n
(/= n
0))
262 "FORTRAN language mode (all uppercase)"
263 "FORTRAN language mode (all lowercase)")
264 "FORTRAN language mode"))))
266 (put 'fortran
'math-oper-table
267 '( ( "u/" (math-parse-fortran-vector) -
1 1 )
268 ( "/" (math-parse-fortran-vector-end) 1 -
1 )
270 ( "u+" ident -
1 191 )
276 ( ".LT." calcFunc-lt
160 161 )
277 ( ".GT." calcFunc-gt
160 161 )
278 ( ".LE." calcFunc-leq
160 161 )
279 ( ".GE." calcFunc-geq
160 161 )
280 ( ".EQ." calcFunc-eq
160 161 )
281 ( ".NE." calcFunc-neq
160 161 )
282 ( ".NOT." calcFunc-lnot -
1 121 )
283 ( ".AND." calcFunc-land
110 111 )
284 ( ".OR." calcFunc-lor
100 101 )
285 ( "!!!" calcFunc-pnot -
1 85 )
286 ( "&&&" calcFunc-pand
80 81 )
287 ( "|||" calcFunc-por
75 76 )
288 ( "=" calcFunc-assign
51 50 )
289 ( ":=" calcFunc-assign
51 50 )
290 ( "::" calcFunc-condition
45 46 )))
292 (put 'fortran
'math-vector-brackets
"//")
294 (put 'fortran
'math-function-table
295 '( ( acos . calcFunc-arccos
)
296 ( acosh . calcFunc-arccosh
)
297 ( aimag . calcFunc-im
)
298 ( aint . calcFunc-ftrunc
)
299 ( asin . calcFunc-arcsin
)
300 ( asinh . calcFunc-arcsinh
)
301 ( atan . calcFunc-arctan
)
302 ( atan2 . calcFunc-arctan2
)
303 ( atanh . calcFunc-arctanh
)
304 ( conjg . calcFunc-conj
)
305 ( log . calcFunc-ln
)
306 ( nint . calcFunc-round
)
307 ( real . calcFunc-re
)))
309 (put 'fortran
'math-input-filter
'calc-input-case-filter
)
311 (put 'fortran
'math-output-filter
'calc-output-case-filter
)
313 (put 'fortran
'math-lang-read-symbol
315 (eq (string-match "\\.[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω]?\\."
316 math-exp-str math-exp-pos
) math-exp-pos
)
317 (setq math-exp-token
'punc
318 math-expr-data
(upcase (math-match-substring math-exp-str
0))
319 math-exp-pos
(match-end 0)))))
321 (put 'fortran
'math-compose-subscr
324 (let ((args (cdr (cdr a
))))
325 (while (eq (car-safe (nth 1 a
)) 'calcFunc-subscr
)
326 (setq args
(append (cdr (cdr (nth 1 a
))) args
)
329 (math-compose-expr (nth 1 a
) 1000)
331 (math-compose-vector args
", " 0)
334 (add-to-list 'calc-lang-slash-idiv
'fortran
)
335 (add-to-list 'calc-lang-allow-underscores
'fortran
)
336 (add-to-list 'calc-lang-parens-are-subscripts
'fortran
)
338 ;; The next few variables are local to math-read-exprs in calc-aent.el
339 ;; and math-read-expr in calc-ext.el, but are set in functions they call.
341 (defvar math-exp-token
)
342 (defvar math-expr-data
)
343 (defvar math-exp-old-pos
)
345 (defvar math-parsing-fortran-vector nil
)
346 (defun math-parse-fortran-vector (op)
347 (let ((math-parsing-fortran-vector '(end .
"\000")))
349 (math-read-brackets t
"]")
350 (setq math-exp-token
(car math-parsing-fortran-vector
)
351 math-expr-data
(cdr math-parsing-fortran-vector
)))))
353 (defun math-parse-fortran-vector-end (x op
)
354 (if math-parsing-fortran-vector
356 (setq math-parsing-fortran-vector
(cons math-exp-token math-expr-data
)
358 math-expr-data
"\000")
360 (throw 'syntax
"Unmatched closing `/'")))
362 (defun math-parse-fortran-subscr (sym args
)
363 (setq sym
(math-build-var-name sym
))
365 (setq sym
(list 'calcFunc-subscr sym
(car args
))
370 (defun calc-tex-language (n)
373 (and n
(setq n
(prefix-numeric-value n
)))
374 (calc-set-language 'tex n
)
376 (message "TeX language mode"))
378 (message "TeX language mode with multiline matrices"))
380 (message "TeX language mode with \\hbox{func}(\\hbox{var})"))
383 "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices"))
385 (message "TeX language mode with \\func(\\hbox{var})"))
388 "TeX language mode with \\func(\\hbox{var}) and multiline matrices")))))
390 (defun calc-latex-language (n)
393 (and n
(setq n
(prefix-numeric-value n
)))
394 (calc-set-language 'latex n
)
396 (message "LaTeX language mode"))
398 (message "LaTeX language mode with multiline matrices"))
400 (message "LaTeX language mode with \\text{func}(\\text{var})"))
403 "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices"))
405 (message "LaTeX language mode with \\func(\\text{var})"))
408 "LaTeX language mode with \\func(\\text{var}) and multiline matrices")))))
410 (put 'tex
'math-lang-name
"TeX")
411 (put 'latex
'math-lang-name
"LaTeX")
413 (put 'tex
'math-oper-table
414 '( ( "\\hat" calcFunc-hat -
1 950 )
415 ( "\\check" calcFunc-check -
1 950 )
416 ( "\\tilde" calcFunc-tilde -
1 950 )
417 ( "\\acute" calcFunc-acute -
1 950 )
418 ( "\\grave" calcFunc-grave -
1 950 )
419 ( "\\dot" calcFunc-dot -
1 950 )
420 ( "\\ddot" calcFunc-dotdot -
1 950 )
421 ( "\\breve" calcFunc-breve -
1 950 )
422 ( "\\bar" calcFunc-bar -
1 950 )
423 ( "\\vec" calcFunc-Vec -
1 950 )
424 ( "\\underline" calcFunc-under -
1 950 )
425 ( "u|" calcFunc-abs -
1 0 )
427 ( "\\lfloor" calcFunc-floor -
1 0 )
428 ( "\\rfloor" closing
0 -
1 )
429 ( "\\lceil" calcFunc-ceil -
1 0 )
430 ( "\\rceil" closing
0 -
1 )
431 ( "\\pm" sdev
300 300 )
432 ( "!" calcFunc-fact
210 -
1 )
434 ( "_" calcFunc-subscr
201 200 )
435 ( "u+" ident -
1 197 )
437 ( "\\times" * 191 190 )
442 ( "\\over" / 170 171 )
444 ( "\\choose" calcFunc-choose
170 171 )
445 ( "\\mod" %
170 171 )
446 ( "<" calcFunc-lt
160 161 )
447 ( ">" calcFunc-gt
160 161 )
448 ( "\\leq" calcFunc-leq
160 161 )
449 ( "\\geq" calcFunc-geq
160 161 )
450 ( "=" calcFunc-eq
160 161 )
451 ( "\\neq" calcFunc-neq
160 161 )
452 ( "\\ne" calcFunc-neq
160 161 )
453 ( "\\lnot" calcFunc-lnot -
1 121 )
454 ( "\\land" calcFunc-land
110 111 )
455 ( "\\lor" calcFunc-lor
100 101 )
456 ( "?" (math-read-if) 91 90 )
457 ( "!!!" calcFunc-pnot -
1 85 )
458 ( "&&&" calcFunc-pand
80 81 )
459 ( "|||" calcFunc-por
75 76 )
460 ( "\\gets" calcFunc-assign
51 50 )
461 ( ":=" calcFunc-assign
51 50 )
462 ( "::" calcFunc-condition
45 46 )
463 ( "\\to" calcFunc-evalto
40 41 )
464 ( "\\to" calcFunc-evalto
40 -
1 )
465 ( "=>" calcFunc-evalto
40 41 )
466 ( "=>" calcFunc-evalto
40 -
1 )))
468 (put 'tex
'math-function-table
469 '( ( \\arccos . calcFunc-arccos
)
470 ( \\arcsin . calcFunc-arcsin
)
471 ( \\arctan . calcFunc-arctan
)
472 ( \\arg . calcFunc-arg
)
473 ( \\cos . calcFunc-cos
)
474 ( \\cosh . calcFunc-cosh
)
475 ( \\cot . calcFunc-cot
)
476 ( \\coth . calcFunc-coth
)
477 ( \\csc . calcFunc-csc
)
478 ( \\det . calcFunc-det
)
479 ( \\exp . calcFunc-exp
)
480 ( \\gcd . calcFunc-gcd
)
481 ( \\ln . calcFunc-ln
)
482 ( \\log . calcFunc-log10
)
483 ( \\max . calcFunc-max
)
484 ( \\min . calcFunc-min
)
485 ( \\sec . calcFunc-sec
)
486 ( \\sin . calcFunc-sin
)
487 ( \\sinh . calcFunc-sinh
)
488 ( \\sqrt . calcFunc-sqrt
)
489 ( \\tan . calcFunc-tan
)
490 ( \\tanh . calcFunc-tanh
)
491 ( \\phi . calcFunc-totient
)
492 ( \\mu . calcFunc-moebius
)))
494 (put 'tex
'math-special-function-table
495 '((calcFunc-sum .
(math-compose-tex-sum "\\sum"))
496 (calcFunc-prod .
(math-compose-tex-sum "\\prod"))
497 (calcFunc-sqrt . math-compose-tex-sqrt
)
498 (intv . math-compose-tex-intv
)))
500 (put 'tex
'math-variable-table
503 ( \\alpha . var-alpha
)
504 ( \\beta . var-beta
)
505 ( \\gamma . var-gamma
)
506 ( \\Gamma . var-Gamma
)
507 ( \\delta . var-delta
)
508 ( \\Delta . var-Delta
)
509 ( \\epsilon . var-epsilon
)
510 ( \\varepsilon . var-varepsilon
)
511 ( \\zeta . var-zeta
)
513 ( \\theta . var-theta
)
514 ( \\vartheta . var-vartheta
)
515 ( \\Theta . var-Theta
)
516 ( \\iota . var-iota
)
517 ( \\kappa . var-kappa
)
518 ( \\lambda . var-lambda
)
519 ( \\Lambda . var-Lambda
)
525 ( \\varpi . var-varpi
)
528 ( \\varrho . var-varrho
)
529 ( \\sigma . var-sigma
)
530 ( \\sigma . var-varsigma
)
531 ( \\Sigma . var-Sigma
)
533 ( \\upsilon . var-upsilon
)
534 ( \\Upsilon . var-Upsilon
)
536 ( \\varphi . var-varphi
)
541 ( \\omega . var-omega
)
542 ( \\Omega . var-Omega
)
555 ( \\infty . var-inf
)
556 ( \\infty . var-uinf
)
557 ( \\sum .
(math-parse-tex-sum calcFunc-sum
) )
558 ( \\prod .
(math-parse-tex-sum calcFunc-prod
) )))
560 (put 'tex
'math-punc-table
565 (put 'tex
'math-complex-format
'i
)
567 (put 'tex
'math-input-filter
'math-tex-input-filter
)
569 (put 'tex
'math-matrix-formatter
572 (if (and (integerp calc-language-option
)
573 (or (= calc-language-option
0)
574 (> calc-language-option
1)
575 (< calc-language-option -
1)))
576 (append '(vleft 0 "\\matrix{")
577 (math-compose-tex-matrix (cdr a
))
579 (append '(horiz "\\matrix{ ")
580 (math-compose-tex-matrix (cdr a
))
583 (put 'tex
'math-var-formatter
'math-compose-tex-var
)
585 (put 'tex
'math-func-formatter
'math-compose-tex-func
)
587 (put 'tex
'math-dots
"\\ldots")
589 (put 'tex
'math-big-parens
'("\\left( " .
" \\right)"))
591 (put 'tex
'math-evalto
'("\\evalto " .
" \\to "))
593 (defconst math-tex-ignore-words
594 '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right")
595 ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ")
596 ("\\quad") ("\\qquad") ("\\hfil") ("\\hfill")
597 ("\\displaystyle") ("\\textstyle") ("\\dsize") ("\\tsize")
598 ("\\scriptstyle") ("\\scriptscriptstyle") ("\\ssize") ("\\sssize")
599 ("\\rm") ("\\bf") ("\\it") ("\\sl")
600 ("\\roman") ("\\bold") ("\\italic") ("\\slanted")
601 ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth")
603 ("\\matrix" mat
) ("\\bmatrix" mat
) ("\\pmatrix" mat
)
605 ("\\cr" punc
";") ("\\\\" punc
";") ("\\*" punc
"*")
606 ("\\{" punc
"[") ("\\}" punc
"]")))
608 (defconst math-latex-ignore-words
609 (append math-tex-ignore-words
610 '(("\\begin" begenv
))))
612 (put 'tex
'math-lang-read-symbol
614 (< math-exp-pos
(1- (length math-exp-str
)))
616 (or (string-match "\\\\hbox *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
617 math-exp-str math-exp-pos
)
618 (string-match "\\(\\\\\\([a-zA-Zα-ωΑ-Ω]+\\|[^a-zA-Zα-ωΑ-Ω]\\)\\)"
619 math-exp-str math-exp-pos
))
620 (setq math-exp-token
'symbol
621 math-exp-pos
(match-end 0)
622 math-expr-data
(math-restore-dashes
623 (math-match-substring math-exp-str
1)))
624 (let ((code (assoc math-expr-data math-latex-ignore-words
)))
628 ((eq (nth 1 code
) 'punc
)
629 (setq math-exp-token
'punc
630 math-expr-data
(nth 2 code
)))
631 ((and (eq (nth 1 code
) 'mat
)
632 (string-match " *{" math-exp-str math-exp-pos
))
633 (setq math-exp-pos
(match-end 0)
636 (let ((right (string-match "}" math-exp-str math-exp-pos
)))
638 (setq math-exp-str
(copy-sequence math-exp-str
))
639 (aset math-exp-str right ?\
]))))))))))
641 (defun math-compose-tex-matrix (a &optional ltx
)
643 (cons (append (math-compose-vector (cdr (car a
)) " & " 0)
644 (if ltx
'(" \\\\ ") '(" \\cr ")))
645 (math-compose-tex-matrix (cdr a
) ltx
))
646 (list (math-compose-vector (cdr (car a
)) " & " 0))))
648 (defun math-compose-tex-sum (a fn
)
651 (list 'horiz
(nth 1 fn
)
652 "_{" (math-compose-expr (nth 2 a
) 0)
653 "=" (math-compose-expr (nth 3 a
) 0)
654 "}^{" (math-compose-expr (nth 4 a
) 0)
655 "}{" (math-compose-expr (nth 1 a
) 0) "}"))
657 (list 'horiz
(nth 1 fn
)
658 "_{" (math-compose-expr (nth 2 a
) 0)
659 "=" (math-compose-expr (nth 3 a
) 0)
660 "}{" (math-compose-expr (nth 1 a
) 0) "}"))
662 (list 'horiz
(nth 1 fn
)
663 "_{" (math-compose-expr (nth 2 a
) 0)
664 "}{" (math-compose-expr (nth 1 a
) 0) "}"))))
666 (defun math-parse-tex-sum (f val
)
668 (or (equal math-expr-data
"_") (throw 'syntax
"Expected `_'"))
670 (setq save math-exp-old-pos
)
671 (setq low
(math-read-factor))
672 (or (eq (car-safe low
) 'calcFunc-eq
)
674 (setq math-exp-old-pos
(1+ save
))
675 (throw 'syntax
"Expected equation")))
676 (or (equal math-expr-data
"^") (throw 'syntax
"Expected `^'"))
678 (setq high
(math-read-factor))
679 (list (nth 2 f
) (math-read-factor) (nth 1 low
) (nth 2 low
) high
)))
681 (defun math-tex-input-filter (str) ; allow parsing of 123\,456\,789.
682 (while (string-match "[0-9]\\\\,[0-9]" str
)
683 (setq str
(concat (substring str
0 (1+ (match-beginning 0)))
684 (substring str
(1- (match-end 0))))))
687 (defun math-compose-tex-sqrt (a)
690 (math-compose-expr (nth 1 a
) 0)
693 (defun math-compose-tex-intv (a)
695 (if (memq (nth 1 a
) '(0 1)) "(" "[")
696 (math-compose-expr (nth 2 a
) 0)
698 (math-compose-expr (nth 3 a
) 0)
699 (if (memq (nth 1 a
) '(0 2)) ")" "]")))
701 (defun math-compose-tex-var (a prec
)
702 (if (and calc-language-option
703 (not (= calc-language-option
0))
704 (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'"
705 (symbol-name (nth 1 a
))))
706 (if (eq calc-language
'latex
)
707 (format "\\text{%s}" (symbol-name (nth 1 a
)))
708 (format "\\hbox{%s}" (symbol-name (nth 1 a
))))
709 (math-compose-var a
)))
711 (defun math-compose-tex-func (func a
)
713 (if (and calc-language-option
714 (not (= calc-language-option
0))
715 (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'" func
))
716 (if (< (prefix-numeric-value calc-language-option
) 0)
717 (setq func
(format "\\%s" func
))
718 (setq func
(if (eq calc-language
'latex
)
719 (format "\\text{%s}" func
)
720 (format "\\hbox{%s}" func
)))))
721 (cond ((or (> (length a
) 2)
722 (not (math-tex-expr-is-flat (nth 1 a
))))
723 (setq left
"\\left( "
725 ((and (eq (aref func
0) ?
\\)
727 (string-match "\\hbox{" func
)
728 (string-match "\\text{" func
)))
730 (or (Math-realp (nth 1 a
))
731 (memq (car (nth 1 a
)) '(var *))))
732 (setq left
"{" right
"}"))
733 (t (setq left calc-function-open
734 right calc-function-close
)))
737 (math-compose-vector (cdr a
) ", " 0)
740 (put 'latex
'math-oper-table
741 (append (get 'tex
'math-oper-table
)
742 '(( "\\Hat" calcFunc-Hat -
1 950 )
743 ( "\\Check" calcFunc-Check -
1 950 )
744 ( "\\Tilde" calcFunc-Tilde -
1 950 )
745 ( "\\Acute" calcFunc-Acute -
1 950 )
746 ( "\\Grave" calcFunc-Grave -
1 950 )
747 ( "\\Dot" calcFunc-Dot -
1 950 )
748 ( "\\Ddot" calcFunc-Dotdot -
1 950 )
749 ( "\\Breve" calcFunc-Breve -
1 950 )
750 ( "\\Bar" calcFunc-Bar -
1 950 )
751 ( "\\Vec" calcFunc-VEC -
1 950 )
752 ( "\\dddot" calcFunc-dddot -
1 950 )
753 ( "\\ddddot" calcFunc-ddddot -
1 950 )
754 ( "\\div" / 170 171 )
755 ( "\\le" calcFunc-leq
160 161 )
756 ( "\\leqq" calcFunc-leq
160 161 )
757 ( "\\leqsland" calcFunc-leq
160 161 )
758 ( "\\ge" calcFunc-geq
160 161 )
759 ( "\\geqq" calcFunc-geq
160 161 )
760 ( "\\geqslant" calcFunc-geq
160 161 )
761 ( "=" calcFunc-eq
160 161 )
762 ( "\\neq" calcFunc-neq
160 161 )
763 ( "\\ne" calcFunc-neq
160 161 )
764 ( "\\lnot" calcFunc-lnot -
1 121 )
765 ( "\\land" calcFunc-land
110 111 )
766 ( "\\lor" calcFunc-lor
100 101 )
767 ( "?" (math-read-if) 91 90 )
768 ( "!!!" calcFunc-pnot -
1 85 )
769 ( "&&&" calcFunc-pand
80 81 )
770 ( "|||" calcFunc-por
75 76 )
771 ( "\\gets" calcFunc-assign
51 50 )
772 ( ":=" calcFunc-assign
51 50 )
773 ( "::" calcFunc-condition
45 46 )
774 ( "\\to" calcFunc-evalto
40 41 )
775 ( "\\to" calcFunc-evalto
40 -
1 )
776 ( "=>" calcFunc-evalto
40 41 )
777 ( "=>" calcFunc-evalto
40 -
1 ))))
779 (put 'latex
'math-function-table
781 (get 'tex
'math-function-table
)
782 '(( \\frac .
(math-latex-parse-frac))
783 ( \\tfrac .
(math-latex-parse-frac))
784 ( \\dfrac .
(math-latex-parse-frac))
785 ( \\binom .
(math-latex-parse-two-args calcFunc-choose
))
786 ( \\tbinom .
(math-latex-parse-two-args calcFunc-choose
))
787 ( \\dbinom .
(math-latex-parse-two-args calcFunc-choose
))
788 ( \\phi . calcFunc-totient
)
789 ( \\mu . calcFunc-moebius
))))
791 (put 'latex
'math-special-function-table
792 '((/ .
(math-compose-latex-frac "\\frac"))
793 (calcFunc-choose .
(math-compose-latex-frac "\\binom"))
794 (calcFunc-sum .
(math-compose-tex-sum "\\sum"))
795 (calcFunc-prod .
(math-compose-tex-sum "\\prod"))
796 (calcFunc-sqrt . math-compose-tex-sqrt
)
797 (intv . math-compose-tex-intv
)))
799 (put 'latex
'math-variable-table
800 (get 'tex
'math-variable-table
))
802 (put 'latex
'math-punc-table
807 (put 'latex
'math-complex-format
'i
)
809 (put 'latex
'math-matrix-formatter
812 (if (and (integerp calc-language-option
)
813 (or (= calc-language-option
0)
814 (> calc-language-option
1)
815 (< calc-language-option -
1)))
816 (append '(vleft 0 "\\begin{pmatrix}")
817 (math-compose-tex-matrix (cdr a
) t
)
819 (append '(horiz "\\begin{pmatrix} ")
820 (math-compose-tex-matrix (cdr a
) t
)
821 '(" \\end{pmatrix}"))))))
823 (put 'latex
'math-var-formatter
'math-compose-tex-var
)
825 (put 'latex
'math-func-formatter
'math-compose-tex-func
)
827 (put 'latex
'math-dots
"\\ldots")
829 (put 'latex
'math-big-parens
'("\\left( " .
" \\right)"))
831 (put 'latex
'math-evalto
'("\\evalto " .
" \\to "))
833 (put 'latex
'math-lang-read-symbol
835 (< math-exp-pos
(1- (length math-exp-str
)))
837 (or (string-match "\\\\hbox *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
838 math-exp-str math-exp-pos
)
839 (string-match "\\\\text *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
840 math-exp-str math-exp-pos
)
841 (string-match "\\(\\\\\\([a-zA-Zα-ωΑ-Ω]+\\|[^a-zA-Zα-ωΑ-Ω]\\)\\)"
842 math-exp-str math-exp-pos
))
843 (setq math-exp-token
'symbol
844 math-exp-pos
(match-end 0)
845 math-expr-data
(math-restore-dashes
846 (math-match-substring math-exp-str
1)))
847 (let ((code (assoc math-expr-data math-tex-ignore-words
))
852 ((eq (nth 1 code
) 'punc
)
853 (setq math-exp-token
'punc
854 math-expr-data
(nth 2 code
)))
855 ((and (eq (nth 1 code
) 'begenv
)
856 (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos
))
857 (setq math-exp-pos
(match-end 0)
858 envname
(match-string 1 math-exp-str
)
861 (cond ((or (string= envname
"matrix")
862 (string= envname
"bmatrix")
863 (string= envname
"smallmatrix")
864 (string= envname
"pmatrix"))
865 (if (string-match (concat "\\\\end{" envname
"}")
866 math-exp-str math-exp-pos
)
868 (replace-match "]" t t math-exp-str
))
869 (error "%s" (concat "No closing \\end{" envname
"}"))))))
870 ((and (eq (nth 1 code
) 'mat
)
871 (string-match " *{" math-exp-str math-exp-pos
))
872 (setq math-exp-pos
(match-end 0)
875 (let ((right (string-match "}" math-exp-str math-exp-pos
)))
877 (setq math-exp-str
(copy-sequence math-exp-str
))
878 (aset math-exp-str right ?\
]))))))))))
880 (defun math-latex-parse-frac (f val
)
882 (setq numer
(car (math-read-expr-list)))
884 (setq denom
(math-read-factor))
885 (if (and (Math-num-integerp numer
)
886 (Math-num-integerp denom
))
887 (list 'frac numer denom
)
888 (list '/ numer denom
))))
890 (defun math-latex-parse-two-args (f val
)
892 (setq first
(car (math-read-expr-list)))
894 (setq second
(math-read-factor))
895 (list (nth 2 f
) first second
)))
897 (defun math-compose-latex-frac (a fn
)
898 (list 'horiz
(nth 1 fn
) "{" (math-compose-expr (nth 1 a
) -
1)
900 (math-compose-expr (nth 2 a
) -
1)
903 (put 'latex
'math-input-filter
'math-tex-input-filter
)
905 (defun calc-eqn-language (n)
908 (calc-set-language 'eqn
)
909 (message "Eqn language mode")))
911 (put 'eqn
'math-oper-table
912 '( ( "prime" (math-parse-eqn-prime) 950 -
1 )
913 ( "prime" calcFunc-Prime
950 -
1 )
914 ( "dot" calcFunc-dot
950 -
1 )
915 ( "dotdot" calcFunc-dotdot
950 -
1 )
916 ( "hat" calcFunc-hat
950 -
1 )
917 ( "tilde" calcFunc-tilde
950 -
1 )
918 ( "vec" calcFunc-Vec
950 -
1 )
919 ( "dyad" calcFunc-dyad
950 -
1 )
920 ( "bar" calcFunc-bar
950 -
1 )
921 ( "under" calcFunc-under
950 -
1 )
922 ( "sub" calcFunc-subscr
931 930 )
924 ( "sqrt" calcFunc-sqrt -
1 910 )
926 ( "u|" calcFunc-abs -
1 0 )
928 ( "left floor" calcFunc-floor -
1 0 )
929 ( "right floor" closing
0 -
1 )
930 ( "left ceil" calcFunc-ceil -
1 0 )
931 ( "right ceil" closing
0 -
1 )
932 ( "+-" sdev
300 300 )
933 ( "!" calcFunc-fact
210 -
1 )
934 ( "u+" ident -
1 197 )
936 ( "times" * 191 190 )
943 ( "<" calcFunc-lt
160 161 )
944 ( ">" calcFunc-gt
160 161 )
945 ( "<=" calcFunc-leq
160 161 )
946 ( ">=" calcFunc-geq
160 161 )
947 ( "=" calcFunc-eq
160 161 )
948 ( "==" calcFunc-eq
160 161 )
949 ( "!=" calcFunc-neq
160 161 )
950 ( "u!" calcFunc-lnot -
1 121 )
951 ( "&&" calcFunc-land
110 111 )
952 ( "||" calcFunc-lor
100 101 )
953 ( "?" (math-read-if) 91 90 )
954 ( "!!!" calcFunc-pnot -
1 85 )
955 ( "&&&" calcFunc-pand
80 81 )
956 ( "|||" calcFunc-por
75 76 )
957 ( "<-" calcFunc-assign
51 50 )
958 ( ":=" calcFunc-assign
51 50 )
959 ( "::" calcFunc-condition
45 46 )
960 ( "->" calcFunc-evalto
40 41 )
961 ( "->" calcFunc-evalto
40 -
1 )
962 ( "=>" calcFunc-evalto
40 41 )
963 ( "=>" calcFunc-evalto
40 -
1 )))
965 (put 'eqn
'math-function-table
966 '( ( arc\ cos . calcFunc-arccos
)
967 ( arc\ cosh . calcFunc-arccosh
)
968 ( arc\ sin . calcFunc-arcsin
)
969 ( arc\ sinh . calcFunc-arcsinh
)
970 ( arc\ tan . calcFunc-arctan
)
971 ( arc\ tanh . calcFunc-arctanh
)
972 ( GAMMA . calcFunc-gamma
)
973 ( phi . calcFunc-totient
)
974 ( mu . calcFunc-moebius
)
975 ( matrix .
(math-parse-eqn-matrix) )))
977 (put 'eqn
'math-special-function-table
978 '((intv . math-compose-eqn-intv
)))
980 (put 'eqn
'math-punc-table
984 (put 'eqn
'math-variable-table
985 '( ( inf . var-uinf
)))
987 (put 'eqn
'math-complex-format
'i
)
989 (put 'eqn
'math-big-parens
'("{left ( " .
" right )}"))
991 (put 'eqn
'math-evalto
'("evalto " .
" -> "))
993 (put 'eqn
'math-matrix-formatter
996 (append '(horiz "matrix { ")
997 (math-compose-eqn-matrix
998 (cdr (math-transpose a
)))
1001 (put 'eqn
'math-var-formatter
1005 (if (and math-compose-hash-args
1006 (let ((p calc-arg-values
))
1008 (while (and p
(not (equal (car p
) a
)))
1009 (setq p
(and (eq math-compose-hash-args t
) (cdr p
))
1012 (if (eq math-compose-hash-args
1)
1015 (if (string-match ".'\\'" (symbol-name (nth 2 a
)))
1017 (list 'calcFunc-Prime
1020 (intern (substring (symbol-name (nth 1 a
)) 0 -
1))
1021 (intern (substring (symbol-name (nth 2 a
)) 0 -
1))))
1023 (symbol-name (nth 1 a
))))))))
1025 (defconst math-eqn-special-funcs
1027 calcFunc-ln calcFunc-exp
1028 calcFunc-sin calcFunc-cos calcFunc-tan
1029 calcFunc-sec calcFunc-csc calcFunc-cot
1030 calcFunc-sinh calcFunc-cosh calcFunc-tanh
1031 calcFunc-sech calcFunc-csch calcFunc-coth
1032 calcFunc-arcsin calcFunc-arccos calcFunc-arctan
1033 calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh
))
1035 (put 'eqn
'math-func-formatter
1039 (if (string-match "[^']'+\\'" func
)
1040 (let ((n (- (length func
) (match-beginning 0) 1)))
1041 (setq func
(substring func
0 (- n
)))
1042 (while (>= (setq n
(1- n
)) 0)
1043 (setq func
(concat func
" prime")))))
1044 (cond ((or (> (length a
) 2)
1045 (not (math-tex-expr-is-flat (nth 1 a
))))
1046 (setq left
"{left ( "
1050 (memq (car a
) math-eqn-special-funcs
)
1052 (or (Math-realp (nth 1 a
))
1053 (memq (car (nth 1 a
)) '(var *))))
1054 (setq left
"~{" right
"}"))
1058 (list 'horiz func left
1059 (math-compose-vector (cdr a
) " , " 0)
1062 (put 'eqn
'math-lang-read-symbol
1064 (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)"
1065 math-exp-str math-exp-pos
)
1067 (setq math-exp-str
(copy-sequence math-exp-str
))
1068 (aset math-exp-str
(match-beginning 1) ?\
{)
1069 (if (< (match-end 1) (length math-exp-str
))
1070 (aset math-exp-str
(match-end 1) ?\
}))
1071 (math-read-token)))))
1073 (defconst math-eqn-ignore-words
1074 '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto")
1075 ("left" ("floor") ("ceil"))
1076 ("right" ("floor") ("ceil"))
1077 ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh"))
1078 ("size" n
) ("font" n
) ("fwd" n
) ("back" n
) ("up" n
) ("down" n
)
1079 ("above" punc
",")))
1081 (put 'eqn
'math-lang-adjust-words
1084 (let ((code (assoc math-expr-data math-eqn-ignore-words
)))
1088 ((consp (nth 1 code
))
1090 (if (assoc math-expr-data
(cdr code
))
1091 (setq math-expr-data
(format "%s %s"
1092 (car code
) math-expr-data
))))
1093 ((eq (nth 1 code
) 'punc
)
1094 (setq math-exp-token
'punc
1095 math-expr-data
(nth 2 code
)))
1098 (math-read-token)))))))
1100 (put 'eqn
'math-lang-read
1101 '((eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
1102 math-exp-str math-exp-pos
)
1105 (setq math-exp-token
'punc
1106 math-expr-data
(math-match-substring math-exp-str
0)
1107 math-exp-pos
(match-end 0))
1108 (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos
)
1110 (setq math-exp-pos
(match-end 0)))
1111 (if (memq (aref math-expr-data
0) '(?~ ?^
))
1112 (math-read-token)))))
1115 (defun math-compose-eqn-matrix (a)
1118 (cond ((eq calc-matrix-just
'right
) "rcol ")
1119 ((eq calc-matrix-just
'center
) "ccol ")
1122 (list 'break math-compose-level
)
1126 (let ((math-compose-level (1+ math-compose-level
)))
1127 (math-compose-vector (cdr (car a
)) " above " 1000))
1130 (math-compose-eqn-matrix (cdr a
)))))))
1133 (defun math-parse-eqn-matrix (f sym
)
1135 (while (assoc math-expr-data
'(("ccol") ("lcol") ("rcol")))
1137 (or (equal math-expr-data calc-function-open
)
1138 (throw 'syntax
"Expected `{'"))
1140 (setq vec
(cons (cons 'vec
(math-read-expr-list)) vec
))
1141 (or (equal math-expr-data calc-function-close
)
1142 (throw 'syntax
"Expected `}'"))
1144 (or (equal math-expr-data calc-function-close
)
1145 (throw 'syntax
"Expected `}'"))
1147 (math-transpose (cons 'vec
(nreverse vec
)))))
1149 (defun math-parse-eqn-prime (x sym
)
1150 (if (eq (car-safe x
) 'var
)
1151 (if (equal math-expr-data calc-function-open
)
1154 (let ((args (if (or (equal math-expr-data calc-function-close
)
1155 (eq math-exp-token
'end
))
1157 (math-read-expr-list))))
1158 (if (not (or (equal math-expr-data calc-function-close
)
1159 (eq math-exp-token
'end
)))
1160 (throw 'syntax
"Expected `)'"))
1162 (cons (intern (format "calcFunc-%s'" (nth 1 x
))) args
)))
1164 (intern (concat (symbol-name (nth 1 x
)) "'"))
1165 (intern (concat (symbol-name (nth 2 x
)) "'"))))
1166 (list 'calcFunc-Prime x
)))
1168 (defun math-compose-eqn-intv (a)
1170 (if (memq (nth 1 a
) '(0 1)) "(" "[")
1171 (math-compose-expr (nth 2 a
) 0)
1173 (math-compose-expr (nth 3 a
) 0)
1174 (if (memq (nth 1 a
) '(0 2)) ")" "]")))
1179 (defun calc-yacas-language ()
1180 "Change the Calc language to be Yacas-like."
1183 (calc-set-language 'yacas
)
1184 (message "`Yacas' language mode")))
1186 (put 'yacas
'math-vector-brackets
"{}")
1188 (put 'yacas
'math-complex-format
'I
)
1190 (add-to-list 'calc-lang-brackets-are-subscripts
'yacas
)
1192 (put 'yacas
'math-variable-table
1193 '(( Infinity . var-inf
)
1194 ( Infinity . var-uinf
)
1195 ( Undefined . var-nan
)
1197 ( E . var-e
) ;; Not really in Yacas
1198 ( GoldenRatio . var-phi
)
1199 ( Gamma . var-gamma
)))
1201 (put 'yacas
'math-parse-table
1202 '((("Deriv(" 0 ")" 0)
1203 calcFunc-deriv
(var ArgB var-ArgB
) (var ArgA var-ArgA
))
1205 calcFunc-deriv
(var ArgB var-ArgB
) (var ArgA var-ArgA
))
1206 (("Integrate(" 0 ")" 0)
1207 calcFunc-integ
(var ArgB var-ArgB
)(var ArgA var-ArgA
))
1208 (("Integrate(" 0 "," 0 "," 0 ")" 0)
1209 calcFunc-integ
(var ArgD var-ArgD
) (var ArgA var-ArgA
)
1210 (var ArgB var-ArgB
) (var ArgC var-ArgC
))
1211 (("Subst(" 0 "," 0 ")" 0)
1212 calcFunc-subst
(var ArgC var-ArgC
) (var ArgA var-ArgA
)
1213 (var ArgB var-ArgB
))
1214 (("Taylor(" 0 "," 0 "," 0 ")" 0)
1215 calcFunc-taylor
(var ArgD var-ArgD
)
1216 (calcFunc-eq (var ArgA var-ArgA
) (var ArgB var-ArgB
))
1217 (var ArgC var-ArgC
))))
1219 (put 'yacas
'math-oper-table
1227 ("<<" calcFunc-lsh
80 80)
1228 (">>" calcFunc-rsh
80 80)
1229 ("!" calcFunc-fact
80 -
1)
1230 ("!!" calcFunc-dfact
80 -
1)
1231 ("X" calcFunc-cross
70 70)
1232 ("=" calcFunc-eq
10 10)
1233 ("!=" calcFunc-neq
10 10)
1234 ("<" calcFunc-lt
10 10)
1235 (">" calcFunc-gt
10 10)
1236 ("<=" calcFunc-leq
10 10)
1237 (">=" calcFunc-geq
10 10)
1238 ("And" calcFunc-land
5 5)
1239 ("Or" calcFunc-or
4 4)
1240 ("Not" calcFunc-lnot -
1 3)
1241 (":=" calcFunc-assign
1 1)))
1243 (put 'yacas
'math-function-table
1244 '(( Div . calcFunc-idiv
)
1245 ( Mod . calcFunc-mod
)
1246 ( Abs . calcFunc-abs
)
1247 ( Sign . calcFunc-sign
)
1248 ( Sqrt . calcFunc-sqrt
)
1249 ( Max . calcFunc-max
)
1250 ( Min . calcFunc-min
)
1251 ( Floor . calcFunc-floor
)
1252 ( Ceil . calcFunc-ceil
)
1253 ( Round . calcFunc-round
)
1254 ( Conjugate . calcFunc-conj
)
1255 ( Arg . calcFunc-arg
)
1258 ( Rationalize . calcFunc-pfrac
)
1259 ( Sin . calcFunc-sin
)
1260 ( Cos . calcFunc-cos
)
1261 ( Tan . calcFunc-tan
)
1262 ( Sec . calcFunc-sec
)
1263 ( Csc . calcFunc-csc
)
1264 ( Cot . calcFunc-cot
)
1265 ( ArcSin . calcFunc-arcsin
)
1266 ( ArcCos . calcFunc-arccos
)
1267 ( ArcTan . calcFunc-arctan
)
1268 ( Sinh . calcFunc-sinh
)
1269 ( Cosh . calcFunc-cosh
)
1270 ( Tanh . calcFunc-tanh
)
1271 ( Sech . calcFunc-sech
)
1272 ( Csch . calcFunc-csch
)
1273 ( Coth . calcFunc-coth
)
1274 ( ArcSinh . calcFunc-arcsinh
)
1275 ( ArcCosh . calcFunc-arccosh
)
1276 ( ArcTanh . calcFunc-arctanh
)
1278 ( Exp . calcFunc-exp
)
1279 ( Gamma . calcFunc-gamma
)
1280 ( Gcd . calcFunc-gcd
)
1281 ( Lcm . calcFunc-lcm
)
1282 ( Bin . calcFunc-choose
)
1283 ( Bernoulli . calcFunc-bern
)
1284 ( Euler . calcFunc-euler
)
1285 ( StirlingNumber1 . calcFunc-stir1
)
1286 ( StirlingNumber2 . calcFunc-stir2
)
1287 ( IsPrime . calcFunc-prime
)
1288 ( Factors . calcFunc-prfac
)
1289 ( NextPrime . calcFunc-nextprime
)
1290 ( Moebius . calcFunc-moebius
)
1291 ( Random . calcFunc-random
)
1292 ( Concat . calcFunc-vconcat
)
1293 ( Head . calcFunc-head
)
1294 ( Tail . calcFunc-tail
)
1295 ( Length . calcFunc-vlen
)
1296 ( Reverse . calcFunc-rev
)
1297 ( CrossProduct . calcFunc-cross
)
1298 ( Dot . calcFunc-mul
)
1299 ( DiagonalMatrix . calcFunc-diag
)
1300 ( Transpose . calcFunc-trn
)
1301 ( Inverse . calcFunc-inv
)
1302 ( Determinant . calcFunc-det
)
1303 ( Trace . calcFunc-tr
)
1304 ( RemoveDuplicates . calcFunc-rdup
)
1305 ( Union . calcFunc-vunion
)
1306 ( Intersection . calcFunc-vint
)
1307 ( Difference . calcFunc-vdiff
)
1308 ( Apply . calcFunc-apply
)
1309 ( Map . calcFunc-map
)
1310 ( Simplify . calcFunc-simplify
)
1311 ( ExpandBrackets . calcFunc-expand
)
1312 ( Solve . calcFunc-solve
)
1313 ( Degree . calcFunc-pdeg
)
1315 ( Contains .
(math-lang-switch-args calcFunc-in
))
1316 ( Sum .
(math-yacas-parse-Sum calcFunc-sum
))
1317 ( Factorize .
(math-yacas-parse-Sum calcFunc-prod
))))
1319 (put 'yacas
'math-special-function-table
1320 '(( calcFunc-sum .
(math-yacas-compose-sum "Sum"))
1321 ( calcFunc-prod .
(math-yacas-compose-sum "Factorize"))
1322 ( calcFunc-deriv .
(math-yacas-compose-deriv "Deriv"))
1323 ( calcFunc-integ .
(math-yacas-compose-deriv "Integrate"))
1324 ( calcFunc-taylor . math-yacas-compose-taylor
)
1325 ( calcFunc-in .
(math-lang-compose-switch-args "Contains"))))
1327 (put 'yacas
'math-compose-subscr
1330 (let ((args (cdr (cdr a
))))
1332 (math-compose-expr (nth 1 a
) 1000)
1334 (math-compose-vector args
", " 0)
1337 (defun math-yacas-parse-Sum (f val
)
1338 "Read in the arguments to \"Sum\" in Calc's Yacas mode."
1339 (let ((args (math-read-expr-list)))
1347 (defun math-yacas-compose-sum (a fn
)
1348 "Compose the \"Sum\" function in Calc's Yacas mode."
1352 (math-compose-expr (nth 2 a
) -
1)
1354 (math-compose-expr (nth 3 a
) -
1)
1356 (math-compose-expr (nth 4 a
) -
1)
1358 (math-compose-expr (nth 1 a
) -
1)
1361 (defun math-yacas-compose-deriv (a fn
)
1362 "Compose the \"Deriv\" function in Calc's Yacas mode."
1366 (math-compose-expr (nth 2 a
) -
1)
1371 (math-compose-expr (nth 3 a
) -
1)
1373 (math-compose-expr (nth 4 a
) -
1)
1376 (math-compose-expr (nth 1 a
) -
1)))
1378 (defun math-yacas-compose-taylor (a)
1379 "Compose the \"Taylor\" function in Calc's Yacas mode."
1382 (if (eq (car-safe (nth 2 a
)) 'calcFunc-eq
)
1383 (concat (math-compose-expr (nth 1 (nth 2 a
)) -
1)
1385 (math-compose-expr (nth 2 (nth 2 a
)) -
1))
1386 (concat (math-compose-expr (nth 2 a
) -
1) ",0"))
1388 (math-compose-expr (nth 3 a
) -
1)
1390 (math-compose-expr (nth 1 a
) -
1)))
1395 (defun calc-maxima-language ()
1396 "Change the Calc language to be Maxima-like."
1399 (calc-set-language 'maxima
)
1400 (message "`Maxima' language mode")))
1402 (put 'maxima
'math-oper-table
1412 ("!" calcFunc-fact
160 -
1)
1413 ("!!" calcFunc-dfact
160 -
1)
1414 ("=" calcFunc-eq
80 80)
1415 ("#" calcFunc-neq
80 80)
1416 ("<" calcFunc-lt
80 80)
1417 (">" calcFunc-gt
80 80)
1418 ("<=" calcFunc-leq
80 80)
1419 (">=" calcFunc-geq
80 80)
1420 ("and" calcFunc-land
65 65)
1421 ("or" calcFunc-or
60 60)
1422 ("not" calcFunc-lnot -
1 70)
1423 (":" calcFunc-assign
180 20)))
1426 (put 'maxima
'math-function-table
1428 ( abs . calcFunc-abs
)
1429 ( cabs . calcFunc-abs
)
1430 ( signum . calcFunc-sign
)
1431 ( floor . calcFunc-floor
)
1432 ( entier . calcFunc-floor
)
1433 ( fix . calcFunc-floor
)
1434 ( conjugate . calcFunc-conj
)
1435 ( carg . calcFunc-arg
)
1436 ( realpart . calcFunc-re
)
1437 ( imagpart . calcFunc-im
)
1438 ( rationalize . calcFunc-pfrac
)
1439 ( asin . calcFunc-arcsin
)
1440 ( acos . calcFunc-arccos
)
1441 ( atan . calcFunc-arctan
)
1442 ( atan2 . calcFunc-arctan2
)
1443 ( asinh . calcFunc-arcsinh
)
1444 ( acosh . calcFunc-arccosh
)
1445 ( atanh . calcFunc-arctanh
)
1446 ( log . calcFunc-ln
)
1447 ( plog . calcFunc-ln
)
1448 ( bessel_j . calcFunc-besJ
)
1449 ( bessel_y . calcFunc-besY
)
1450 ( factorial . calcFunc-fact
)
1451 ( binomial . calcFunc-choose
)
1452 ( primep . calcFunc-prime
)
1453 ( next_prime . calcFunc-nextprime
)
1454 ( prev_prime . calcFunc-prevprime
)
1455 ( append . calcFunc-vconcat
)
1456 ( rest . calcFunc-tail
)
1457 ( reverse . calcFunc-rev
)
1458 ( innerproduct . calcFunc-mul
)
1459 ( inprod . calcFunc-mul
)
1460 ( row . calcFunc-mrow
)
1461 ( columnvector . calcFunc-mcol
)
1462 ( covect . calcFunc-mcol
)
1463 ( transpose . calcFunc-trn
)
1464 ( invert . calcFunc-inv
)
1465 ( determinant . calcFunc-det
)
1466 ( mattrace . calcFunc-tr
)
1467 ( member . calcFunc-in
)
1468 ( lmax . calcFunc-vmax
)
1469 ( lmin . calcFunc-vmin
)
1470 ( distrib . calcFunc-expand
)
1471 ( partfrac . calcFunc-apart
)
1472 ( rat . calcFunc-nrat
)
1473 ( product . calcFunc-prod
)
1474 ( diff . calcFunc-deriv
)
1475 ( integrate . calcFunc-integ
)
1476 ( quotient . calcFunc-pdiv
)
1477 ( remainder . calcFunc-prem
)
1478 ( divide . calcFunc-pdivrem
)
1479 ( equal . calcFunc-eq
)
1480 ( notequal . calcFunc-neq
)
1481 ( rhs . calcFunc-rmeq
)
1482 ( subst .
(math-maxima-parse-subst))
1483 ( substitute .
(math-maxima-parse-subst))
1484 ( taylor .
(math-maxima-parse-taylor))))
1486 (defun math-maxima-parse-subst (f val
)
1487 "Read in the arguments to \"subst\" in Calc's Maxima mode."
1488 (let ((args (math-read-expr-list)))
1490 (list 'calcFunc-subst
1495 (defun math-maxima-parse-taylor (f val
)
1496 "Read in the arguments to \"taylor\" in Calc's Maxima mode."
1497 (let ((args (math-read-expr-list)))
1499 (list 'calcFunc-taylor
1506 (put 'maxima
'math-parse-table
1507 '((("if" 0 "then" 0 "else" 0)
1511 (var ArgC var-ArgC
))))
1513 (put 'maxima
'math-special-function-table
1514 '(( calcFunc-taylor . math-maxima-compose-taylor
)
1515 ( calcFunc-subst . math-maxima-compose-subst
)
1516 ( calcFunc-if . math-maxima-compose-if
)))
1518 (defun math-maxima-compose-taylor (a)
1519 "Compose the \"taylor\" function in Calc's Maxima mode."
1522 (math-compose-expr (nth 1 a
) -
1)
1524 (if (eq (car-safe (nth 2 a
)) 'calcFunc-eq
)
1525 (concat (math-compose-expr (nth 1 (nth 2 a
)) -
1)
1527 (math-compose-expr (nth 2 (nth 2 a
)) -
1))
1528 (concat (math-compose-expr (nth 2 a
) -
1) ",0"))
1530 (math-compose-expr (nth 3 a
) -
1)
1533 (defun math-maxima-compose-subst (a)
1534 "Compose the \"subst\" function in Calc's Maxima mode."
1537 (math-compose-expr (nth 2 a
) -
1)
1539 (math-compose-expr (nth 3 a
) -
1)
1541 (math-compose-expr (nth 1 a
) -
1)
1544 (defun math-maxima-compose-if (a)
1545 "Compose the \"if\" function in Calc's Maxima mode."
1548 (math-compose-expr (nth 1 a
) -
1)
1550 (math-compose-expr (nth 2 a
) -
1)
1552 (math-compose-expr (nth 3 a
) -
1)))
1554 (put 'maxima
'math-variable-table
1555 '(( infinity . var-uinf
)
1560 ( %gamma . var-gamma
)))
1562 (put 'maxima
'math-complex-format
'%i
)
1564 (add-to-list 'calc-lang-allow-underscores
'maxima
)
1566 (add-to-list 'calc-lang-allow-percentsigns
'maxima
)
1568 (add-to-list 'calc-lang-brackets-are-subscripts
'maxima
)
1570 (put 'maxima
'math-compose-subscr
1573 (let ((args (cdr (cdr a
))))
1575 (math-compose-expr (nth 1 a
) 1000)
1577 (math-compose-vector args
", " 0)
1580 (put 'maxima
'math-matrix-formatter
1585 (math-compose-vector (cdr a
)
1586 (concat math-comp-comma
" ")
1587 math-comp-vector-prec
)
1593 (defun calc-giac-language ()
1594 "Change the Calc language to be Giac-like."
1597 (calc-set-language 'giac
)
1598 (message "`Giac' language mode")))
1600 (put 'giac
'math-oper-table
1601 '( ( "[" (math-read-giac-subscr) 250 -
1 )
1607 ( "u+" ident -
1 197 )
1609 ( "!" calcFunc-fact
210 -
1 )
1610 ( ".." (math-read-maple-dots) 165 165 )
1611 ( "\\dots" (math-read-maple-dots) 165 165 )
1612 ( "intersect" calcFunc-vint
191 192 )
1613 ( "union" calcFunc-vunion
180 181 )
1614 ( "minus" calcFunc-vdiff
180 181 )
1615 ( "<" calcFunc-lt
160 160 )
1616 ( ">" calcFunc-gt
160 160 )
1617 ( "<=" calcFunc-leq
160 160 )
1618 ( ">=" calcFunc-geq
160 160 )
1619 ( "=" calcFunc-eq
160 160 )
1620 ( "==" calcFunc-eq
160 160 )
1621 ( "!=" calcFunc-neq
160 160 )
1622 ( "and" calcFunc-land
110 111 )
1623 ( "or" calcFunc-lor
100 101 )
1624 ( "&&" calcFunc-land
110 111 )
1625 ( "||" calcFunc-lor
100 101 )
1626 ( "not" calcFunc-lnot -
1 121 )
1627 ( ":=" calcFunc-assign
51 50 )))
1630 (put 'giac
'math-function-table
1631 '(( rdiv . calcFunc-div
)
1632 ( iquo . calcFunc-idiv
)
1633 ( irem . calcFunc-mod
)
1634 ( remain . calcFunc-mod
)
1635 ( floor . calcFunc-floor
)
1636 ( iPart . calcFunc-floor
)
1637 ( ceil . calcFunc-ceil
)
1638 ( ceiling . calcFunc-ceil
)
1640 ( real . calcFunc-re
)
1642 ( imag . calcFunc-im
)
1643 ( float2rational . calcFunc-pfrac
)
1644 ( exact . calcFunc-pfrac
)
1645 ( evalf . calcFunc-pfloat
)
1646 ( bitand . calcFunc-and
)
1647 ( bitor . calcFunc-or
)
1648 ( bitxor . calcFunc-xor
)
1649 ( asin . calcFunc-arcsin
)
1650 ( acos . calcFunc-arccos
)
1651 ( atan . calcFunc-arctan
)
1652 ( asinh . calcFunc-arcsinh
)
1653 ( acosh . calcFunc-arccosh
)
1654 ( atanh . calcFunc-arctanh
)
1655 ( log . calcFunc-ln
)
1656 ( logb . calcFunc-log
)
1657 ( factorial . calcFunc-fact
)
1658 ( comb . calcFunc-choose
)
1659 ( binomial . calcFunc-choose
)
1660 ( nCr . calcFunc-choose
)
1661 ( perm . calcFunc-perm
)
1662 ( nPr . calcFunc-perm
)
1663 ( bernoulli . calcFunc-bern
)
1664 ( is_prime . calcFunc-prime
)
1665 ( isprime . calcFunc-prime
)
1666 ( isPrime . calcFunc-prime
)
1667 ( ifactors . calcFunc-prfac
)
1668 ( euler . calcFunc-totient
)
1669 ( phi . calcFunc-totient
)
1670 ( rand . calcFunc-random
)
1671 ( concat . calcFunc-vconcat
)
1672 ( augment . calcFunc-vconcat
)
1673 ( mid . calcFunc-subvec
)
1674 ( length . calcFunc-length
)
1675 ( size . calcFunc-length
)
1676 ( nops . calcFunc-length
)
1677 ( SortA . calcFunc-sort
)
1678 ( SortB . calcFunc-rsort
)
1679 ( revlist . calcFunc-rev
)
1680 ( cross . calcFunc-cross
)
1681 ( crossP . calcFunc-cross
)
1682 ( crossproduct . calcFunc-cross
)
1683 ( mul . calcFunc-mul
)
1684 ( dot . calcFunc-mul
)
1685 ( dotprod . calcFunc-mul
)
1686 ( dotP . calcFunc-mul
)
1687 ( scalar_product . calcFunc-mul
)
1688 ( scalar_Product . calcFunc-mul
)
1689 ( row . calcFunc-mrow
)
1690 ( col . calcFunc-mcol
)
1691 ( dim . calcFunc-mdims
)
1692 ( tran . calcFunc-trn
)
1693 ( transpose . calcFunc-trn
)
1694 ( lu . calcFunc-lud
)
1695 ( trace . calcFunc-tr
)
1696 ( member . calcFunc-in
)
1697 ( sum . calcFunc-vsum
)
1698 ( add . calcFunc-vsum
)
1699 ( product . calcFunc-vprod
)
1700 ( mean . calcFunc-vmean
)
1701 ( median . calcFunc-vmedian
)
1702 ( stddev . calcFunc-vsdev
)
1703 ( stddevp . calcFunc-vpsdev
)
1704 ( variance . calcFunc-vpvar
)
1705 ( map . calcFunc-map
)
1706 ( apply . calcFunc-map
)
1707 ( of . calcFunc-map
)
1708 ( zip . calcFunc-map
)
1709 ( expand . calcFunc-expand
)
1710 ( fdistrib . calcFunc-expand
)
1711 ( partfrac . calcFunc-apart
)
1712 ( ratnormal . calcFunc-nrat
)
1713 ( diff . calcFunc-deriv
)
1714 ( derive . calcFunc-deriv
)
1715 ( integrate . calcFunc-integ
)
1716 ( int . calcFunc-integ
)
1717 ( Int . calcFunc-integ
)
1718 ( romberg . calcFunc-ninteg
)
1719 ( nInt . calcFunc-ninteg
)
1720 ( lcoeff . calcFunc-plead
)
1721 ( content . calcFunc-pcont
)
1722 ( primpart . calcFunc-pprim
)
1723 ( quo . calcFunc-pdiv
)
1724 ( rem . calcFunc-prem
)
1725 ( quorem . calcFunc-pdivrem
)
1726 ( divide . calcFunc-pdivrem
)
1727 ( equal . calcFunc-eq
)
1728 ( ifte . calcFunc-if
)
1729 ( not . calcFunc-lnot
)
1730 ( rhs . calcFunc-rmeq
)
1731 ( right . calcFunc-rmeq
)
1732 ( prepend .
(math-lang-switch-args calcFunc-cons
))
1733 ( contains .
(math-lang-switch-args calcFunc-in
))
1734 ( has .
(math-lang-switch-args calcFunc-refers
))))
1736 (defun math-lang-switch-args (f val
)
1737 "Read the arguments to a Calc function in reverse order.
1738 This is used for various language modes which have functions in reverse
1740 (let ((args (math-read-expr-list)))
1746 (put 'giac
'math-parse-table
1749 (var ArgA var-ArgA
))))
1751 (put 'giac
'math-special-function-table
1752 '((calcFunc-cons .
(math-lang-compose-switch-args "prepend"))
1753 (calcFunc-in .
(math-lang-compose-switch-args "contains"))
1754 (calcFunc-refers .
(math-lang-compose-switch-args "has"))
1755 (intv . math-compose-maple-intv
)))
1757 (defun math-lang-compose-switch-args (a fn
)
1758 "Compose the arguments to a Calc function in reverse order.
1759 This is used for various language modes which have functions in reverse
1761 (list 'horiz
(nth 1 fn
)
1763 (math-compose-expr (nth 2 a
) 0)
1765 (math-compose-expr (nth 1 a
) 0)
1768 (put 'giac
'math-variable-table
1769 '(( infinity . var-inf
)
1770 ( infinity . var-uinf
)))
1772 (put 'giac
'math-complex-format
'i
)
1774 (add-to-list 'calc-lang-allow-underscores
'giac
)
1776 (put 'giac
'math-compose-subscr
1779 (let ((args (cdr (cdr a
))))
1781 (math-compose-expr (nth 1 a
) 1000)
1784 (calc-normalize (list '-
(nth 2 a
) 1)) 0)
1787 (defun math-read-giac-subscr (x op
)
1788 (let ((idx (math-read-expr-level 0)))
1789 (or (equal math-expr-data
"]")
1790 (throw 'syntax
"Expected ']'"))
1792 (list 'calcFunc-subscr x
(calc-normalize (list '+ idx
1)))))
1794 (add-to-list 'calc-lang-c-type-hex
'giac
)
1797 (defun calc-mathematica-language ()
1800 (calc-set-language 'math
)
1801 (message "Mathematica language mode")))
1803 (put 'math
'math-oper-table
1804 '( ( "[[" (math-read-math-subscr) 250 -
1 )
1805 ( "!" calcFunc-fact
210 -
1 )
1806 ( "!!" calcFunc-dfact
210 -
1 )
1808 ( "u+" ident -
1 197 )
1815 ( "<" calcFunc-lt
160 161 )
1816 ( ">" calcFunc-gt
160 161 )
1817 ( "<=" calcFunc-leq
160 161 )
1818 ( ">=" calcFunc-geq
160 161 )
1819 ( "==" calcFunc-eq
150 151 )
1820 ( "!=" calcFunc-neq
150 151 )
1821 ( "u!" calcFunc-lnot -
1 121 )
1822 ( "&&" calcFunc-land
110 111 )
1823 ( "||" calcFunc-lor
100 101 )
1824 ( "!!!" calcFunc-pnot -
1 85 )
1825 ( "&&&" calcFunc-pand
80 81 )
1826 ( "|||" calcFunc-por
75 76 )
1827 ( ":=" calcFunc-assign
51 50 )
1828 ( "=" calcFunc-assign
51 50 )
1829 ( "->" calcFunc-assign
51 50 )
1830 ( ":>" calcFunc-assign
51 50 )
1831 ( "::" calcFunc-condition
45 46 )
1834 (put 'math
'math-function-table
1835 '( ( Abs . calcFunc-abs
)
1836 ( ArcCos . calcFunc-arccos
)
1837 ( ArcCosh . calcFunc-arccosh
)
1838 ( ArcSin . calcFunc-arcsin
)
1839 ( ArcSinh . calcFunc-arcsinh
)
1840 ( ArcTan . calcFunc-arctan
)
1841 ( ArcTanh . calcFunc-arctanh
)
1842 ( Arg . calcFunc-arg
)
1843 ( Binomial . calcFunc-choose
)
1844 ( Ceiling . calcFunc-ceil
)
1845 ( Conjugate . calcFunc-conj
)
1846 ( Cos . calcFunc-cos
)
1847 ( Cosh . calcFunc-cosh
)
1848 ( Cot . calcFunc-cot
)
1849 ( Coth . calcFunc-coth
)
1850 ( Csc . calcFunc-csc
)
1851 ( Csch . calcFunc-csch
)
1852 ( D . calcFunc-deriv
)
1853 ( Dt . calcFunc-tderiv
)
1854 ( Det . calcFunc-det
)
1855 ( Exp . calcFunc-exp
)
1856 ( EulerPhi . calcFunc-totient
)
1857 ( Floor . calcFunc-floor
)
1858 ( Gamma . calcFunc-gamma
)
1859 ( GCD . calcFunc-gcd
)
1860 ( If . calcFunc-if
)
1861 ( Im . calcFunc-im
)
1862 ( Inverse . calcFunc-inv
)
1863 ( Integrate . calcFunc-integ
)
1864 ( Join . calcFunc-vconcat
)
1865 ( LCM . calcFunc-lcm
)
1866 ( Log . calcFunc-ln
)
1867 ( Max . calcFunc-max
)
1868 ( Min . calcFunc-min
)
1869 ( Mod . calcFunc-mod
)
1870 ( MoebiusMu . calcFunc-moebius
)
1871 ( Random . calcFunc-random
)
1872 ( Round . calcFunc-round
)
1873 ( Re . calcFunc-re
)
1874 ( Sec . calcFunc-sec
)
1875 ( Sech . calcFunc-sech
)
1876 ( Sign . calcFunc-sign
)
1877 ( Sin . calcFunc-sin
)
1878 ( Sinh . calcFunc-sinh
)
1879 ( Sqrt . calcFunc-sqrt
)
1880 ( Tan . calcFunc-tan
)
1881 ( Tanh . calcFunc-tanh
)
1882 ( Transpose . calcFunc-trn
)
1883 ( Length . calcFunc-vlen
)
1886 (put 'math
'math-variable-table
1890 ( GoldenRatio . var-phi
)
1891 ( EulerGamma . var-gamma
)
1892 ( Infinity . var-inf
)
1893 ( ComplexInfinity . var-uinf
)
1894 ( Indeterminate . var-nan
)
1897 (put 'math
'math-vector-brackets
"{}")
1898 (put 'math
'math-complex-format
'I
)
1899 (put 'math
'math-function-open
"[")
1900 (put 'math
'math-function-close
"]")
1902 (put 'math
'math-radix-formatter
1903 (function (lambda (r s
) (format "%d^^%s" r s
))))
1905 (put 'math
'math-lang-read
1906 '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos
)
1908 (setq math-exp-token
'punc
1909 math-expr-data
(math-match-substring math-exp-str
0)
1910 math-exp-pos
(match-end 0))))
1912 (put 'math
'math-compose-subscr
1916 (math-compose-expr (nth 1 a
) 1000)
1918 (math-compose-expr (nth 2 a
) 0)
1921 (defun math-read-math-subscr (x op
)
1922 (let ((idx (math-read-expr-level 0)))
1923 (or (and (equal math-expr-data
"]")
1926 (equal math-expr-data
"]")))
1927 (throw 'syntax
"Expected ']]'"))
1929 (list 'calcFunc-subscr x idx
)))
1932 (defun calc-maple-language ()
1935 (calc-set-language 'maple
)
1936 (message "Maple language mode")))
1938 (put 'maple
'math-oper-table
1939 '( ( "matrix" ident -
1 300 )
1940 ( "MATRIX" ident -
1 300 )
1941 ( "!" calcFunc-fact
210 -
1 )
1944 ( "u+" ident -
1 197 )
1948 ( "intersect" calcFunc-vint
191 192 )
1951 ( "union" calcFunc-vunion
180 181 )
1952 ( "minus" calcFunc-vdiff
180 181 )
1954 ( ".." (math-read-maple-dots) 165 165 )
1955 ( "\\dots" (math-read-maple-dots) 165 165 )
1956 ( "<" calcFunc-lt
160 160 )
1957 ( ">" calcFunc-gt
160 160 )
1958 ( "<=" calcFunc-leq
160 160 )
1959 ( ">=" calcFunc-geq
160 160 )
1960 ( "=" calcFunc-eq
160 160 )
1961 ( "<>" calcFunc-neq
160 160 )
1962 ( "not" calcFunc-lnot -
1 121 )
1963 ( "and" calcFunc-land
110 111 )
1964 ( "or" calcFunc-lor
100 101 )
1965 ( "!!!" calcFunc-pnot -
1 85 )
1966 ( "&&&" calcFunc-pand
80 81 )
1967 ( "|||" calcFunc-por
75 76 )
1968 ( ":=" calcFunc-assign
51 50 )
1969 ( "::" calcFunc-condition
45 46 )
1972 (put 'maple
'math-function-table
1973 '( ( bernoulli . calcFunc-bern
)
1974 ( binomial . calcFunc-choose
)
1975 ( diff . calcFunc-deriv
)
1976 ( GAMMA . calcFunc-gamma
)
1977 ( ifactor . calcFunc-prfac
)
1978 ( igcd . calcFunc-gcd
)
1979 ( ilcm . calcFunc-lcm
)
1980 ( int . calcFunc-integ
)
1983 ( iquo . calcFunc-idiv
)
1984 ( isprime . calcFunc-prime
)
1985 ( length . calcFunc-vlen
)
1986 ( member . calcFunc-in
)
1987 ( crossprod . calcFunc-cross
)
1988 ( inverse . calcFunc-inv
)
1989 ( trace . calcFunc-tr
)
1990 ( transpose . calcFunc-trn
)
1991 ( vectdim . calcFunc-vlen
)
1994 (put 'maple
'math-special-function-table
1995 '((intv . math-compose-maple-intv
)))
1997 (put 'maple
'math-variable-table
2001 ( infinity . var-inf
)
2002 ( infinity . var-uinf
)
2003 ( infinity . var-nan
)
2006 (put 'maple
'math-complex-format
'I
)
2008 (put 'maple
'math-matrix-formatter
2013 math-comp-left-bracket
2014 (math-compose-vector (cdr a
)
2015 (concat math-comp-comma
" ")
2016 math-comp-vector-prec
)
2017 math-comp-right-bracket
2020 (put 'maple
'math-compose-subscr
2023 (let ((args (cdr (cdr a
))))
2025 (math-compose-expr (nth 1 a
) 1000)
2027 (math-compose-vector args
", " 0)
2030 (add-to-list 'calc-lang-allow-underscores
'maple
)
2031 (add-to-list 'calc-lang-brackets-are-subscripts
'maple
)
2033 (defun math-compose-maple-intv (a)
2035 (math-compose-expr (nth 2 a
) 0)
2037 (math-compose-expr (nth 3 a
) 0)))
2039 (defun math-read-maple-dots (x op
)
2040 (list 'intv
3 x
(math-read-expr-level (nth 3 op
))))
2043 ;; The variable math-read-big-lines is local to math-read-big-expr in
2044 ;; calc-ext.el, but is used by math-read-big-rec, math-read-big-char,
2045 ;; math-read-big-emptyp, math-read-big-error and math-read-big-balance,
2046 ;; which are called (directly and indirectly) by math-read-big-expr.
2047 ;; It is also local to math-read-big-bigp in calc-ext.el, which calls
2048 ;; math-read-big-balance.
2049 (defvar math-read-big-lines
)
2051 ;; The variables math-read-big-baseline and math-read-big-h2 are
2052 ;; local to math-read-big-expr in calc-ext.el, but used by
2053 ;; math-read-big-rec.
2054 (defvar math-read-big-baseline
)
2055 (defvar math-read-big-h2
)
2057 ;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2
2058 ;; are local to math-read-big-rec, but are used by math-read-big-char,
2059 ;; math-read-big-emptyp and math-read-big-balance which are called by
2060 ;; math-read-big-rec.
2061 ;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el,
2062 ;; which calls math-read-big-balance.
2068 (defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2
2069 &optional baseline prec short
)
2070 (or prec
(setq prec
0))
2072 ;; Clip whitespace above or below.
2073 (while (and (< math-rb-v1 math-rb-v2
)
2074 (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2
(1+ math-rb-v1
)))
2075 (setq math-rb-v1
(1+ math-rb-v1
)))
2076 (while (and (< math-rb-v1 math-rb-v2
)
2077 (math-read-big-emptyp math-rb-h1
(1- math-rb-v2
) math-rb-h2 math-rb-v2
))
2078 (setq math-rb-v2
(1- math-rb-v2
)))
2080 ;; If formula is a single line high, normal parser can handle it.
2081 (if (<= math-rb-v2
(1+ math-rb-v1
))
2082 (if (or (<= math-rb-v2 math-rb-v1
)
2083 (> math-rb-h1
(length (setq math-rb-v2
2084 (nth math-rb-v1 math-read-big-lines
)))))
2085 (math-read-big-error math-rb-h1 math-rb-v1
)
2086 (setq math-read-big-baseline math-rb-v1
2087 math-read-big-h2 math-rb-h2
2088 math-rb-v2
(nth math-rb-v1 math-read-big-lines
)
2089 math-rb-h2
(math-read-expr
2090 (substring math-rb-v2 math-rb-h1
2091 (min math-rb-h2
(length math-rb-v2
)))))
2092 (if (eq (car-safe math-rb-h2
) 'error
)
2093 (math-read-big-error (+ math-rb-h1
(nth 1 math-rb-h2
))
2094 math-rb-v1
(nth 2 math-rb-h2
))
2097 ;; Clip whitespace at left or right.
2098 (while (and (< math-rb-h1 math-rb-h2
)
2099 (math-read-big-emptyp math-rb-h1 math-rb-v1
(1+ math-rb-h1
) math-rb-v2
))
2100 (setq math-rb-h1
(1+ math-rb-h1
)))
2101 (while (and (< math-rb-h1 math-rb-h2
)
2102 (math-read-big-emptyp (1- math-rb-h2
) math-rb-v1 math-rb-h2 math-rb-v2
))
2103 (setq math-rb-h2
(1- math-rb-h2
)))
2105 ;; Scan to find widest left-justified "----" in the region.
2108 (lines-v1 (nthcdr math-rb-v1 math-read-big-lines
))
2112 other-char line len h
)
2113 (while (< v math-rb-v2
)
2115 len
(min math-rb-h2
(length line
)))
2116 (and (< math-rb-h1 len
)
2117 (/= (aref line math-rb-h1
) ?\
)
2118 (if (and (= (aref line math-rb-h1
) ?\-
)
2119 ;; Make sure it's not a minus sign.
2120 (or (and (< (1+ math-rb-h1
) len
)
2121 (= (aref line
(1+ math-rb-h1
)) ?\-
))
2122 (/= (math-read-big-char math-rb-h1
(1- v
)) ?\
)
2123 (/= (math-read-big-char math-rb-h1
(1+ v
)) ?\
)))
2126 (while (and (< (setq h
(1+ h
)) len
)
2127 (= (aref line h
) ?\-
)))
2131 (or other-v
(setq other-v v other-char
(aref line math-rb-h1
)))))
2135 (cond ((not (setq v other-v
))
2136 (math-read-big-error math-rb-h1 math-rb-v1
)) ; Should never happen!
2142 (let ((num (math-read-big-rec math-rb-h1 math-rb-v1 h v
))
2143 (den (math-read-big-rec math-rb-h1
(1+ v
) h math-rb-v2
)))
2144 (setq p
(if (and (math-integerp num
) (math-integerp den
))
2145 (math-make-frac num den
)
2146 (list '/ num den
)))))
2148 ;; Big radical sign.
2150 (or (= (math-read-big-char (1+ math-rb-h1
) v
) ?\|
)
2151 (math-read-big-error (1+ math-rb-h1
) v
"Malformed root sign"))
2152 (math-read-big-emptyp math-rb-h1 math-rb-v1
(1+ math-rb-h1
) v nil t
)
2153 (while (= (math-read-big-char (1+ math-rb-h1
) (setq v
(1- v
))) ?\|
))
2154 (or (= (math-read-big-char (setq h
(+ math-rb-h1
2)) v
) ?\_
)
2155 (math-read-big-error h v
"Malformed root sign"))
2156 (while (= (math-read-big-char (setq h
(1+ h
)) v
) ?\_
))
2157 (math-read-big-emptyp math-rb-h1 math-rb-v1
(1+ math-rb-h1
) v nil t
)
2158 (math-read-big-emptyp math-rb-h1
(1+ other-v
) h math-rb-v2 nil t
)
2159 (setq p
(list 'calcFunc-sqrt
(math-read-big-rec
2160 (+ math-rb-h1
2) (1+ v
)
2161 h
(1+ other-v
) baseline
))
2162 v math-read-big-baseline
))
2164 ;; Small radical sign.
2165 ((and (= other-char ?V
)
2166 (= (math-read-big-char (1+ math-rb-h1
) (1- v
)) ?\_
))
2167 (setq h
(1+ math-rb-h1
))
2168 (math-read-big-emptyp math-rb-h1 math-rb-v1 h
(1- v
) nil t
)
2169 (math-read-big-emptyp math-rb-h1
(1+ v
) h math-rb-v2 nil t
)
2170 (math-read-big-emptyp math-rb-h1 math-rb-v1
(1+ math-rb-h1
) v nil t
)
2171 (while (= (math-read-big-char (setq h
(1+ h
)) (1- v
)) ?\_
))
2172 (setq p
(list 'calcFunc-sqrt
(math-read-big-rec
2173 (1+ math-rb-h1
) v h
(1+ v
) t
))
2174 v math-read-big-baseline
))
2176 ;; Binomial coefficient.
2177 ((and (= other-char ?\
()
2178 (= (math-read-big-char (1+ math-rb-h1
) v
) ?\
)
2179 (= (string-match "( *)" (nth v math-read-big-lines
)
2180 math-rb-h1
) math-rb-h1
))
2181 (setq h
(match-end 0))
2182 (math-read-big-emptyp math-rb-h1 math-rb-v1
(1+ math-rb-h1
) v nil t
)
2183 (math-read-big-emptyp math-rb-h1
(1+ v
) (1+ math-rb-h1
) math-rb-v2 nil t
)
2184 (math-read-big-emptyp (1- h
) math-rb-v1 h v nil t
)
2185 (math-read-big-emptyp (1- h
) (1+ v
) h math-rb-v2 nil t
)
2186 (setq p
(list 'calcFunc-choose
2187 (math-read-big-rec (1+ math-rb-h1
) math-rb-v1
(1- h
) v
)
2188 (math-read-big-rec (1+ math-rb-h1
) (1+ v
)
2189 (1- h
) math-rb-v2
))))
2193 (setq p
(list 'neg
(math-read-big-rec (1+ math-rb-h1
) math-rb-v1
2194 math-rb-h2 math-rb-v2 v
250 t
))
2195 v math-read-big-baseline
2196 h math-read-big-h2
))
2200 (math-read-big-emptyp math-rb-h1 math-rb-v1
(1+ math-rb-h1
) v nil t
)
2201 (math-read-big-emptyp math-rb-h1
(1+ v
) (1+ math-rb-h1
) math-rb-v2 nil t
)
2202 (setq h
(math-read-big-balance (1+ math-rb-h1
) v
"(" t
))
2203 (math-read-big-emptyp (1- h
) math-rb-v1 h v nil t
)
2204 (math-read-big-emptyp (1- h
) (1+ v
) h math-rb-v2 nil t
)
2205 (let ((sep (math-read-big-char (1- h
) v
))
2210 (math-read-big-error (1- h
) v
"Expected `)'"))
2212 (setq p
(math-read-big-rec
2213 (1+ math-rb-h1
) math-rb-v1
(1- h
) math-rb-v2 v
))
2214 (setq hmid
(math-read-big-balance h v
"(")
2216 (math-read-big-rec h math-rb-v1
(1- hmid
) math-rb-v2 v
))
2219 (setq p
(cons 'intv
(cons (if (= (math-read-big-char
2224 ((= (math-read-big-char (1- h
) v
) ?\
])
2225 (math-read-big-error (1- h
) v
"Expected `)'"))
2227 (or (and (math-realp (car p
)) (math-realp (nth 1 p
)))
2228 (math-read-big-error
2229 math-rb-h1 v
"Complex components must be real"))
2230 (setq p
(cons 'cplx p
)))
2232 (or (and (math-realp (car p
)) (math-anglep (nth 1 p
)))
2233 (math-read-big-error
2234 math-rb-h1 v
"Complex components must be real"))
2235 (setq p
(cons 'polar p
)))))))
2238 ((and (= other-char ?\
[)
2239 (or (= (math-read-big-char (setq h math-rb-h1
) (1+ v
)) ?\
[)
2240 (= (math-read-big-char (setq h
(1+ h
)) v
) ?\
[)
2241 (and (= (math-read-big-char h v
) ?\
)
2242 (= (math-read-big-char (setq h
(1+ h
)) v
) ?\
[)))
2243 (= (math-read-big-char h
(1+ v
)) ?\
[))
2244 (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t
)
2250 (setq h
(math-read-big-balance (1+ hleft
) v
"["))
2253 (math-read-big-error hright v
"Expected `]'"))
2255 (setq p
(cons (math-read-big-rec
2256 hleft v h
(1+ v
)) p
))
2257 (and (memq (math-read-big-char h v
) '(?\ ?\
,))
2258 (= (math-read-big-char hleft
(1+ v
)) ?\
[)))
2260 (or (= hleft math-rb-h1
)
2262 (if (= (math-read-big-char h v
) ?\
)
2264 (and (= (math-read-big-char h v
) ?\
])
2266 (math-read-big-error (1- h
) v
"Expected `]'"))
2267 (if (= (math-read-big-char h vtop
) ?\
,)
2269 (math-read-big-emptyp math-rb-h1
(1+ v
) (1- h
) math-rb-v2 nil t
)
2270 (setq v
(+ vtop
(/ (- v vtop
) 2))
2271 p
(cons 'vec
(nreverse p
)))))
2275 (math-read-big-emptyp math-rb-h1 math-rb-v1
(1+ math-rb-h1
) v nil t
)
2276 (math-read-big-emptyp math-rb-h1
(1+ v
) (1+ math-rb-h1
) math-rb-v2 nil t
)
2280 (setq widest
(math-read-big-balance h v
"[" t
))
2281 (math-read-big-emptyp (1- h
) math-rb-v1 h v nil t
)
2282 (math-read-big-emptyp (1- h
) (1+ v
) h math-rb-v2 nil t
)
2283 (setq p
(cons (math-read-big-rec
2284 h math-rb-v1
(1- widest
) math-rb-v2 v
) p
)
2286 (= (math-read-big-char (1- h
) v
) ?\
,)))
2287 (setq widest
(math-read-big-char (1- h
) v
))
2288 (if (or (memq widest
'(?\
; ?\)))
2289 (and (eq widest ?\.
) (cdr p
)))
2290 (math-read-big-error (1- h
) v
"Expected `]'"))
2293 widest
(math-read-big-balance h v
"[")
2294 p
(nconc p
(list (math-read-big-rec
2295 h math-rb-v1
(1- widest
) math-rb-v2 v
)))
2297 p
(cons 'intv
(cons (if (= (math-read-big-char (1- h
) v
)
2301 (setq p
(cons 'vec
(nreverse p
)))))
2305 (setq line
(nth v math-read-big-lines
))
2306 (string-match ">" line math-rb-h1
)
2307 (setq h
(match-end 0))
2308 (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t
)
2309 (math-read-big-emptyp math-rb-h1
(1+ v
) h math-rb-v2 nil t
)
2310 (setq p
(math-read-big-rec math-rb-h1 v h
(1+ v
) v
)))
2312 ;; Variable name or function call.
2313 ((or (and (>= other-char ?a
) (<= other-char ?z
))
2314 (and (>= other-char ?A
) (<= other-char ?Z
))
2315 (and (>= other-char ?α
) (<= other-char ?ω
))
2316 (and (>= other-char ?Α
) (<= other-char ?Ω
)))
2317 (setq line
(nth v math-read-big-lines
))
2318 (string-match "\\([a-zA-Zα-ωΑ-Ω'_]+\\) *" line math-rb-h1
)
2319 (setq h
(match-end 1)
2320 widest
(match-end 0)
2321 p
(math-match-substring line
1))
2322 (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t
)
2323 (math-read-big-emptyp math-rb-h1
(1+ v
) h math-rb-v2 nil t
)
2324 (if (= (math-read-big-char widest v
) ?\
()
2326 (setq line
(if (string-match "-" p
)
2328 (intern (concat "calcFunc-" p
)))
2331 (math-read-big-emptyp widest math-rb-v1 h v nil t
)
2332 (math-read-big-emptyp widest
(1+ v
) h math-rb-v2 nil t
)
2334 (setq widest
(math-read-big-balance h v
"(" t
))
2335 (math-read-big-emptyp (1- h
) math-rb-v1 h v nil t
)
2336 (math-read-big-emptyp (1- h
) (1+ v
) h math-rb-v2 nil t
)
2337 (setq p
(cons (math-read-big-rec
2338 h math-rb-v1
(1- widest
) math-rb-v2 v
) p
)
2340 (= (math-read-big-char (1- h
) v
) ?\
,)))
2341 (or (= (math-read-big-char (1- h
) v
) ?\
))
2342 (math-read-big-error (1- h
) v
"Expected `)'"))
2343 (setq p
(cons line
(nreverse p
))))
2345 (intern (math-remove-dashes p
))
2346 (if (string-match "-" p
)
2348 (intern (concat "var-" p
)))))))
2352 (setq line
(nth v math-read-big-lines
))
2353 (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 math-rb-h1
) math-rb-h1
)
2354 (math-read-big-error h v
"Expected a number"))
2355 (setq h
(match-end 0)
2356 p
(math-read-number (math-match-substring line
0)))
2357 (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t
)
2358 (math-read-big-emptyp math-rb-h1
(1+ v
) h math-rb-v2 nil t
)))
2360 ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2;
2364 (math-read-big-error math-rb-h1 v
"Inconsistent baseline in formula"))
2367 ;; Look for superscripts or subscripts.
2368 (setq line
(nth baseline math-read-big-lines
)
2369 len
(min math-rb-h2
(length line
))
2371 (while (and (< widest len
)
2372 (= (aref line widest
) ?\
))
2373 (setq widest
(1+ widest
)))
2374 (and (>= widest len
) (setq widest math-rb-h2
))
2375 (if (math-read-big-emptyp h v widest math-rb-v2
)
2376 (if (math-read-big-emptyp h math-rb-v1 widest v
)
2378 (setq p
(list '^ p
(math-read-big-rec h math-rb-v1 widest v
))
2380 (if (math-read-big-emptyp h math-rb-v1 widest v
)
2381 (setq p
(list 'calcFunc-subscr p
2382 (math-read-big-rec h v widest math-rb-v2
))
2385 ;; Look for an operator name and grab additional terms.
2386 (while (and (< h len
)
2387 (if (setq widest
(and (math-read-big-emptyp
2388 h math-rb-v1
(1+ h
) v
)
2389 (math-read-big-emptyp
2390 h
(1+ v
) (1+ h
) math-rb-v2
)
2391 (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h
)
2392 (assoc (math-match-substring line
0)
2393 (math-standard-ops))))
2394 (and (>= (nth 2 widest
) prec
)
2395 (setq h
(match-end 0)))
2396 (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h
)
2398 (setq widest
'("2x" * 196 195)))))
2399 (cond ((eq (nth 3 widest
) -
1)
2400 (setq p
(list (nth 1 widest
) p
)))
2401 ((equal (car widest
) "?")
2402 (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2
2403 math-rb-v2 baseline nil t
)))
2404 (or (= (math-read-big-char math-read-big-h2 baseline
) ?\
:)
2405 (math-read-big-error math-read-big-h2 baseline
"Expected `:'"))
2406 (setq p
(list (nth 1 widest
) p y
2408 (1+ math-read-big-h2
) math-rb-v1 math-rb-h2 math-rb-v2
2409 baseline
(nth 3 widest
) t
))
2410 h math-read-big-h2
)))
2412 (setq p
(list (nth 1 widest
) p
2413 (math-read-big-rec h math-rb-v1 math-rb-h2 math-rb-v2
2414 baseline
(nth 3 widest
) t
))
2415 h math-read-big-h2
))))
2417 ;; Return all relevant information to caller.
2418 (setq math-read-big-baseline baseline
2420 (or short
(= math-read-big-h2 math-rb-h2
)
2421 (math-read-big-error h baseline
))
2424 (defun math-read-big-char (h v
)
2425 (or (and (>= h math-rb-h1
)
2429 (let ((line (nth v math-read-big-lines
)))
2435 (defun math-read-big-emptyp (eh1 ev1 eh2 ev2
&optional what error
)
2436 (and (< ev1 math-rb-v1
) (setq ev1 math-rb-v1
))
2437 (and (< eh1 math-rb-h1
) (setq eh1 math-rb-h1
))
2438 (and (> ev2 math-rb-v2
) (setq ev2 math-rb-v2
))
2439 (and (> eh2 math-rb-h2
) (setq eh2 math-rb-h2
))
2440 (or what
(setq what ?\
))
2441 (let ((p (nthcdr ev1 math-read-big-lines
))
2443 (while (and (< ev1 ev2
)
2445 (setq h
(min eh2
(length (car p
))))
2446 (while (and (>= (setq h
(1- h
)) eh1
)
2447 (= (aref (car p
) h
) what
)))
2448 (and error
(>= h eh1
)
2449 (math-read-big-error h ev1
(if (stringp error
)
2451 "Whitespace expected")))
2457 ;; math-read-big-err-msg is local to math-read-big-expr in calc-ext.el,
2458 ;; but is used by math-read-big-error which is called (indirectly) by
2459 ;; math-read-big-expr.
2460 (defvar math-read-big-err-msg
)
2462 (defun math-read-big-error (h v
&optional msg
)
2464 (p math-read-big-lines
))
2466 (setq pos
(+ pos
1 (length (car p
)))
2469 (setq h
(+ pos
(min h
(length (car p
))))
2470 math-read-big-err-msg
(list 'error h
(or msg
"Syntax error")))
2471 (throw 'syntax nil
)))
2473 (defun math-read-big-balance (h v what
&optional commas
)
2474 (let* ((line (nth v math-read-big-lines
))
2475 (len (min math-rb-h2
(length line
)))
2480 (math-read-big-error nil v
(format "Unmatched `%s'" what
))
2482 (if (memq (aref line h
) '(?\
( ?\
[))
2483 (setq count
(1+ count
))
2484 (if (if (and commas
(= count
1))
2485 (or (memq (aref line h
) '(?\
) ?\
] ?\
, ?\
;))
2486 (and (eq (aref line h
) ?\.
)
2488 (eq (aref line
(1+ h
)) ?\.
)))
2489 (memq (aref line h
) '(?\
) ?\
])))
2490 (setq count
(1- count
))))
2494 (provide 'calc-lang
)
2500 ;;; calc-lang.el ends here