~ chicken-core (chicken-5) 59c58b2416e3c0892948db6e317468c91ceae919

commit 59c58b2416e3c0892948db6e317468c91ceae919
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sat Apr 21 20:18:19 2012 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Apr 24 09:07:29 2012 +0200

    Always add default core macros to syntax env in internal compiler-syntax so that even when the user doesn't import scheme the macros will expand correctly
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 85aae773..65a80db9 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -46,7 +46,7 @@
   (let ((t (cons (##sys#ensure-transformer
 		  (##sys#er-transformer transformer)
 		  (car names))
-		 se)))
+		 (append se ##sys#default-macro-environment))))
     (for-each
      (lambda (name)
        (##sys#put! name '##compiler#compiler-syntax t) )
@@ -66,6 +66,7 @@
 	(%loop (r 'for-each-loop))
 	(%proc (gensym))
 	(%begin (r 'begin))
+	(%quote (r 'quote))
 	(%and (r 'and))
 	(%pair? (r 'pair?))
 	(%lambda (r 'lambda))
@@ -76,7 +77,7 @@
 	  `(,%let ((,%proc ,(cadr x))
 		   ,@(map list vars lsts))
 		  ,@(map (lambda (var)
-			   `(##core#check (##sys#check-list ,var 'for-each)))
+			   `(##core#check (##sys#check-list ,var (,%quote for-each))))
 			 vars)
 		  (,%let ,%loop ,(map list vars vars)
 			 (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
@@ -89,7 +90,7 @@
 	x)))
 
 (define-internal-compiler-syntax ((map ##sys#map #%map) x r c)
-  (pair?)
+  (pair? cons)
   (let ((%let (r 'let))
 	(%if (r 'if))
 	(%loop (r 'map-loop))
@@ -113,7 +114,7 @@
 		   (,%proc ,(cadr x))
 		   ,@(map list vars lsts))		   
 		  ,@(map (lambda (var)
-			   `(##core#check (##sys#check-list ,var 'map)))
+			   `(##core#check (##sys#check-list ,var (,%quote map))))
 			 vars)
 		  (,%let ,%loop ,(map list vars vars)
 			 (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 31eeb2b8..f4200af6 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -37,7 +37,7 @@ Warning: at toplevel:
   (scrutiny-tests.scm:28) in procedure call to `+', expected argument #2 of type `number', but was given an argument of type `symbol'
 
 Warning: at toplevel:
-  assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a123) (procedure car ((pair a123 *)) a123))'
+  assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a124) (procedure car ((pair a124 *)) a124))'
 
 Warning: at toplevel:
   expected in `let' binding of `g8' a single result, but were given 2 results
@@ -47,9 +47,9 @@ Warning: at toplevel:
 
 Note: in toplevel procedure `foo':
   expected value of type boolean in conditional but were given a value of type
-  `(procedure bar29 () *)' which is always true:
+  `(procedure bar30 () *)' which is always true:
 
-(if bar29 3 (##core#undefined))
+(if bar30 3 (##core#undefined))
 
 Warning: in toplevel procedure `foo2':
   (scrutiny-tests.scm:57) in procedure call to `string-append', expected argument #1 of type `string', but was given an argument of type `number'
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index c5f038cd..98dddf35 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -1025,3 +1025,9 @@ take
   (import (prefix chicken c/) (prefix scheme s/))
   (c/case-lambda ((a) a))
   (c/ensure s/even? 2))
+
+
+;; #816: compiler-syntax should obey hygiene in its rewrites
+(module foo ()
+  (import (prefix (only scheme map lambda list) ~))
+  (~map (~lambda (y) y) (~list 1)))
\ No newline at end of file