From df8f55184d2cc2e98f7e14e5137d0e825fb2eced Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Tue, 18 Jul 2017 22:32:48 +0200
Subject: [PATCH] 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.
---
 chicken.h               | 12 ++++++++++--
 library.scm             |  4 ++--
 tests/library-tests.scm |  5 +++++
 3 files changed, 17 insertions(+), 4 deletions(-)

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)))
 
-- 
2.11.0