1 | ;;;; -*- Mode: lisp -*- |
---|
2 | ;;;; |
---|
3 | ;;;; Copyright (c) 2007, 2008, 2011 Raymond Toy |
---|
4 | ;;;; |
---|
5 | ;;;; Permission is hereby granted, free of charge, to any person |
---|
6 | ;;;; obtaining a copy of this software and associated documentation |
---|
7 | ;;;; files (the "Software"), to deal in the Software without |
---|
8 | ;;;; restriction, including without limitation the rights to use, |
---|
9 | ;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell |
---|
10 | ;;;; copies of the Software, and to permit persons to whom the |
---|
11 | ;;;; Software is furnished to do so, subject to the following |
---|
12 | ;;;; conditions: |
---|
13 | ;;;; |
---|
14 | ;;;; The above copyright notice and this permission notice shall be |
---|
15 | ;;;; included in all copies or substantial portions of the Software. |
---|
16 | ;;;; |
---|
17 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
---|
18 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES |
---|
19 | ;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND |
---|
20 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT |
---|
21 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, |
---|
22 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING |
---|
23 | ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR |
---|
24 | ;;;; OTHER DEALINGS IN THE SOFTWARE. |
---|
25 | |
---|
26 | (in-package #:oct) |
---|
27 | |
---|
28 | (defconstant +pi+ |
---|
29 | (make-instance 'qd-real :value octi:+qd-pi+) |
---|
30 | "Pi represented as a QD-REAL") |
---|
31 | |
---|
32 | (defconstant +pi/2+ |
---|
33 | (make-instance 'qd-real :value octi:+qd-pi/2+) |
---|
34 | "Pi/2 represented as a QD-REAL") |
---|
35 | |
---|
36 | (defconstant +pi/4+ |
---|
37 | (make-instance 'qd-real :value octi:+qd-pi/4+) |
---|
38 | "Pi/4 represented as a QD-REAL") |
---|
39 | |
---|
40 | (defconstant +2pi+ |
---|
41 | (make-instance 'qd-real :value octi:+qd-2pi+) |
---|
42 | "2*pi represented as a QD-REAL") |
---|
43 | |
---|
44 | (defconstant +log2+ |
---|
45 | (make-instance 'qd-real :value octi:+qd-log2+) |
---|
46 | "Natural log of 2 represented as a QD-REAL") |
---|
47 | |
---|
48 | ;; How do we represent infinity for a QD-REAL? For now, we just make |
---|
49 | ;; the QD-REAL whose most significant part is infinity. Currently |
---|
50 | ;; only supported on CMUCL. |
---|
51 | #+cmu |
---|
52 | (defconstant +quad-double-float-positive-infinity+ |
---|
53 | (make-instance 'qd-real :value (make-qd-d ext:double-float-positive-infinity)) |
---|
54 | "One representation of positive infinity for QD-REAL") |
---|
55 | |
---|
56 | #+cmu |
---|
57 | (defconstant +quad-double-float-negative-infinity+ |
---|
58 | (make-instance 'qd-real :value (make-qd-d ext:double-float-negative-infinity)) |
---|
59 | "One representation of negative infinity for QD-REAL") |
---|
60 | |
---|
61 | (defconstant +most-positive-quad-double-float+ |
---|
62 | (make-instance 'qd-real |
---|
63 | :value (octi::%make-qd-d most-positive-double-float |
---|
64 | (cl:scale-float most-positive-double-float (cl:* 1 -53)) |
---|
65 | (cl:scale-float most-positive-double-float (cl:* 2 -53)) |
---|
66 | (cl:scale-float most-positive-double-float (cl:* 3 -53)))) |
---|
67 | "Most positive representable QD-REAL") |
---|
68 | |
---|
69 | (defconstant +least-positive-quad-double-float+ |
---|
70 | (make-instance 'qd-real |
---|
71 | :value (make-qd-d least-positive-double-float)) |
---|
72 | "Least positive QD-REAL") |
---|
73 | |
---|
74 | ;; Not sure this is 100% correct, but I think if the first component |
---|
75 | ;; is any smaller than this, the last component would no longer be a |
---|
76 | ;; normalized double-float. |
---|
77 | (defconstant +least-positive-normalized-quad-double-float+ |
---|
78 | (make-instance 'qd-real |
---|
79 | :value (make-qd-d (cl:scale-float least-positive-normalized-double-float (cl:* 3 53)))) |
---|
80 | "Least positive normalized QD-REAL") |
---|
81 | |
---|
82 | (defconstant +qd-real-one+ |
---|
83 | (make-instance 'qd-real :value (make-qd-d 1d0)) |
---|
84 | "QD-REAL representation of 1") |
---|
85 | |
---|
86 | (defconstant +%gamma+ |
---|
87 | (make-instance 'qd-real :value octi::+qd-%gamma+) |
---|
88 | "Euler's constant") |
---|