[gimp] R5RS compatibility fix for min and max (SourceForge bug #3399331) They are required to return inexac



commit 5d61a737a7a6006f88566b36040db4fabb87db92
Author: Kevin Cozens <kcozens svn gnome org>
Date:   Mon Aug 29 15:21:28 2011 -0400

    R5RS compatibility fix for min and max (SourceForge bug #3399331)
    They are required to return inexact when any argument is inexact.
    (From a patch by Doug Currie.)  Also de-tabified init.scm file.

 plug-ins/script-fu/tinyscheme/init.scm |   69 ++++++++++++++++++-------------
 1 files changed, 40 insertions(+), 29 deletions(-)
---
diff --git a/plug-ins/script-fu/tinyscheme/init.scm b/plug-ins/script-fu/tinyscheme/init.scm
index f0d5d14..1443d21 100644
--- a/plug-ins/script-fu/tinyscheme/init.scm
+++ b/plug-ins/script-fu/tinyscheme/init.scm
@@ -70,10 +70,21 @@
 (define (abs n) (if (>= n 0) n (- n)))
 (define (exact->inexact n) (* n 1.0))
 (define (<> n1 n2) (not (= n1 n2)))
+
+; min and max must return inexact if any arg is inexact; use (+ n 0.0)
 (define (max . lst)
-     (foldr (lambda (a b) (if (> a b) a b)) (car lst) (cdr lst)))
+  (foldr (lambda (a b)
+           (if (> a b)
+             (if (exact? b) a (+ a 0.0))
+             (if (exact? a) b (+ b 0.0))))
+         (car lst) (cdr lst)))
 (define (min . lst)
-     (foldr (lambda (a b) (if (< a b) a b)) (car lst) (cdr lst)))
+  (foldr (lambda (a b)
+           (if (< a b)
+             (if (exact? b) a (+ a 0.0))
+             (if (exact? a) b (+ b 0.0))))
+         (car lst) (cdr lst)))
+
 (define (succ x) (+ x 1))
 (define (pred x) (- x 1))
 (define gcd
@@ -382,16 +393,16 @@
                ;;Exit the old list.  Do deeper ones last.  Don't do
                ;;any shared ones.
                (define (pop-many)
-        	  (unless (eq? *active-windings* shared)
-        	     (deactivate-top-winding!)
-        	     (pop-many)))
+                  (unless (eq? *active-windings* shared)
+                     (deactivate-top-winding!)
+                     (pop-many)))
                ;;Enter the new list.  Do deeper ones first so that the
                ;;deeper windings will already be active.  Don't do any
                ;;shared ones.
                (define (push-many new-ws)
-        	  (unless (eq? new-ws shared)
-        	     (push-many (cdr new-ws))
-        	     (activate-winding! (car new-ws))))
+                  (unless (eq? new-ws shared)
+                     (push-many (cdr new-ws))
+                     (activate-winding! (car new-ws))))
 
                ;;Do it.
                (pop-many)
@@ -402,20 +413,20 @@
          `(define call-with-current-continuation
              ;;It internally uses the built-in call/cc, so capture it.
              ,(let ((old-c/cc call-with-current-continuation))
-        	 (lambda (func)
-        	    ;;Use old call/cc to get the continuation.
-        	    (old-c/cc
-        	       (lambda (continuation)
-        		  ;;Call func with not the continuation itself
-        		  ;;but a procedure that adjusts the active
-        		  ;;windings to what they were when we made
-        		  ;;this, and only then calls the
-        		  ;;continuation.
-        		  (func
-        		     (let ((current-ws *active-windings*))
-        			(lambda (x)
-        			   (set-active-windings! current-ws)
-        			   (continuation x)))))))))
+                 (lambda (func)
+                    ;;Use old call/cc to get the continuation.
+                    (old-c/cc
+                       (lambda (continuation)
+                          ;;Call func with not the continuation itself
+                          ;;but a procedure that adjusts the active
+                          ;;windings to what they were when we made
+                          ;;this, and only then calls the
+                          ;;continuation.
+                          (func
+                             (let ((current-ws *active-windings*))
+                                (lambda (x)
+                                   (set-active-windings! current-ws)
+                                   (continuation x)))))))))
          outer-env)
       ;;We can't just say "define (dynamic-wind before thunk after)"
       ;;because the lambda it's defined to lives in this environment,
@@ -423,13 +434,13 @@
       (eval
          `(define dynamic-wind
              ,(lambda (before thunk after)
-        	 ;;Make a new winding
-        	 (activate-winding! (make-winding before after))
-        	 (let ((result (thunk)))
-        	    ;;Get rid of the new winding.
-        	    (deactivate-top-winding!)
-        	    ;;The return value is that of thunk.
-        	    result)))
+                 ;;Make a new winding
+                 (activate-winding! (make-winding before after))
+                 (let ((result (thunk)))
+                    ;;Get rid of the new winding.
+                    (deactivate-top-winding!)
+                    ;;The return value is that of thunk.
+                    result)))
          outer-env)))
 
 (define call/cc call-with-current-continuation)



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]