~ chicken-core (chicken-5) 0ec220f5babc4006ee7a748a24c99178210aa2b1

commit 0ec220f5babc4006ee7a748a24c99178210aa2b1
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Tue Jul 18 22:32:48 2017 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jul 25 14:20:10 2017 +0200

    Introduce an inline helper function to check for keywords.
    
    Symbols bound to themselves aren't always keywords, which would trip
    up the GC sanity check.
    
    To make it easier to change how keywords are represented, the keyword?
    predicate now also makes use of this new C_u_i_keywordp() function.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/chicken.h b/chicken.h
index d2e9db6d..443565d3 100644
--- a/chicken.h
+++ b/chicken.h
@@ -2215,6 +2215,15 @@ inline static C_word C_u_i_namespaced_symbolp(C_word x)
   return C_mk_bool(C_memchr(C_data_pointer(s), '#', C_header_size(s)));
 }
 
+inline static C_word C_u_i_keywordp(C_word x)
+{
+  /* TODO: This representation is rather bogus */
+  C_word n = C_symbol_name(x);
+  return C_mk_bool(C_symbol_value(x) == x &&
+                   C_header_size(n) > 0 &&
+                   ((C_byte *)C_data_pointer(n))[0] == '\0');
+}
+
 inline static C_word C_flonum(C_word **ptr, double n)
 {
   C_word 
@@ -2705,9 +2714,8 @@ inline static C_word C_i_symbolp(C_word x)
 
 inline static int C_persistable_symbol(C_word x)
 {
-  C_word val = C_symbol_value(x);
   /* Symbol is bound (and not a keyword), or has a non-empty plist */
-  return ((val != C_SCHEME_UNBOUND && val != x) ||
+  return ((C_truep(C_boundp(x)) && !C_truep(C_u_i_keywordp(x))) ||
           C_symbol_plist(x) != C_SCHEME_END_OF_LIST);
 }
 
diff --git a/library.scm b/library.scm
index 7f0d60ad..0c296847 100644
--- a/library.scm
+++ b/library.scm
@@ -2109,7 +2109,7 @@ EOF
 (import scheme chicken chicken.fixnum)
 
 (define (keyword? x)
-  (and (symbol? x) (fx= 0 (##sys#byte (##sys#slot x 1) 0))) )
+  (and (symbol? x) (##core#inline "C_u_i_keywordp" x)) )
 
 (define string->keyword
   (let ([string string] )
@@ -4031,7 +4031,7 @@ EOF
 		((not (##core#inline "C_blockp" x)) (outstr port "#<invalid immediate object>"))
 		((##core#inline "C_forwardedp" x) (outstr port "#<invalid forwarded object>"))
 		((##core#inline "C_symbolp" x)
-		 (cond ((fx= 0 (##sys#byte (##sys#slot x 1) 0)) ; keyword
+		 (cond ((##core#inline "C_u_i_keywordp" x)
 			;; Force portable #: style for readable output
 			(case (and (not readable) ksp)
 			  ((#:prefix)
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 1e33adcb..ed2b4b09 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -403,6 +403,11 @@
   (assert (keyword? empty-kw))
   (assert (string=? "" (keyword->string empty-kw))))
 
+;; TODO: It should eventually be possible to distinguish these (#1077)
+#;(let ((nul-sym (with-input-from-string "|\\x00|" read)))
+  (assert (not (keyword? nul-sym)))
+  (assert (string=? "\x00" (symbol->string nul-sym))))
+
 (assert (keyword? (with-input-from-string "42:" read)))
 (assert (keyword? (with-input-from-string ".:" read)))