~ 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))) (elseTrap