~ chicken-core (chicken-5) e5797f6953ad0699d48ddad1c67a66ebaae5cbe8
commit e5797f6953ad0699d48ddad1c67a66ebaae5cbe8
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Mon Jul 13 12:08:52 2015 +1200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Mon Jul 13 12:08:52 2015 +1200
Update built-in compiler-syntax rules to respect modules
Ensures that compiler-syntax rules for identifiers from core unit
modules are only triggered when those identifiers have actually been
imported.
Updates format string compilation output to use fully-qualified
identifiers, where necessary.
diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 045cc086..520c7752 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -142,46 +142,35 @@
,%result))))
x)))
-(define-internal-compiler-syntax ((o #%o chicken.data-structures#o) x r c) ()
+(define-internal-compiler-syntax ((chicken.data-structures#o) x r c) ()
(if (and (fx> (length x) 1)
(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 chicken.extras#sprintf format #%format chicken.extras#format) x r c)
- (display write fprintf number->string write-char open-output-string get-output-string)
+(define-internal-compiler-syntax ((chicken.extras#sprintf chicken.extras#format) x r c)
+ (display write number->string write-char open-output-string get-output-string)
(let* ((out (gensym 'out))
- (code (compile-format-string
- (if (memq (car x) '(sprintf #%sprintf))
- 'sprintf
- 'format)
- out
- x
- (cdr x)
- r c)))
+ (code (compile-format-string
+ (if (eq? (car x) 'chicken.extras#sprintf) 'sprintf 'format)
+ out x (cdr x) r c)))
(if code
`(,(r 'let) ((,out (,(r 'open-output-string))))
,code
(,(r 'get-output-string) ,out))
x)))
-(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)
+(define-internal-compiler-syntax ((chicken.extras#fprintf) x r c)
+ (display write number->string write-char open-output-string get-output-string)
(if (>= (length x) 3)
- (let ((code (compile-format-string
- 'fprintf (cadr x)
- x (cddr x)
- r c)))
+ (let ((code (compile-format-string 'fprintf (cadr x) x (cddr x) r c)))
(or code x))
x))
-(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
- x (cdr x)
- r c)))
+(define-internal-compiler-syntax ((chicken.extras#printf) x r c)
+ (display write number->string write-char open-output-string get-output-string)
+ (let ((code (compile-format-string 'printf '##sys#standard-output x (cdr x) r c)))
(or code x)))
(define (compile-format-string func out x args r c)
Trap