~ chicken-core (chicken-5) eb76436fae3a2037db4d8c449aa7cf44d78f7549
commit eb76436fae3a2037db4d8c449aa7cf44d78f7549
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Sun Jul 12 21:48:36 2015 +1200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Sun Jul 12 21:48:36 2015 +1200
Update built-in compiler-syntax rules to handle module-namespaced identifiers
Ensures that compiler-syntax rules are triggered even when the
identifier in head position is imported from a core unit module (and
thus namespaced).
diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 68eb6656..045cc086 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -142,14 +142,14 @@
,%result))))
x)))
-(define-internal-compiler-syntax ((o #%o) x r c) ()
+(define-internal-compiler-syntax ((o #%o chicken.data-structures#o) x r c) ()
(if (and (fx> (length x) 1)
- (memq 'o extended-bindings) ) ; s.a.
+ (memq 'chicken.data-structures#o extended-bindings)) ; s.a.
(let ((%tmp (r 'tmp)))
`(,(r 'lambda) (,%tmp) ,(foldr list %tmp (cdr x))))
x))
-(define-internal-compiler-syntax ((sprintf #%sprintf format #%format) x r c)
+(define-internal-compiler-syntax ((sprintf #%sprintf chicken.extras#sprintf format #%format chicken.extras#format) x r c)
(display write fprintf number->string write-char open-output-string get-output-string)
(let* ((out (gensym 'out))
(code (compile-format-string
@@ -166,7 +166,7 @@
(,(r 'get-output-string) ,out))
x)))
-(define-internal-compiler-syntax ((fprintf #%fprintf) x r c)
+(define-internal-compiler-syntax ((fprintf #%fprintf chicken.extras#fprintf) x r c)
(display write fprintf number->string write-char open-output-string get-output-string)
(if (>= (length x) 3)
(let ((code (compile-format-string
@@ -176,7 +176,7 @@
(or code x))
x))
-(define-internal-compiler-syntax ((printf #%printf) x r c)
+(define-internal-compiler-syntax ((printf #%printf chicken.extras#printf) x r c)
(display write fprintf number->string write-char open-output-string get-output-string)
(let ((code (compile-format-string
'printf '##sys#standard-output
@@ -188,7 +188,7 @@
(call/cc
(lambda (return)
(and (>= (length args) 1)
- (memq func extended-bindings) ; s.a.
+ (memq (symbol-append 'chicken.extras# func) extended-bindings) ; s.a.
(or (string? (car args))
(and (list? (car args))
(c (r 'quote) (caar args))
@@ -207,7 +207,6 @@
(index 0)
(len (string-length fstr))
(%out (r 'out))
- (%fprintf (r 'fprintf))
(%let (r 'let))
(%number->string (r 'number->string)))
(define (fetch)
@@ -261,7 +260,7 @@
((#\?)
(let* ([fstr (next)]
[lst (next)] )
- (push `(##sys#apply ,%fprintf ,%out ,fstr ,lst))))
+ (push `(##sys#apply chicken.extras#fprintf ,%out ,fstr ,lst))))
((#\~) (push `(##sys#write-char-0 #\~ ,%out)))
((#\% #\N) (push `(##sys#write-char-0 #\newline ,%out)))
(else
Trap