src/transf.lisp

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