From 72d5564a795aca3d31b15cd10e59d592d995ac5a Mon Sep 17 00:00:00 2001
From: Peter Bex <peter.bex@xs4all.nl>
Date: Sat, 21 Apr 2012 20:18:19 +0200
Subject: [PATCH] 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
---
compiler-syntax.scm | 9 +++++----
tests/scrutiny.expected | 6 +++---
tests/syntax-tests.scm | 6 ++++++
3 files changed, 14 insertions(+), 7 deletions(-)
diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 85aae77..65a80db 100644
a
|
b
|
|
46 | 46 | (let ((t (cons (##sys#ensure-transformer |
47 | 47 | (##sys#er-transformer transformer) |
48 | 48 | (car names)) |
49 | | se))) |
| 49 | (append se ##sys#default-macro-environment)))) |
50 | 50 | (for-each |
51 | 51 | (lambda (name) |
52 | 52 | (##sys#put! name '##compiler#compiler-syntax t) ) |
… |
… |
|
66 | 66 | (%loop (r 'for-each-loop)) |
67 | 67 | (%proc (gensym)) |
68 | 68 | (%begin (r 'begin)) |
| 69 | (%quote (r 'quote)) |
69 | 70 | (%and (r 'and)) |
70 | 71 | (%pair? (r 'pair?)) |
71 | 72 | (%lambda (r 'lambda)) |
… |
… |
|
76 | 77 | `(,%let ((,%proc ,(cadr x)) |
77 | 78 | ,@(map list vars lsts)) |
78 | 79 | ,@(map (lambda (var) |
79 | | `(##core#check (##sys#check-list ,var 'for-each))) |
| 80 | `(##core#check (##sys#check-list ,var (,%quote for-each)))) |
80 | 81 | vars) |
81 | 82 | (,%let ,%loop ,(map list vars vars) |
82 | 83 | (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars)) |
… |
… |
|
89 | 90 | x))) |
90 | 91 | |
91 | 92 | (define-internal-compiler-syntax ((map ##sys#map #%map) x r c) |
92 | | (pair?) |
| 93 | (pair? cons) |
93 | 94 | (let ((%let (r 'let)) |
94 | 95 | (%if (r 'if)) |
95 | 96 | (%loop (r 'map-loop)) |
… |
… |
|
113 | 114 | (,%proc ,(cadr x)) |
114 | 115 | ,@(map list vars lsts)) |
115 | 116 | ,@(map (lambda (var) |
116 | | `(##core#check (##sys#check-list ,var 'map))) |
| 117 | `(##core#check (##sys#check-list ,var (,%quote map)))) |
117 | 118 | vars) |
118 | 119 | (,%let ,%loop ,(map list vars vars) |
119 | 120 | (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars)) |
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 31eeb2b..f4200af 100644
a
|
b
|
Warning: at toplevel: |
37 | 37 | (scrutiny-tests.scm:28) in procedure call to `+', expected argument #2 of type `number', but was given an argument of type `symbol' |
38 | 38 | |
39 | 39 | Warning: at toplevel: |
40 | | assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a123) (procedure car ((pair a123 *)) a123))' |
| 40 | assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a124) (procedure car ((pair a124 *)) a124))' |
41 | 41 | |
42 | 42 | Warning: at toplevel: |
43 | 43 | expected in `let' binding of `g8' a single result, but were given 2 results |
… |
… |
Warning: at toplevel: |
47 | 47 | |
48 | 48 | Note: in toplevel procedure `foo': |
49 | 49 | expected value of type boolean in conditional but were given a value of type |
50 | | `(procedure bar29 () *)' which is always true: |
| 50 | `(procedure bar30 () *)' which is always true: |
51 | 51 | |
52 | | (if bar29 3 (##core#undefined)) |
| 52 | (if bar30 3 (##core#undefined)) |
53 | 53 | |
54 | 54 | Warning: in toplevel procedure `foo2': |
55 | 55 | (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 c1a2fa8..cad0d39 100644
a
|
b
|
take |
974 | 974 | (import (prefix chicken c/) (prefix scheme s/)) |
975 | 975 | (c/case-lambda ((a) a)) |
976 | 976 | (c/ensure s/even? 2)) |
| 977 | |
| 978 | |
| 979 | ;; #816: compiler-syntax should obey hygiene in its rewrites |
| 980 | (module foo () |
| 981 | (import (prefix (only scheme map lambda list) ~)) |
| 982 | (~map (~lambda (y) y) (~list 1))) |
| 983 | No newline at end of file |