~ chicken-core (chicken-5) ba2dd616650a25c368b80a1a8644e8322b4196c0
commit ba2dd616650a25c368b80a1a8644e8322b4196c0
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Jun 25 13:36:48 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sat Jun 25 13:36:48 2011 +0200
brutally force-globalizing name in define-specialization
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index c7f43ac1..98ad27e8 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -1211,8 +1211,10 @@
(##sys#check-syntax 'define-specialization x '(_ (symbol . #(_ 0)) _ . #(_ 0 1)))
(let* ((head (cadr x))
(name (car head))
+ (gname (##sys#globalize name '())) ;XXX correct?
(args (cdr head))
(alias (gensym name))
+ (galias (##sys#globalize alias '())) ;XXX and this?
(rtypes (and (pair? (cdddr x)) (caddr x)))
(%define (r 'define))
(body (if rtypes (cadddr x) (caddr x))))
@@ -1221,13 +1223,13 @@
(let ((anames (reverse anames))
(atypes (reverse atypes))
(spec
- `(,alias ,@(let loop2 ((anames anames) (i 1))
- (if (null? anames)
- '()
- (cons (vector i)
- (loop2 (cdr anames) (fx+ i 1))))))))
+ `(,galias ,@(let loop2 ((anames anames) (i 1))
+ (if (null? anames)
+ '()
+ (cons (vector i)
+ (loop2 (cdr anames) (fx+ i 1))))))))
(##sys#put!
- name '##compiler#local-specializations
+ gname '##compiler#local-specializations
(##sys#append
(list
(cons atypes
@@ -1244,7 +1246,8 @@
spec)
(list spec))))
(or (##compiler#variable-mark
- name '##compiler#local-specializations)
+ gname
+ '##compiler#local-specializations)
'())))
`(##core#begin
(##core#declare (inline ,alias) (hide ,alias))
diff --git a/manual/Types b/manual/Types
index 3cd55803..214ff7a9 100644
--- a/manual/Types
+++ b/manual/Types
@@ -188,19 +188,19 @@ Specializations can also be defined by the user:
<syntax>(define-specialization (NAME ARGUMENT ...) [RESULTS] BODY)</syntax>
-{{NAME}} should have a declared type (for example by using {{:}}).
-Declares the calls to the procedure {{NAME}} with arguments matching
-the types given in {{ARGUMENTS}} should be replaced by {{BODY}} (a
-single expression). If given, {{RESULTS}} (which follows the syntax
-given above under "Type Syntax") narrows the result type(s) if it
-differs from the result types previously declared for {{NAME}}.
-{{ARGUMENT}} should be an identifier naming the formal parameter or a
-list of the form {{(IDENTIFIER TYPE)}}. In the former case, this
-argument specializes on the {{*}} type. User-defined specializations
-are always local to the compilation unit in which they occur and can
-not be exported. When encountered in the interpreter,
-{{define-specialization}} does nothing and returns an unspecified
-result.
+{{NAME}} should have a declared type (for example by using {{:}})
+(this is currently not checked). Declares the calls to the globally
+defined procedure {{NAME}} with arguments matching the types given in
+{{ARGUMENTS}} should be replaced by {{BODY}} (a single expression). If
+given, {{RESULTS}} (which follows the syntax given above under "Type
+Syntax") narrows the result type(s) if it differs from the result
+types previously declared for {{NAME}}. {{ARGUMENT}} should be an
+identifier naming the formal parameter or a list of the form
+{{(IDENTIFIER TYPE)}}. In the former case, this argument specializes
+on the {{*}} type. User-defined specializations are always local to
+the compilation unit in which they occur and can not be exported. When
+encountered in the interpreter, {{define-specialization}} does nothing
+and returns an unspecified result.
---
Trap