[uim-commit] r2924 - in branches/r5rs/sigscheme: src test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-14 17:37:11 -0800 (Sat, 14 Jan 2006)
New Revision: 2924

Modified:
   branches/r5rs/sigscheme/src/syntax.c
   branches/r5rs/sigscheme/test/test-exp.scm
Log:
* sigscheme/src/syntax.c
  - (scm_s_let): Fix deprecated use of define_internal()
* sigscheme/test/test-exp.scm
  - Cosmetic change


Modified: branches/r5rs/sigscheme/src/syntax.c
===================================================================
--- branches/r5rs/sigscheme/src/syntax.c	2006-01-15 01:21:01 UTC (rev 2923)
+++ branches/r5rs/sigscheme/src/syntax.c	2006-01-15 01:37:11 UTC (rev 2924)
@@ -814,14 +814,14 @@
         ERR_OBJ("invalid bindings form", bindings);
 
     env = scm_extend_environment(formals, actuals, env);
-    eval_state->env = env;
 
     /* named let */
     if (SYMBOLP(named_let_sym)) {
         proc = MAKE_CLOSURE(CONS(formals, body), env);
-        define_internal(named_let_sym, proc, env);
+        env = scm_add_environment(named_let_sym, proc, env);
     }
 
+    eval_state->env = env;
     return scm_s_body(body, eval_state);
 }
 

Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2006-01-15 01:21:01 UTC (rev 2923)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2006-01-15 01:37:11 UTC (rev 2924)
@@ -560,18 +560,20 @@
     (assert-equal? "lexical scope test5" 1 a)))
 (lexical-test)
 
-(assert-equal? "named let test" '((6 1 3) (-5 -2)) (let loop ((numbers '(3 -2 1 6 -5))
-							      (nonneg '())
-							      (neg '()))
-						     (cond ((null? numbers) (list nonneg neg))
-							   ((>= (car numbers) 0)
-							    (loop (cdr numbers)
-								  (cons (car numbers) nonneg)
-								  neg))
-							   ((< (car numbers) 0)
-							    (loop (cdr numbers)
-								  nonneg
-								  (cons (car numbers) neg))))))
+(assert-equal? "named let test"
+               '((6 1 3) (-5 -2))
+               (let loop ((numbers '(3 -2 1 6 -5))
+                          (nonneg '())
+                          (neg '()))
+                 (cond ((null? numbers) (list nonneg neg))
+                       ((>= (car numbers) 0)
+                        (loop (cdr numbers)
+                              (cons (car numbers) nonneg)
+                              neg))
+                       ((< (car numbers) 0)
+                        (loop (cdr numbers)
+                              nonneg
+                              (cons (car numbers) neg))))))
 
 ;;
 ;; let*
@@ -644,21 +646,25 @@
                (lambda ()
                  (letrec (1) #t)))
 
-(assert-equal? "basic letrec test1" #t (letrec ((even?
-					   (lambda (n)
-					     (if (zero? n)
-						 #t
-						 (odd? (- n 1)))))
-					  (odd?
-					   (lambda (n)
-					     (if (zero? n)
-						 #f
-						 (even? (- n 1))))))
-				      (even? 88)))
+(assert-equal? "basic letrec test1"
+               #t
+               (letrec ((even?
+                         (lambda (n)
+                           (if (zero? n)
+                               #t
+                               (odd? (- n 1)))))
+                        (odd?
+                         (lambda (n)
+                           (if (zero? n)
+                               #f
+                               (even? (- n 1))))))
+                 (even? 88)))
 
-(assert-equal? "basic letrec test2" "aiueo" (letrec ((a (lambda () b))
-						     (b "aiueo"))
-					      (a)))
+(assert-equal? "basic letrec test2"
+               "aiueo"
+               (letrec ((a (lambda () b))
+                        (b "aiueo"))
+                 (a)))
 
 (define mularg-apply
   (letrec ((apply-2 apply)