← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to src/transf.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
Import upstream version 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/transf.lisp
9
9
;;;       (c) Copyright 1980 Massachusetts Institute of Technology       ;;;
10
10
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11
11
 
12
 
(in-package "MAXIMA")
 
12
(in-package :maxima)
13
13
;;; TRANSLATION PROPERTIES FOR MACSYMA OPERATORS AND FUNCTIONS.
14
14
 
15
15
;;; This file is for list and array manipulation optimizations.
17
17
(macsyma-module transf)
18
18
 
19
19
 
20
 
(TRANSL-MODULE TRANSF)
 
20
(transl-module transf)
21
21
 
22
22
;;; some floating point translations. with tricks.
23
23
 
24
 
(DEF%TR %LOG (FORM) 
25
 
  (LET   (ARG)
26
 
    (SETQ ARG (TRANSLATE (CADR FORM)))
27
 
    (COND ((AND (EQ (CAR ARG) '$FLOAT) (GET (CAAR FORM) 'LISP-FUNCTION-TO-USE))
28
 
           `($FLOAT ,(GET (CAAR FORM) 'LISP-FUNCTION-TO-USE) ,(CDR ARG)))
29
 
          (T `($ANY SIMPLIFY (LIST ',(LIST (CAAR FORM)) ,(CDR ARG)))))))
 
24
(def%tr %log (form) 
 
25
  (let   (arg)
 
26
    (setq arg (translate (cadr form)))
 
27
    (cond ((and (eq (car arg) '$float) (get (caar form) 'lisp-function-to-use))
 
28
           `($float ,(get (caar form) 'lisp-function-to-use) ,(cdr arg)))
 
29
          (t `($any simplify (list ',(list (caar form)) ,(cdr arg)))))))
30
30
 
31
 
(DEF-SAME%TR %SIN %LOG)
32
 
(DEF-SAME%TR %COS %LOG)
33
 
(DEF-SAME%TR %TAN %LOG)
34
 
(DEF-SAME%TR %COT %LOG)
35
 
(DEF-SAME%TR %CSC %LOG)
36
 
(DEF-SAME%TR %SEC %LOG)
37
 
(DEF-SAME%TR %ACOT %LOG)
38
 
(DEF-SAME%TR %SINH %LOG)
39
 
(DEF-SAME%TR %COSH %LOG)
40
 
(DEF-SAME%TR %TANH %LOG)
41
 
(DEF-SAME%TR %COTH %LOG)
42
 
(DEF-SAME%TR %CSCH %LOG)
43
 
(DEF-SAME%TR %SECH %LOG)
44
 
(DEF-SAME%TR %ASINH %LOG)
45
 
(DEF-SAME%TR %ACSCH %LOG)
46
 
(DEF-SAME%TR %ERF %LOG)
 
31
(def-same%tr %sin %log)
 
32
(def-same%tr %cos %log)
 
33
(def-same%tr %tan %log)
 
34
(def-same%tr %cot %log)
 
35
(def-same%tr %csc %log)
 
36
(def-same%tr %sec %log)
 
37
(def-same%tr %acot %log)
 
38
(def-same%tr %sinh %log)
 
39
(def-same%tr %cosh %log)
 
40
(def-same%tr %tanh %log)
 
41
(def-same%tr %coth %log)
 
42
(def-same%tr %csch %log)
 
43
(def-same%tr %sech %log)
 
44
(def-same%tr %asinh %log)
 
45
(def-same%tr %acsch %log)
 
46
(def-same%tr %erf %log)
47
47
 
48
48
(comment not used
49
 
; defsubr1 is also obsolete. see DEF-PROCEDURE-PROPERTY.
50
 
(DEFsubr1 TRANSLATE-$NUMBER (FORM) 
51
 
  (LET   (ARG)
52
 
    (SETQ ARG (TRANSLATE (CADR FORM)))
53
 
    (IF (AND (COVERS '$NUMBER (CAR ARG)) (GET (CAAR FORM) 'LISP-FUNCTION-TO-USE))
54
 
        (LIST (CAR ARG) (GET (CAAR FORM) 'LISP-FUNCTION-TO-USE) (CDR ARG))
55
 
        (CONS (CAR ARG) `(SIMPLIFY (LIST ',(LIST (CAAR FORM)) ,(CDR ARG))))))))
 
49
         ;; defsubr1 is also obsolete. see DEF-PROCEDURE-PROPERTY.
 
50
         (defsubr1 translate-$number (form) 
 
51
           (let   (arg)
 
52
             (setq arg (translate (cadr form)))
 
53
             (if (and (covers '$number (car arg)) (get (caar form) 'lisp-function-to-use))
 
54
                 (list (car arg) (get (caar form) 'lisp-function-to-use) (cdr arg))
 
55
                 (cons (car arg) `(simplify (list ',(list (caar form)) ,(cdr arg))))))))
56
56
 
57
57
 
58
 
(DEFMVAR $TR_FLOAT_CAN_BRANCH_COMPLEX T
59
 
         "States wether the arc functions might return complex
 
58
(defmvar $tr_float_can_branch_complex t
 
59
  "States wether the arc functions might return complex
60
60
         results. The arc functions are SQRT,LOG,ACOS, etc.
61
61
         e.g. When it is TRUE then ACOS(X) will be of mode ANY even if X is
62
62
         of mode FLOAT. When FALSE then ACOS(X) will be of mode FLOAT
63
63
         if and only if X is of mode FLOAT.")
64
64
 
65
 
(def%TR %ACOS (form)
66
 
  (LET ((arg (translate (cadr form))))
 
65
(def%tr %acos (form)
 
66
  (let ((arg (translate (cadr form))))
67
67
    (cond ((and (eq (car arg) '$float)
68
68
                (get (caar form) 'lisp-function-to-use))
69
 
           `(,(cond ($TR_FLOAT_CAN_BRANCH_COMPLEX
70
 
                     '$ANY)
71
 
                    (T '$FLOAT))
72
 
             . (,(GET (CAAR FORM) 'LISP-FUNCTION-TO-USE)
73
 
                ,(CDR ARG))))
74
 
          (T
75
 
           `($ANY . (SIMPLIFY (LIST '(,(CAAR FORM)) ,(CDR ARG))))))))
 
69
           `(,(cond ($tr_float_can_branch_complex
 
70
                     '$any)
 
71
                    (t '$float))
 
72
             . (,(get (caar form) 'lisp-function-to-use)
 
73
                ,(cdr arg))))
 
74
          (t
 
75
           `($any . (simplify (list '(,(caar form)) ,(cdr arg))))))))
76
76
 
77
 
(DEF-SAME%TR %ASIN %ACOS)
78
 
(DEF-SAME%TR %ASEC %ACOS)
79
 
(DEF-SAME%TR %ASEC %ACOS)
80
 
(DEF-SAME%TR %ACSC %ACOS)
 
77
(def-same%tr %asin %acos)
 
78
(def-same%tr %asec %acos)
 
79
(def-same%tr %asec %acos)
 
80
(def-same%tr %acsc %acos)
81
81