[oct-scm] [oct-git]OCT: A portable Lisp implementation for quad-double precision floats branch master updated. 68432cb1855605c346216788f1aa64517a96a808

Raymond Toy rtoy at common-lisp.net
Tue Mar 8 14:20:28 UTC 2011


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "OCT:  A portable Lisp implementation for quad-double precision floats".

The branch, master has been updated
       via  68432cb1855605c346216788f1aa64517a96a808 (commit)
       via  3d37e3b9346092b58e820723ae20f114dc912d44 (commit)
      from  6c91244701c5867328a58c94d2118db6e09310d1 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 68432cb1855605c346216788f1aa64517a96a808
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Tue Mar 8 09:02:42 2011 -0500

    Oops.  Remove the #q reader functions from here.
    
    They've been moved to qd-reader.lisp.

diff --git a/qd-methods.lisp b/qd-methods.lisp
index 4f8065f..6f41857 100644
--- a/qd-methods.lisp
+++ b/qd-methods.lisp
@@ -1064,36 +1064,6 @@ underlying floating-point format"
   (frob two-arg-* cl:* mul-qd mul-d-qd mul-qd-d)
   (frob two-arg-/ cl:/ div-qd nil nil))
   
-
-(defun read-qd-real-or-complex (stream)
-  (let ((c (peek-char t stream)))
-    (cond ((char= c #\()
-	   ;; Read a QD complex
-	   (read-char stream)		; Skip the paren
-	   (let ((real (read stream t nil t))
-		 (imag (read stream t nil t)))
-	     (unless (char= (peek-char t stream) #\))
-	       (error "Illegal QD-COMPLEX number format"))
-	     ;; Read closing paren
-	     (read-char stream)
-	     (make-instance 'qd-complex
-			    :real (qd-value (float real +qd-real-one+))
-			    :imag (qd-value (float imag +qd-real-one+)))))
-	  (t
-	   (make-instance 'qd-real :value (read-qd stream))))))
-	
-(defun qd-class-reader (stream subchar arg)
-  (declare (ignore subchar))
-  (when arg
-    (warn "Numeric argument ignored in #~DQ" arg))
-  (read-qd-real-or-complex stream))
-
-;; Yow!  We redefine the #q reader that is in qd-io.lisp to read in
-;; and make a real qd-real float, instead of the hackish
-;; %qd-real.
-(set-dispatch-macro-character #\# #\Q #'qd-class-reader)
-
-
 (defmethod epsilon ((m cl:float))
   (etypecase m
     (single-float single-float-epsilon)

commit 3d37e3b9346092b58e820723ae20f114dc912d44
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Tue Mar 8 09:01:06 2011 -0500

    Move #Q reader functions to new file qd-reader.lisp.
    
    qd-reader.lisp:
    o New file containing #Q reader functions.
    o Create a new readtable containing our reader functions so we don't
      destructively modify the default *readtable*.
    
    oct.asd:
    o Add qd-reader.lisp.
    
    qd-complex.lisp:
    qd-elliptic.lisp:
    qd-format.lisp:
    o Set the *readtable* to *oct-readtable* before compiling these
      files.

diff --git a/oct.asd b/oct.asd
index 153706c..77828aa 100644
--- a/oct.asd
+++ b/oct.asd
@@ -54,12 +54,14 @@
 	  :depends-on ("qd-fun"))
    (:file "qd-methods"
 	  :depends-on ("qd-class"))
-   (:file "qd-format"
+   (:file "qd-reader"
 	  :depends-on ("qd-methods"))
+   (:file "qd-format"
+	  :depends-on ("qd-methods" "qd-reader"))
    (:file "qd-complex"
-	  :depends-on ("qd-methods"))
+	  :depends-on ("qd-methods" "qd-reader"))
    (:file "qd-elliptic"
-	  :depends-on ("qd-methods"))
+	  :depends-on ("qd-methods" "qd-reader"))
    ))
 
 (defmethod perform ((op test-op) (c (eql (find-system :oct))))
diff --git a/qd-complex.lisp b/qd-complex.lisp
index 2a2aaf7..409e94f 100644
--- a/qd-complex.lisp
+++ b/qd-complex.lisp
@@ -25,6 +25,9 @@
 
 (in-package #:oct)
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* *oct-readtable*))
+
 (defmethod add1 ((a qd-complex))
   (make-instance 'qd-complex
 		 :real (add-qd-d (qd-value (realpart a)) 1d0)
diff --git a/qd-elliptic.lisp b/qd-elliptic.lisp
index 3336444..2fadecd 100644
--- a/qd-elliptic.lisp
+++ b/qd-elliptic.lisp
@@ -24,6 +24,9 @@
 
 (in-package #:oct)
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* *oct-readtable*))
+
 (declaim (inline descending-transform ascending-transform))
 
 (defun ascending-transform (u m)
diff --git a/qd-format.lisp b/qd-format.lisp
index a63d814..5ae5289 100644
--- a/qd-format.lisp
+++ b/qd-format.lisp
@@ -25,6 +25,9 @@
 
 (in-package #:oct)
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* *oct-readtable*))
+
 (defun qd-scale-exponent (original-x)
   (let* ((x original-x))
     (multiple-value-bind (sig exponent)
diff --git a/qd-reader.lisp b/qd-reader.lisp
new file mode 100644
index 0000000..d2159ea
--- /dev/null
+++ b/qd-reader.lisp
@@ -0,0 +1,58 @@
+;;;; -*- 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)
+
+
+
+(defun read-qd-real-or-complex (stream)
+  (let ((c (peek-char t stream)))
+    (cond ((char= c #\()
+	   ;; Read a QD complex
+	   (read-char stream)		; Skip the paren
+	   (let ((real (read stream t nil t))
+		 (imag (read stream t nil t)))
+	     (unless (char= (peek-char t stream) #\))
+	       (error "Illegal QD-COMPLEX number format"))
+	     ;; Read closing paren
+	     (read-char stream)
+	     (make-instance 'qd-complex
+			    :real (qd-value (float real +qd-real-one+))
+			    :imag (qd-value (float imag +qd-real-one+)))))
+	  (t
+	   (make-instance 'qd-real :value (read-qd stream))))))
+	
+(defun qd-class-reader (stream subchar arg)
+  (declare (ignore subchar))
+  (when arg
+    (warn "Numeric argument ignored in #~DQ" arg))
+  (read-qd-real-or-complex stream))
+
+(defvar *oct-readtable*
+  (let ((rt (copy-readtable nil)))
+    (set-dispatch-macro-character #\# #\Q #'qd-class-reader rt)
+    rt)
+  "Readtable that extends the standard readtable to include #q for
+  reading QD-REAL and QD-COMPLEX numbers")

-----------------------------------------------------------------------

Summary of changes:
 oct.asd                           |    8 +++--
 qd-complex.lisp                   |    3 ++
 qd-elliptic.lisp                  |    3 ++
 qd-format.lisp                    |    3 ++
 qd-methods.lisp                   |   30 ----------------------
 oct-test.system => qd-reader.lisp |   50 +++++++++++++++++++++++-------------
 6 files changed, 46 insertions(+), 51 deletions(-)
 copy oct-test.system => qd-reader.lisp (51%)


hooks/post-receive
-- 
OCT:  A portable Lisp implementation for quad-double precision floats




More information about the oct-cvs mailing list