~ chicken-core (chicken-5) 231acab228150177adcb980b0db9e80ff4e9eddd


commit 231acab228150177adcb980b0db9e80ff4e9eddd
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Nov 30 13:54:00 2011 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Nov 30 13:54:00 2011 +0100

    tiny change for inlining car

diff --git a/compiler.scm b/compiler.scm
index b252bc12..a23e8eff 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -434,7 +434,7 @@
 
   (define (resolve-variable x0 e se dest ldest h)
     (let ((x (lookup x0 se)))
-      (d `(RESOLVE-VARIABLE: ,x0 ,x ,(map car se)))
+      (d `(RESOLVE-VARIABLE: ,x0 ,x ,(map (lambda (x) (car x)) se)))
       (cond ((not (symbol? x)) x0)	; syntax?
 	    [(and constants-used (##sys#hash-table-ref constant-table x)) 
 	     => (lambda (val) (walk (car val) e se dest ldest h)) ]
@@ -1614,7 +1614,7 @@
   (let* ([rtype (second exp)]
 	 [args (third exp)]
 	 [body (apply string-append (cdddr exp))]
- 	 [argtypes (map car args)]
+ 	 [argtypes (map (lambda (x) (car x)) args)]
          ;; C identifiers aren't hygienically renamed inside body strings
 	 [argnames (map cadr (##sys#strip-syntax args))] )
     (create-foreign-stub rtype #f argtypes argnames body callback? callback?) ) )
@@ -1625,7 +1625,7 @@
 	 [rtype (if hasrtype (second exp) 'void)]
 	 [args (##sys#strip-syntax (if hasrtype (third exp) (second exp)))]
 	 [body (apply string-append (if hasrtype (cdddr exp) (cddr exp)))]
- 	 [argtypes (map car args)]
+ 	 [argtypes (map (lambda (x) (car x)) args)]
          ;; C identifiers aren't hygienically renamed inside body strings
 	 [argnames (map cadr (##sys#strip-syntax args))] )
     (create-foreign-stub rtype #f argtypes argnames body #f #t) ) )
diff --git a/eval.scm b/eval.scm
index 0be9cb7f..04c2cd9b 100644
--- a/eval.scm
+++ b/eval.scm
@@ -200,7 +200,7 @@
 
       (define (lookup var0 e se)
 	(let ((var (rename var0 se)))
-	  (d `(LOOKUP/EVAL: ,var0 ,var ,e ,(map car se)))
+	  (d `(LOOKUP/EVAL: ,var0 ,var ,e ,(map (lambda (x) (car x)) se)))
 	  (let loop ((envs e) (ei 0))
 	    (cond ((null? envs) (values #f var))
 		  ((posq var (##sys#slot envs 0)) => (lambda (p) (values ei p)))
@@ -372,7 +372,7 @@
 			 [(##core#let)
 			  (let* ([bindings (cadr x)]
 				 [n (length bindings)] 
-				 [vars (map car bindings)]
+				 [vars (map (lambda (x) (car x)) bindings)]
 				 (aliases (map gensym vars))
 				 [e2 (cons aliases e)]
 				 (se2 (##sys#extend-se se vars aliases))
Trap