~ 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