~ 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