Ticket #1613: 0001-Make-keywords-distinct-from-symbols-at-the-Scheme-le.patch

File 0001-Make-keywords-distinct-from-symbols-at-the-Scheme-le.patch, 24.1 KB (added by sjamaan, 5 years ago)

Patch to make keywords distinct objects

  • NEWS 

    From 2273e5313b11211fc0f8914131e6738b43fbc1a1 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Mon, 6 May 2019 21:57:03 +0200
Subject: [PATCH] Make keywords distinct from symbols at the Scheme level

Having keywords as a subtype of symbols is problematic.  This is most
obvious with identifiers, which may be any symbol, but cannot be
keywords.  Keywords also no longer have plists, so it makes less and
less sense to treat these two object types as almost the same.

There are several Schemes which treat them as distinct types.  Having
keywords be a subtype of symbols is more of a old school Lisp thing,
like treating () and 'nil as the same, falsy values.  It's cleaner to
separate them, this also allows the scrutinizer to treat them more
cleanly as different things.
---
 NEWS                    |  6 ++++++
 c-backend.scm           |  5 +++--
 chicken.h               | 22 ++++++++++++++--------
 core.scm                |  6 +-----
 expand.scm              |  2 +-
 extras.scm              |  6 +++---
 lfa2.scm                |  7 ++++++-
 library.scm             | 39 +++++++++++++++++++++------------------
 runtime.c               | 22 +++++++++++++---------
 scrutinizer.scm         | 10 +++++++---
 synrules.scm            | 15 ++++++---------
 tests/library-tests.scm | 14 ++++++++++----
 tests/version-tests.scm |  6 +++---
 types.db                | 16 ++++++++--------
 14 files changed, 102 insertions(+), 74 deletions(-)

diff --git a/NEWS b/NEWS
index c37366f2..54c87cf6 100644
    a b  
     15.0.3
     2
     3- Runtime system
     4  - Keywords are now distinct types; they are not a subtype of symbols.
     5
     6
    175.0.2
    28
    39- Core libraries

  • c-backend.scm 

    diff --git a/c-backend.scm b/c-backend.scm
index 037eab3e..a6942c47 100644
    a b  
    705705            ((bignum? lit) 2)           ; internal vector statically allocated
    706706            ((flonum? lit) words-per-flonum)
    707707            ((symbol? lit) 7)           ; size of symbol, and possibly a bucket
     708            ((keyword? lit) 7)          ; size of keyword (symbol), and possibly a bucket
    708709            ((pair? lit) (+ 3 (literal-size (car lit)) (literal-size (cdr lit))))
    709710            ((vector? lit)
    710711             (+ 1 (vector-length lit)
    … …  
    739740             (gen #t to #\= (if lit "C_SCHEME_TRUE" "C_SCHEME_FALSE") #\;) )
    740741            ((char? lit)
    741742             (gen #t to "=C_make_character(" (char->integer lit) ");") )
    742             ((symbol? lit)              ; handled slightly specially (see C_h_intern_in)
     743            ((or (keyword? lit) (symbol? lit)) ; handled slightly specially (see C_h_intern_in)
    743744             (let* ((str (##sys#slot lit 1))
    744745                    (cstr (c-ify-string str))
    745746                    (len (##sys#size str))
    … … return((C_header_bits(lit) >> 24) & 0xff); 
    14841485            (string-append "\xc2" (encode-size (string-length str)) str)))
    14851486         ((flonum? lit)
    14861487          (string-append "\x55" (number->string lit) "\x00") )
    1487          ((symbol? lit)
     1488         ((or (keyword? lit) (symbol? lit))
    14881489          (let ((str (##sys#slot lit 1)))
    14891490            (string-append
    14901491             "\x01"

  • chicken.h 

    diff --git a/chicken.h b/chicken.h
index 20dab23e..c73bb03c 100644
    a b void *alloca (); 
    583583#define C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR            2
    584584#define C_BAD_ARGUMENT_TYPE_ERROR                     3
    585585#define C_UNBOUND_VARIABLE_ERROR                      4
    586 #define C_BAD_ARGUMENT_TYPE_SYMBOL_IS_KEYWORD_ERROR   5
     586#define C_BAD_ARGUMENT_TYPE_NO_KEYWORD_ERROR          5
    587587#define C_OUT_OF_MEMORY_ERROR                         6
    588588#define C_DIVISION_BY_ZERO_ERROR                      7
    589589#define C_OUT_OF_RANGE_ERROR                          8
    … … typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret; 
    13881388#define C_i_check_number(x)             C_i_check_number_2(x, C_SCHEME_FALSE)
    13891389#define C_i_check_string(x)             C_i_check_string_2(x, C_SCHEME_FALSE)
    13901390#define C_i_check_bytevector(x)         C_i_check_bytevector_2(x, C_SCHEME_FALSE)
     1391#define C_i_check_keyword(x)            C_i_check_keyword_2(x, C_SCHEME_FALSE)
    13911392#define C_i_check_symbol(x)             C_i_check_symbol_2(x, C_SCHEME_FALSE)
    13921393#define C_i_check_list(x)               C_i_check_list_2(x, C_SCHEME_FALSE)
    13931394#define C_i_check_pair(x)               C_i_check_pair_2(x, C_SCHEME_FALSE)
    … … C_fctexport C_word C_fcall C_i_check_number_2(C_word x, C_word loc) C_regparm; 
    20082009C_fctexport C_word C_fcall C_i_check_string_2(C_word x, C_word loc) C_regparm;
    20092010C_fctexport C_word C_fcall C_i_check_bytevector_2(C_word x, C_word loc) C_regparm;
    20102011C_fctexport C_word C_fcall C_i_check_symbol_2(C_word x, C_word loc) C_regparm;
     2012C_fctexport C_word C_fcall C_i_check_keyword_2(C_word x, C_word loc) C_regparm;
    20112013C_fctexport C_word C_fcall C_i_check_list_2(C_word x, C_word loc) C_regparm;
    20122014C_fctexport C_word C_fcall C_i_check_pair_2(C_word x, C_word loc) C_regparm;
    20132015C_fctexport C_word C_fcall C_i_check_boolean_2(C_word x, C_word loc) C_regparm;
    … … inline static C_word C_u_i_namespaced_symbolp(C_word x) 
    21942196  return C_mk_bool(C_memchr(C_data_pointer(s), '#', C_header_size(s)));
    21952197}
    21962198
    2197 inline static C_word C_u_i_keywordp(C_word x)
    2198 {
    2199   return C_mk_bool(C_symbol_plist(x) == C_SCHEME_FALSE);
    2200 }
    2201 
    22022199inline static C_word C_flonum(C_word **ptr, double n)
    22032200{
    22042201  C_word
    … … inline static C_word C_i_eqvp(C_word x, C_word y) 
    26532650
    26542651inline static C_word C_i_symbolp(C_word x)
    26552652{
    2656   return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_SYMBOL_TAG);
     2653  return C_mk_bool(!C_immediatep(x) &&
     2654                   C_block_header(x) == C_SYMBOL_TAG &&
     2655                   C_symbol_plist(x) != C_SCHEME_FALSE);
     2656}
     2657
     2658inline static C_word C_i_keywordp(C_word x)
     2659{
     2660  return C_mk_bool(!C_immediatep(x) &&
     2661                   C_block_header(x) == C_SYMBOL_TAG &&
     2662                   C_symbol_plist(x) == C_SCHEME_FALSE);
    26572663}
    26582664
    26592665inline static int C_persistable_symbol(C_word x)
    … … inline static int C_persistable_symbol(C_word x) 
    26612667  /* Symbol is bound, or has a non-empty plist (but is not a keyword) */
    26622668  return ((C_truep(C_boundp(x)) ||
    26632669           C_symbol_plist(x) != C_SCHEME_END_OF_LIST) &&
    2664           !C_truep(C_u_i_keywordp(x)));
     2670          C_symbol_plist(x) != C_SCHEME_FALSE);
    26652671}
    26662672
    26672673inline static C_word C_i_pairp(C_word x)

  • core.scm 

    diff --git a/core.scm b/core.scm
index c4aa81bc..d9aa8a4c 100644
    a b  
    524524          (else (find-id id (cdr se)))))
    525525
    526526  (define (lookup id)
    527     (cond ((keyword? id) id)
     527    (cond ((keyword? id) id)            ; DEPRECATED
    528528          ((find-id id (##sys#current-environment)))
    529529          ((##sys#get id '##core#macro-alias) symbol? => values)
    530530          (else id)))
    … …  
    11451145                                         ((assq var0 (##sys#current-environment))
    11461146                                          (warning
    11471147                                           (sprintf "~aassignment to imported value binding `~S'"
    1148                                             (if ln (sprintf "(~a) - " ln) "") var0)))
    1149                                          ((keyword? var0)
    1150                                           (warning
    1151                                            (sprintf "~aassignment to keyword `~S'"
    11521148                                            (if ln (sprintf "(~a) - " ln) "") var0)))))
    11531149                                 `(set! ,var ,(walk val e var0 (memq var e) h ln #f))))))
    11541150

  • expand.scm 

    diff --git a/expand.scm b/expand.scm
index baaa133c..0ce8b505 100644
    a b  
    771771                  (else #f) ) ) ) )
    772772
    773773    (define (variable? v)
    774       (and (symbol? v) (not (##core#inline "C_u_i_keywordp" v))))
     774      (symbol? v))
    775775
    776776    (define (proper-list? x)
    777777      (let loop ((x x))

  • extras.scm 

    diff --git a/extras.scm b/extras.scm
index 3449294e..535e499f 100644
    a b  
    248248(module chicken.pretty-print
    249249  (pp pretty-print pretty-print-width)
    250250
    251 (import scheme chicken.base chicken.fixnum chicken.string)
     251(import scheme chicken.base chicken.fixnum chicken.keyword chicken.string)
    252252
    253253(define generic-write
    254254  (lambda (obj display? width output)
    … …  
    298298            ((vector? obj)      (wr-lst (vector->list obj) (out "#" col)))
    299299            ((boolean? obj)     (out (if obj "#t" "#f") col))
    300300            ((##sys#number? obj)      (out (##sys#number->string obj) col))
    301             ((symbol? obj)
    302              (let ([s (open-output-string)])
     301            ((or (keyword? obj) (symbol? obj))
     302             (let ((s (open-output-string)))
    303303               (##sys#print obj #t s)
    304304               (out (get-output-string s) col) ) )
    305305            ((procedure? obj)   (out (##sys#procedure->string obj) col))

  • lfa2.scm 

    diff --git a/lfa2.scm b/lfa2.scm
index 1fba207c..b1147a4a 100644
    a b  
    4545        chicken.base
    4646        chicken.compiler.support
    4747        chicken.fixnum
    48         chicken.format)
     48        chicken.format
     49        chicken.keyword)
    4950
    5051(include "tweaks")
    5152(include "mini-srfi-1.scm")
    … …  
    6162    ("C_i_check_string" string)
    6263    ("C_i_check_bytevector" blob)
    6364    ("C_i_check_symbol" symbol)
     65    ("C_i_check_keyword" keyword)
    6466    ("C_i_check_list" null pair list)
    6567    ("C_i_check_pair" pair)
    6668    ("C_i_check_locative" locative)
    … …  
    7577    ("C_i_check_string_2" string)
    7678    ("C_i_check_bytevector_2" blob)
    7779    ("C_i_check_symbol_2" symbol)
     80    ("C_i_check_keyword_2" keyword)
    7881    ("C_i_check_list_2" null pair list)
    7982    ("C_i_check_pair_2" pair)
    8083    ("C_i_check_locative_2" locative)
    … …  
    97100    ("C_i_cplxnump" cplxnum)
    98101    ("C_stringp" string)
    99102    ("C_bytevectorp" blob)
     103    ("C_i_keywordp" keyword)
    100104    ("C_i_symbolp" symbol)
    101105    ("C_i_listp" list)
    102106    ("C_i_pairp" pair)
    … …  
    235239    (define (constant-result lit)
    236240      ;; a simplified variant of the one in scrutinizer.scm
    237241      (cond ((string? lit) 'string)
     242            ((keyword? lit) 'keyword)
    238243            ((symbol? lit) 'symbol)
    239244            ;; Do not assume fixnum width matches target platforms!
    240245            ((or (big-fixnum? lit) (small-bignum? lit)) 'integer)

  • library.scm 

    diff --git a/library.scm b/library.scm
index c7ce2b5a..0f329199 100644
    a b EOF 
    11561156      (##core#inline "C_i_check_symbol_2" x (car loc))
    11571157      (##core#inline "C_i_check_symbol" x) ) )
    11581158
     1159(define (##sys#check-keyword x . loc)
     1160  (if (pair? loc)
     1161      (##core#inline "C_i_check_keyword_2" x (car loc))
     1162      (##core#inline "C_i_check_keyword" x) ) )
     1163
    11591164(define (##sys#check-vector x . loc)
    11601165  (if (pair? loc)
    11611166      (##core#inline "C_i_check_vector_2" x (car loc))
    … … EOF 
    27292734(import scheme)
    27302735(import chicken.fixnum)
    27312736
    2732 (define (keyword? x)
    2733   (and (symbol? x) (##core#inline "C_u_i_keywordp" x)) )
     2737(define (keyword? x) (##core#inline "C_i_keywordp" x) )
    27342738
    27352739(define string->keyword
    27362740  (let ([string string] )
    … … EOF 
    27482752(define get-keyword
    27492753  (let ((tag (list 'tag)))
    27502754    (lambda (key args #!optional thunk)
     2755      (##sys#check-keyword key 'get-keyword)
    27512756      (##sys#check-list args 'get-keyword)
    27522757      (let ((r (##core#inline "C_i_get_keyword" key args tag)))
    27532758        (if (eq? r tag)                 ; not found
    … … EOF 
    45394544                ((##core#inline "C_unboundvaluep" x) (outstr port "#<unbound value>"))
    45404545                ((not (##core#inline "C_blockp" x)) (outstr port "#<invalid immediate object>"))
    45414546                ((##core#inline "C_forwardedp" x) (outstr port "#<invalid forwarded object>"))
    4542                 ((##core#inline "C_symbolp" x)
    4543                  (cond ((##core#inline "C_u_i_keywordp" x)
    4544                         ;; Force portable #: style for readable output
    4545                         (case (and (not readable) ksp)
    4546                           ((#:prefix)
    4547                            (outchr port #\:)
    4548                            (outsym port x))
    4549                           ((#:suffix)
    4550                            (outsym port x)
    4551                            (outchr port #\:))
    4552                           (else
    4553                            (outstr port "#:")
    4554                            (outsym port x))))
    4555                        (else
    4556                         (outsym port x))))
     4547                ((##core#inline "C_i_keywordp" x)
     4548                 ;; Force portable #: style for readable output
     4549                 (case (and (not readable) ksp)
     4550                   ((#:prefix)
     4551                    (outchr port #\:)
     4552                    (outsym port x))
     4553                   ((#:suffix)
     4554                    (outsym port x)
     4555                    (outchr port #\:))
     4556                   (else
     4557                    (outstr port "#:")
     4558                    (outsym port x))))
     4559                ((##core#inline "C_i_symbolp" x) (outsym port x))
    45574560                ((##sys#number? x) (outstr port (##sys#number->string x)))
    45584561                ((##core#inline "C_anypointerp" x) (outstr port (##sys#pointer->string x)))
    45594562                ((##core#inline "C_stringp" x)
    … … EOF 
    53775380                (if fn (list fn) '()))))
    53785381        ((3) (apply ##sys#signal-hook #:type-error loc "bad argument type" args))
    53795382        ((4) (apply ##sys#signal-hook #:runtime-error loc "unbound variable" args))
    5380         ((5) (apply ##sys#signal-hook #:type-error loc "symbol is a keyword, which has no plist" args))
     5383        ((5) (apply ##sys#signal-hook #:type-error loc "bad argument type - not a keyword" args))
    53815384        ((6) (apply ##sys#signal-hook #:limit-error loc "out of memory" args))
    53825385        ((7) (apply ##sys#signal-hook #:arithmetic-error loc "division by zero" args))
    53835386        ((8) (apply ##sys#signal-hook #:bounds-error loc "out of range" args))

  • runtime.c 

    diff --git a/runtime.c b/runtime.c
index 5638df55..05ab5f7b 100644
    a b void barf(int code, char *loc, ...) 
    16931693    c = 1;
    16941694    break;
    16951695
    1696   case C_BAD_ARGUMENT_TYPE_SYMBOL_IS_KEYWORD_ERROR:
    1697     msg = C_text("symbol is a keyword, which has no plist");
     1696  case C_BAD_ARGUMENT_TYPE_NO_KEYWORD_ERROR:
     1697    msg = C_text("bad argument type - not a keyword");
    16981698    c = 1;
    16991699    break;
    17001700
    … … C_regparm C_word C_fcall C_i_check_locative_2(C_word x, C_word loc) 
    74087408
    74097409C_regparm C_word C_fcall C_i_check_symbol_2(C_word x, C_word loc)
    74107410{
    7411   if(C_immediatep(x) || C_block_header(x) != C_SYMBOL_TAG) {
     7411  if(!C_truep(C_i_symbolp(x))) {
    74127412    error_location = loc;
    74137413    barf(C_BAD_ARGUMENT_TYPE_NO_SYMBOL_ERROR, NULL, x);
    74147414  }
    … … C_regparm C_word C_fcall C_i_check_symbol_2(C_word x, C_word loc) 
    74177417}
    74187418
    74197419
     7420C_regparm C_word C_fcall C_i_check_keyword_2(C_word x, C_word loc)
     7421{
     7422  if(!C_truep(C_i_keywordp(x))) {
     7423    error_location = loc;
     7424    barf(C_BAD_ARGUMENT_TYPE_NO_KEYWORD_ERROR, NULL, x);
     7425  }
     7426
     7427  return C_SCHEME_UNDEFINED;
     7428}
     7429
    74207430C_regparm C_word C_fcall C_i_check_list_2(C_word x, C_word loc)
    74217431{
    74227432  if(x != C_SCHEME_END_OF_LIST && (C_immediatep(x) || C_block_header(x) != C_PAIR_TAG)) {
    … … C_i_getprop(C_word sym, C_word prop, C_word def) 
    1283712847{
    1283812848  C_word pl = C_symbol_plist(sym);
    1283912849
    12840   if (pl == C_SCHEME_FALSE)
    12841     barf(C_BAD_ARGUMENT_TYPE_SYMBOL_IS_KEYWORD_ERROR, "get", sym);
    12842 
    1284312850  while(pl != C_SCHEME_END_OF_LIST) {
    1284412851    if(C_block_item(pl, 0) == prop)
    1284512852      return C_u_i_car(C_u_i_cdr(pl));
    … … C_putprop(C_word **ptr, C_word sym, C_word prop, C_word val) 
    1285512862{
    1285612863  C_word pl = C_symbol_plist(sym);
    1285712864
    12858   if (pl == C_SCHEME_FALSE)
    12859     barf(C_BAD_ARGUMENT_TYPE_SYMBOL_IS_KEYWORD_ERROR, "put", sym);
    12860 
    1286112865  /* Newly added plist?  Ensure the symbol stays! */
    1286212866  if (pl == C_SCHEME_END_OF_LIST) C_i_persist_symbol(sym);
    1286312867

  • scrutinizer.scm 

    diff --git a/scrutinizer.scm b/scrutinizer.scm
index 7ceb8302..309960c1 100644
    a b  
    4141        chicken.format
    4242        chicken.internal
    4343        chicken.io
     44        chicken.keyword
    4445        chicken.pathname
    4546        chicken.platform
    4647        chicken.plist
    … …  
    8485;        | (refine (SYMBOL ...) VALUE)
    8586;        | deprecated
    8687;        | (deprecated NAME)
    87 ;   VALUE = string | symbol | char | number | boolean | true | false |
     88;   VALUE = string | symbol | keyword | char | number |
     89;           boolean | true | false |
    8890;           null | eof | blob |  pointer | port | locative | fixnum |
    8991;           float | bignum | ratnum | cplxnum | integer | pointer-vector
    9092;   BASIC = * | list | pair | procedure | vector | undefined | noreturn | values
    … …  
    130132(define-constant +maximal-complex-object-constructor-result-type-length+ 256)
    131133
    132134(define-constant value-types
    133   '(string symbol char null boolean true false blob eof fixnum float number
    134     integer bignum ratnum cplxnum pointer-vector port pointer locative))
     135  '(string symbol keyword char null boolean true false blob eof
     136    fixnum float number integer bignum ratnum cplxnum
     137    pointer-vector port pointer locative))
    135138
    136139(define-constant basic-types
    137140  '(* list pair procedure vector undefined deprecated noreturn values))
    … …  
    190193
    191194    (define (constant-result lit)
    192195      (cond ((string? lit) 'string)
     196            ((keyword? lit) 'keyword)
    193197            ((symbol? lit) 'symbol)
    194198            ;; Do not assume fixnum width matches target platforms!
    195199            ((or (big-fixnum? lit) (small-bignum? lit)) 'integer)

  • synrules.scm 

    diff --git a/synrules.scm b/synrules.scm
index d3453fe7..d0919862 100644
    a b  
    6464
    6565(import scheme)
    6666
    67 (define (plain-symbol? x)
    68   (and (symbol? x) (not (##core#inline "C_u_i_keywordp" x))) )
    69 
    7067(define (syntax-rules-mismatch input)
    7168  (##sys#syntax-error-hook "no rule matches form" input))
    7269
    … …  
    163160  ;; Generate code to test whether input expression matches pattern
    164161
    165162  (define (process-match input pattern seen-segment?)
    166     (cond ((plain-symbol? pattern)
     163    (cond ((symbol? pattern)
    167164           (if (memq pattern subkeywords)
    168165               `((,%compare ,input (,%rename (##core#syntax ,pattern))))
    169166               `()))
    … …  
    202199  ;; This is pretty bad, but it seems to work (can't say why).
    203200
    204201  (define (process-pattern pattern path mapit seen-segment?)
    205     (cond ((plain-symbol? pattern)
     202    (cond ((symbol? pattern)
    206203           (if (memq pattern subkeywords)
    207204               '()
    208205               (list (list pattern (mapit path)))))
    … …  
    233230  ;; Generate code to compose the output expression according to template
    234231
    235232  (define (process-template template dim env)
    236     (cond ((plain-symbol? template)
     233    (cond ((symbol? template)
    237234           (let ((probe (assq template env)))
    238235             (if probe
    239236                 (if (<= (cdr probe) dim)
    … …  
    253250                                             env))
    254251                        (gen (if (and (pair? vars)
    255252                                      (null? (cdr vars))
    256                                       (plain-symbol? x)
     253                                      (symbol? x)
    257254                                      (eq? x (car vars)))
    258255                                 x      ;+++
    259256                                 `(,%map (,%lambda ,vars ,x)
    … …  
    278275  ;; Return an association list of (var . dim)
    279276
    280277  (define (meta-variables pattern dim vars seen-segment?)
    281     (cond ((plain-symbol? pattern)
     278    (cond ((symbol? pattern)
    282279           (if (memq pattern subkeywords)
    283280               vars
    284281               (cons (cons pattern dim) vars)))
    … …  
    295292  ;; Return a list of meta-variables of given higher dim
    296293
    297294  (define (free-meta-variables template dim env free)
    298     (cond ((plain-symbol? template)
     295    (cond ((symbol? template)
    299296           (if (and (not (memq template free))
    300297                    (let ((probe (assq template env)))
    301298                      (and probe (>= (cdr probe) dim))))

  • tests/library-tests.scm 

    diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 1e19a632..fa56e820 100644
    a b  
    348348
    349349(parameterize ((keyword-style #:suffix))
    350350  (assert (string=? "abc:" (symbol->string (with-input-from-string "|abc:|" read))))
    351   (assert (string=? "abc" (symbol->string (with-input-from-string "|abc|:" read)))) ; keyword
     351  (assert (string=? "abc" (keyword->string (with-input-from-string "|abc|:" read)))) ; keyword
    352352  (let ((kw (with-input-from-string "|foo bar|:" read)))
    353353    (assert (eq? kw (with-input-from-string "#:|foo bar|" read)))
    354     (assert (string=? "foo bar" (symbol->string kw)))
     354    (assert (string=? "foo bar" (keyword->string kw)))
    355355    (assert (string=? "foo bar:"
    356356                      (with-output-to-string (lambda () (display kw)))))
    357357    (assert (string=? "#:|foo bar|"
    358358                      (with-output-to-string (lambda () (write kw)))))))
    359359
    360360(parameterize ((keyword-style #:prefix))
    361   (assert (string=? "abc" (symbol->string (with-input-from-string ":|abc|" read))))
     361  (assert (string=? "abc" (keyword->string (with-input-from-string ":|abc|" read))))
    362362  (assert (string=? ":abc" (symbol->string (with-input-from-string "|:abc|" read))))
    363363  (let ((kw (with-input-from-string ":|foo bar|" read)))
    364364    (assert (eq? kw (with-input-from-string "#:|foo bar|" read)))
    365     (assert (string=? "foo bar" (symbol->string kw)))
     365    (assert (string=? "foo bar" (keyword->string kw)))
    366366    (assert (string=? ":foo bar"
    367367                      (with-output-to-string (lambda () (display kw)))))
    368368    (assert (string=? "#:|foo bar|"
    … …  
    413413(assert-fail (with-input-from-string "#:" read))
    414414
    415415(let ((empty-kw (with-input-from-string "#:||" read)))
     416  (assert (not (symbol? empty-kw)))
    416417  (assert (keyword? empty-kw))
    417418  (assert (string=? "" (keyword->string empty-kw))))
    418419
    … …  
    427428(assert (equal? (cons 1 2) (with-input-from-string "(1 . 2)" read)))
    428429(assert (every keyword? (with-input-from-string "(42: abc: .: #:: ::)" read)))
    429430
     431;; symbols and keywords are now distinct
     432(assert (not (symbol? #:foo)))
     433(assert (not (symbol? (string->keyword "foo"))))
     434(assert (not (keyword? 'foo)))
     435(assert (not (keyword? (string->symbol "foo"))))
    430436
    431437;;; reading unterminated objects
    432438

  • tests/version-tests.scm 

    diff --git a/tests/version-tests.scm b/tests/version-tests.scm
index c6c3ce7d..2a786dc8 100644
    a b  
    1 (import chicken.irregex chicken.platform chicken.string)
     1(import chicken.irregex chicken.platform chicken.keyword chicken.string)
    22
    33(let* ((version-tokens (string-split (chicken-version) "."))
    44       (major (string->number (car version-tokens)))
    … …  
    1313  (let loop ((features (features)))
    1414    (if (null? features)
    1515        (error "Could not find feature chicken-<major>.<minor>")
    16         (let ((feature (symbol->string (car features))))
     16        (let ((feature (keyword->string (car features))))
    1717          (cond ((irregex-match "chicken-(\\d+)\\.(\\d+)" feature)
    1818                 => (lambda (match)
    1919                      (assert (= (string->number
    … …  
    2828  (let loop ((features (features)))
    2929    (if (null? features)
    3030        (error "Could not find feature chicken-<major>")
    31         (let ((feature (symbol->string (car features))))
     31        (let ((feature (keyword->string (car features))))
    3232          (cond ((irregex-match "chicken-(\\d+)" feature)
    3333                 => (lambda (match)
    3434                      (assert (= (string->number

  • types.db 

    diff --git a/types.db b/types.db
index 9131145d..0b1b1ec7 100644
    a b  
    13221322
    13231323;; keyword
    13241324
    1325 (chicken.keyword#get-keyword (#(procedure #:clean #:enforce) chicken.keyword#get-keyword (symbol list #!optional *) *))
    1326 (chicken.keyword#keyword->string (#(procedure #:clean #:enforce) chicken.keyword#keyword->string (symbol) string))
    1327 (chicken.keyword#keyword? (#(procedure #:pure) chicken.keyword#keyword? (*) boolean))
    1328 (chicken.keyword#string->keyword (#(procedure #:clean #:enforce) chicken.keyword#string->keyword (string) symbol))
     1325(chicken.keyword#get-keyword (#(procedure #:clean #:enforce) chicken.keyword#get-keyword (keyword list #!optional *) *))
     1326(chicken.keyword#keyword->string (#(procedure #:clean #:enforce) chicken.keyword#keyword->string (keyword) string))
     1327(chicken.keyword#keyword? (#(procedure #:pure #:predicate keyword) chicken.keyword#keyword? (*) boolean))
     1328(chicken.keyword#string->keyword (#(procedure #:clean #:enforce) chicken.keyword#string->keyword (string) keyword))
    13291329
    13301330;; load
    13311331
    … …  
    13461346(chicken.platform#build-platform (#(procedure #:pure) chicken.platform#build-platform () symbol))
    13471347(chicken.platform#chicken-version (#(procedure #:pure) chicken.platform#chicken-version (#!optional *) string))
    13481348(chicken.platform#chicken-home (#(procedure #:clean) chicken.platform#chicken-home () string))
    1349 (chicken.platform#feature? (#(procedure #:clean) chicken.platform#feature? (#!rest symbol) boolean))
    1350 (chicken.platform#features (#(procedure #:clean) chicken.platform#features () (list-of symbol)))
     1349(chicken.platform#feature? (#(procedure #:clean) chicken.platform#feature? (#!rest (or keyword symbol string)) boolean))
     1350(chicken.platform#features (#(procedure #:clean) chicken.platform#features () (list-of keyword)))
    13511351(chicken.platform#software-type (#(procedure #:pure) chicken.platform#software-type () symbol))
    13521352(chicken.platform#software-version (#(procedure #:pure) chicken.platform#software-version () symbol))
    1353 (chicken.platform#register-feature! (#(procedure #:clean #:enforce) chicken.platform#register-feature! (#!rest symbol) undefined))
    1354 (chicken.platform#unregister-feature! (#(procedure #:clean #:enforce) chicken.platform#unregister-feature! (#!rest symbol) undefined))
     1353(chicken.platform#register-feature! (#(procedure #:clean #:enforce) chicken.platform#register-feature! (#!rest (or keyword symbol string)) undefined))
     1354(chicken.platform#unregister-feature! (#(procedure #:clean #:enforce) chicken.platform#unregister-feature! (#!rest (or keyword symbol string)) undefined))
    13551355(chicken.platform#machine-byte-order (#(procedure #:pure) chicken.platform#machine-byte-order () symbol))
    13561356(chicken.platform#machine-type (#(procedure #:pure) chicken.platform#machine-type () symbol))
    13571357(chicken.platform#repository-path (#(procedure #:clean) chicken.platform#repository-path (#!optional *) *))