~ 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