/[gcl]/gcl/ansi-tests/ansi-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/ansi-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.115 by pfdietz, Sat Apr 30 21:33:22 2005 UTC revision 1.116 by pfdietz, Sun May 1 01:33:08 2005 UTC
# Line 324  the condition to go uncaught if it canno Line 324  the condition to go uncaught if it canno
324           (or (not (second results))           (or (not (second results))
325               (not (first results))))))               (not (first results))))))
326    
327  (declaim (ftype (function (&rest function) (values function &optional))  ;; (declaim (ftype (function (&rest function) (values function &optional))
328                  compose))  ;;              compose))
329    
330  (defun compose (&rest fns)  (defun compose (&rest fns)
331    (let ((rfns (reverse fns)))    (let ((rfns (reverse fns)))
# Line 1039  the condition to go uncaught if it canno Line 1039  the condition to go uncaught if it canno
1039  ;;; Approximate equality function  ;;; Approximate equality function
1040  (defun approx= (x y &optional (eps (epsilon x)))  (defun approx= (x y &optional (eps (epsilon x)))
1041    (<= (abs (/ (- x y) (max (abs x) 1))) eps))    (<= (abs (/ (- x y) (max (abs x) 1))) eps))
1042    
1043    (defun epsilon (number)
1044      (etypecase number
1045        (complex (* 2 (epsilon (realpart number)))) ;; crude
1046        (short-float short-float-epsilon)
1047        (single-float single-float-epsilon)
1048        (double-float double-float-epsilon)
1049        (long-float long-float-epsilon)
1050        (rational 0)))
1051    
1052    (defun negative-epsilon (number)
1053      (etypecase number
1054        (complex (* 2 (negative-epsilon (realpart number)))) ;; crude
1055        (short-float short-float-negative-epsilon)
1056        (single-float single-float-negative-epsilon)
1057        (double-float double-float-negative-epsilon)
1058        (long-float long-float-negative-epsilon)
1059        (rational 0)))

Legend:
Removed from v.1.115  
changed lines
  Added in v.1.116

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26