From c80181fe16a4ab86f79ac7dff1a7974459b43e08 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 28 Apr 2018 16:56:14 -0700 Subject: [PATCH] =?utf8?q?Implement=20symbol=3D=3F=20for=20R7RS.?= Also fix some symbol procedures that were unsafe. --- src/runtime/runtime.pkg | 1 + src/runtime/symbol.scm | 18 +++++++++++++----- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index e0b33bd4b..8b8aed8ef 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -751,6 +751,7 @@ USA. symbol->string symbol-hash symbol? symbol? uninterned-symbol?)) diff --git a/src/runtime/symbol.scm b/src/runtime/symbol.scm index 989a34584..43e31cb69 100644 --- a/src/runtime/symbol.scm +++ b/src/runtime/symbol.scm @@ -44,6 +44,15 @@ USA. (define-guarantee interned-symbol "interned symbol") (define-guarantee uninterned-symbol "uninterned symbol") +(define (symbol=? symbol1 symbol2 . symbols) + (guarantee symbol? symbol1 'symbol=?) + (guarantee symbol? symbol2 'symbol=?) + (and (eq? symbol1 symbol2) + (every (lambda (symbol) + (guarantee symbol? symbol 'symbol=?) + (eq? symbol1 symbol)) + symbols))) + (define (string->uninterned-symbol string #!optional start end) ((ucode-primitive system-pair-cons) (ucode-type uninterned-symbol) (string->utf8 string start end) @@ -60,8 +69,7 @@ USA. (string->utf8 string start end)))) (define (symbol->string symbol) - (if (not (symbol? symbol)) - (error:not-a symbol? symbol 'symbol->string)) + (guarantee symbol? symbol 'symbol->string) (symbol-name symbol)) (define (symbol-name symbol) @@ -79,13 +87,13 @@ USA. ((ucode-primitive find-symbol) (foldcase->utf8 string))) (define (symbol-hash symbol #!optional modulus) - (string-hash (symbol-name symbol) modulus)) + (string-hash (symbol->string symbol) modulus)) (define (symbolstring x) (symbol->string y))) (define (symbol>? x y) - (stringstring y) (symbol->string x))) (define generate-uninterned-symbol (let ((mutex (make-thread-mutex)) -- 2.25.1