src/transf.lisp

   1 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;;     The data in this file contains enhancements.                   ;;;;;
   4 ;;;                                                                    ;;;;;
   5 ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
   6 ;;;     All rights reserved                                            ;;;;;
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9 ;;;       (c) Copyright 1980 Massachusetts Institute of Technology       ;;;
  10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11
  12 (in-package :maxima)
  13
  14 (macsyma-module transf)
  15
  16 (defmvar $tr_float_can_branch_complex t
  17   "States whether the arc functions might return complex results. The
  18 arc functions are SQRT,LOG,ACOS, etc. e.g. When it is TRUE then
  19 ACOS(X) will be of mode ANY even if X is of mode FLOAT. When FALSE
  20 then ACOS(X) will be of mode FLOAT if and only if X is of mode FLOAT.")
  21
  22
  23 ;;; some floating point translations. with tricks.
  24
  25 (defun translate-with-flonum-op (form can-branch-p)
  26   (let ((arg (translate (cadr form)))
  27         (lisp-function (gethash (caar form) *flonum-op*)))
  28     (if (and (eq (car arg) '$float)
  29              lisp-function)
  30         (let ((call `(funcall ,lisp-function ,(cdr arg))))
  31           (if (and can-branch-p
  32                    $tr_float_can_branch_complex)
  33               `($any . (complexify ,call))
  34               `($float . ,call)))
  35         `($any . (simplify (list '(,(caar form)) ,(cdr arg)))))))
  36
  37 (def%tr %sin (form)
  38   (translate-with-flonum-op form nil))
  39
  40 (def-same%tr %cos %sin)
  41 (def-same%tr %tan %sin)
  42 (def-same%tr %cot %sin)
  43 (def-same%tr %csc %sin)
  44 (def-same%tr %sec %sin)
  45 (def-same%tr %acot %sin)
  46 (def-same%tr %sinh %sin)
  47 (def-same%tr %cosh %sin)
  48 (def-same%tr %tanh %sin)
  49 (def-same%tr %coth %sin)
  50 (def-same%tr %csch %sin)
  51 (def-same%tr %sech %sin)
  52 (def-same%tr %asinh %sin)
  53 (def-same%tr %acsch %sin)
  54 (def-same%tr %atan %sin)
  55 (def-same%tr %erf %sin)
  56 (def-same%tr %exp %sin)
  57
  58 (def%tr %acos (form)
  59   (translate-with-flonum-op form t))
  60
  61 (def-same%tr %asin %acos)
  62 (def-same%tr %asec %acos)
  63 (def-same%tr %acsc %acos)
  64 (def-same%tr %acosh %acos)
  65 (def-same%tr %asech %acos)
  66 (def-same%tr %atanh %acos)
  67 (def-same%tr %acoth %acos)
  68 (def-same%tr %log %acos)
  69 (def-same%tr %sqrt %acos)