[gimp] R5RS compatibility fix for min and max (SourceForge bug #3399331) They are required to return inexac
- From: Kevin Cozens <kcozens src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [gimp] R5RS compatibility fix for min and max (SourceForge bug #3399331) They are required to return inexac
- Date: Mon, 29 Aug 2011 21:27:24 +0000 (UTC)
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]