From ce14a71a291fb31a346d42bbbe76019efb73f290 Mon Sep 17 00:00:00 2001
From: Itamar Ben Zaken <itamar@itamar-desktop.(none)>
Date: Tue, 17 Mar 2009 09:46:18 +0200
Subject: [PATCH] updated from Mayer's website

---
 src/scm/support-code.scm | 34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/src/scm/support-code.scm b/src/scm/support-code.scm
index 16956dd..f75b8b4 100644
--- a/src/scm/support-code.scm
+++ b/src/scm/support-code.scm
@@ -20,12 +20,20 @@
 ;;;   (set! binary<? (lambda (a b) (< a b)))
 ;;;   (set! binary=? (lambda (a b) (= a b))))
 
+;;; Use this procedure for boxing your variables
+;;; when removing set! during the semantic analysis
+;(define box
+;  (lambda (x)
+;    (let ((v (make-vector 1)))
+;      (vector-set! v 0 x)
+;      v)))
+
 (define foldr
   (lambda (binop final s)
-    (letrec ((loop (lambda (s)
-                     (if (null? s)
-                         final
-                         (binop (car s) (loop (cdr s)))))))
+    (letrec ((loop
+	      (lambda (s)
+		(if (null? s) final
+		    (binop (car s) (loop (cdr s)))))))
       (loop s))))
 
 (define add1 (lambda (n) (binary-add n 1)))
@@ -60,7 +68,7 @@
   (let ((binary>=?
 	 (lambda (a b)
 	   (or (binary=? a b)
-	       (binary>? a b)))))
+	       (binary<? b a)))))
     (order binary>=?)))
 
 (define = (order binary=?))
@@ -163,17 +171,15 @@
   (let ((char-aA (- (char->integer #\a) (char->integer #\A))))
     (lambda (ch)
       (if (char-lowercase? ch)
-	      (integer->char
-	        (- (integer->char ch) char-aA))
-          ch))))
+	  (integer->char
+	   (- (char->integer ch) char-aA))))))
 
 (define char-downcase
   (let ((char-aA (- (char->integer #\a) (char->integer #\A))))
     (lambda (ch)
       (if (char-uppercase? ch)
-	      (integer->char
-	        (+ (integer->char ch) char-aA))
-          ch))))
+	  (integer->char
+	   (+ (char->integer ch) char-aA))))))
 
 (define char-ci<=?
   (order
@@ -424,9 +430,3 @@
   (lambda s
     (/ (apply * s)
        (apply gcd s))))
-
-;(define box
-;  (lambda (x)
-;    (let ((v (make-vector 1)))
-;      (vector-set! v 0 x)
-;      v)))
-- 
2.11.4.GIT