M compiler/lib/scheme/base.rb => compiler/lib/scheme/base.rb +8 -0
@@ 189,6 189,14 @@ class Compiler
]
end
+ def base_symbol_to_string((symbol, *_rest), options)
+ [
+ compile_sexp_use(symbol, options),
+ VM::TO_STR,
+ pop_maybe(options)
+ ]
+ end
+
def base_null?((arg, *_rest), options)
[
compile_sexp_use(arg, options),
M lib/scheme/base.scm => lib/scheme/base.scm +15 -0
@@ 90,6 90,8 @@
string->number
string-append
symbol?
+ symbol=?
+ symbol->string
unless
when
write-string
@@ 136,6 138,7 @@
(--define-native string-length base_string_length)
(--define-native string-ref base_string_ref)
(--define-native symbol? base_symbol?)
+ (--define-native symbol->string base_symbol_to_string)
(define-syntax begin
(syntax-rules ()
@@ 522,6 525,18 @@
((and (symbol? a) (symbol? b)) (eq? a b))
(else #f)))
+ (define (symbol=? . symbols)
+ (if (< (length symbols) 2)
+ #t
+ (let ((s1 (car symbols))
+ (s2 (cadr symbols)))
+ (if (and
+ (symbol? s1)
+ (symbol? s2)
+ (eq? s1 s2))
+ (apply symbol=? (cdr symbols))
+ #f))))
+
(define-syntax when
(syntax-rules ()
((when test result1 result2 ...)
M spec/lib/symbol-spec.scm => spec/lib/symbol-spec.scm +10 -0
@@ 4,3 4,13 @@
(assert (symbol? 'a))
(assert (symbol? (car '(a b))))
(assert (not (symbol? "a")))
+
+(assert (equal? (symbol->string 'a) "a"))
+(assert (not (equal? (symbol->string 'b) "a")))
+
+(assert (symbol=?))
+(assert (symbol=? 'a))
+(assert (symbol=? 'a 'a 'a))
+(assert (not (symbol=? 'a 'a 'b)))
+(assert (not (symbol=? 'a "a")))
+(assert (not (symbol=? 1 1)))
M vm/operations.rb => vm/operations.rb +12 -3
@@ 128,9 128,18 @@ class VM
end
def do_to_str
- list = pop_val
- chars = list.to_ruby.map(&:to_s)
- push_val(ByteArray.new(chars.join))
+ value = pop_val
+ case value
+ when Pair
+ chars = value.to_ruby.map(&:to_s)
+ push_val(ByteArray.new(chars.join))
+ when EmptyList
+ push_val(ByteArray.new(''))
+ when Atom
+ push_val(ByteArray.new(value.to_ruby))
+ else
+ raise "unknown value type: #{value.inspect}"
+ end
end
def do_call(new_ip = pop)