;;;; -*- Mode: lisp -*- ;;;; ;;;; Copyright (c) 2007, 2008, 2011 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation ;;;; files (the "Software"), to deal in the Software without ;;;; restriction, including without limitation the rights to use, ;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell ;;;; copies of the Software, and to permit persons to whom the ;;;; Software is furnished to do so, subject to the following ;;;; conditions: ;;;; ;;;; The above copyright notice and this permission notice shall be ;;;; included in all copies or substantial portions of the Software. ;;;; ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES ;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. (in-package #:oct) (define-symbol-macro * cl:*) (define-symbol-macro - cl:-) (define-symbol-macro / cl:/) (defclass qd-real () ((qd :initform +qd-zero+ :reader qd-value :initarg :value :type %quad-double)) (:documentation "QUAD-DOUBLE real number")) (defclass qd-complex () ((real :initform +qd-zero+ :reader qd-real :initarg :real :type %quad-double) (imag :initform +qd-zero+ :reader qd-imag :initarg :imag :type %quad-double)) (:documentation "Complex number consisting of QUAD-DOUBLE components")) (defmethod print-object ((qd qd-real) stream) (format stream "~/octi::qd-format/" (qd-value qd))) (defmethod make-qd ((x cl:float)) (make-instance 'qd-real :value (make-qd-d (float x 1d0)))) (defmethod make-qd ((x qd-real)) (make-instance 'qd-real :value (qd-value x))) (defmethod print-object ((qd qd-complex) stream) (format stream "#q(~<~/octi::qd-format/ ~/octi::qd-format/~:@>)" (list (qd-real qd) (qd-imag qd)))) #+(or) (defmethod print-object ((qd qd-complex) stream) (write-string "#q(" stream) (print-qd (qd-real qd) stream) (write-char #\space stream) (print-qd (qd-imag qd) stream) (write-string ")" stream)) (defmethod qd-value ((x real)) (make-qd-d (float x 1d0))) (defmethod make-load-form ((qd qd-real) &optional environment) (declare (ignore environment)) `(make-instance ',(class-of qd) :value ',(qd-value qd))) (defmethod make-load-form ((qd qd-complex) &optional environment) (declare (ignore environment)) `(make-instance ',(class-of qd) :real ',(qd-value (realpart qd)) :imag ',(qd-value (imagpart qd)))) (defmethod describe-object ((q qd-real) stream) (multiple-value-bind (q0 q1 q2 q3) (qd-parts (qd-value q)) (format stream "~&~S is a QD-REAL with components ~ ~% ~A, ~A, ~A, ~A~%" q q0 q1 q2 q3))) (defmethod describe-object ((q qd-complex) stream) (format stream "~&~S is a QD-COMPLEX" q) (format stream "~&It has components~&REAL: ") (describe (realpart q)) (format stream "~&IMAG: ") (describe (imagpart q))) (defgeneric add1 (a) (:documentation "Add 1")) (defgeneric sub1 (a) (:documentation "Subtract 1")) (defgeneric two-arg-+ (a b) (:documentation "A + B")) (defgeneric two-arg-- (a b) (:documentation "A - B")) (defgeneric two-arg-* (a b) (:documentation "A * B")) (defgeneric two-arg-/ (a b) (:documentation "A / B")) (defgeneric two-arg-< (a b) (:documentation "A < B")) (defgeneric two-arg-> (a b) (:documentation "A > B")) (defgeneric two-arg-<= (a b) (:documentation "A <= B")) (defgeneric two-arg->= (a b) (:documentation "A >= B")) (defgeneric two-arg-= (a b) (:documentation "A = B?")) (defgeneric unary-minus (a) (:documentation "-A")) (defgeneric unary-divide (a) (:documentation "1 / A")) (defgeneric qzerop (a) (:documentation "A = 0?")) (defgeneric qplusp (a) (:documentation "A > 0")) (defgeneric qminusp (a) (:documentation "A < 0")) (defgeneric qfloat (x ftype) (:documentation "Convert X to a float of the same type a FLOAT")) (defgeneric qrealpart (x) (:documentation "The real part of X")) (defgeneric qimagpart (x) (:documentation "The imaginary part of X")) (defgeneric qconjugate (z) (:documentation "The complex conjugate of Z")) (defgeneric qscale-float (x n) (:documentation "Multiply the float X by 2^N")) (defgeneric abs (x) (:documentation "Absolute value of X")) (defgeneric exp (x) (:documentation "Exponential of X")) (defgeneric sin (x) (:documentation "Sine of X")) (defgeneric cos (x) (:documentation "Cosine of X")) (defgeneric tan (x) (:documentation "Tangent of X")) (defgeneric sinh (x) (:documentation "Hyperbolic sine of X")) (defgeneric cosh (x) (:documentation "Hyperbolic cosine of X")) (defgeneric tanh (x) (:documentation "Hyperbolic tangent of X")) (defgeneric sqrt (x) (:documentation "Square root of X")) (defgeneric log (a &optional b) (:documentation "Log of A base B. If B not given, then natural log")) (defgeneric log1p (x) (:documentation "log(1+x)")) (defgeneric atan (y &optional x) (:documentation "If X not given, atan(y). If X is given, atan(y/x), taking the quadrant into account")) (defgeneric qexpt (x y) (:documentation "X^Y")) (defgeneric qcomplex (x y) (:documentation "Create a complex number with components X and Y.")) (defgeneric qinteger-decode-float (f) (:documentation "integer-decode-float")) (defgeneric qdecode-float (f) (:documentation "decode-float")) (defgeneric qfloor (x &optional y)) (defgeneric qffloor (x &optional y)) (defgeneric %unary-round (x)) (defgeneric qfloat-sign (a &optional b) (:documentation "Transfer sign of A to B. If B not given, assume 1")) (defgeneric asin (x) (:documentation "Inverse sine of X")) (defgeneric acos (x) (:documentation "Inverse cosine of X")) (defgeneric acosh (x) (:documentation "Inverse hyperbolic cosine of X")) (defgeneric atanh (x) (:documentation "Inverse hyperbolic tangent of X")) (defgeneric cis (x) (:documentation "(complex (cos x) (sin x))")) (defgeneric phase (x) (:documentation "Phase of X")) (defgeneric coerce (x type) (:documentation "COERCE")) (defgeneric random (x &optional state) (:documentation "RANDOM"))