From: Chris Hanson Date: Fri, 10 Aug 2007 19:08:44 +0000 (+0000) Subject: Allow URIs to be given to STRING and UTF8-STRING. X-Git-Tag: 20090517-FFI~466 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=47e728010ab61776c03e1873010ce29fc19037dc;p=mit-scheme.git Allow URIs to be given to STRING and UTF8-STRING. --- diff --git a/v7/src/runtime/string.scm b/v7/src/runtime/string.scm index e2592a760..a27d1a6de 100644 --- a/v7/src/runtime/string.scm +++ b/v7/src/runtime/string.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: string.scm,v 14.65 2007/08/10 18:06:20 cph Exp $ +$Id: string.scm,v 14.66 2007/08/10 19:08:44 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -174,22 +174,23 @@ USA. (%string-append (map ->utf8-string objects))) (define (->string object) - (cond ((symbol? object) (symbol->string object)) - ((string? object) object) + (cond ((string? object) object) + ((symbol? object) (symbol->string object)) ((wide-string? object) (wide-string->string object)) ((8-bit-char? object) (make-string 1 object)) (else (%->string object 'STRING)))) (define (->utf8-string object) - (cond ((symbol? object) (symbol-name object)) - ((string? object) (string->utf8-string object)) + (cond ((string? object) (string->utf8-string object)) + ((symbol? object) (symbol-name object)) ((wide-string? object) (wide-string->utf8-string object)) ((wide-char? object) (wide-string->utf8-string (wide-string object))) (else (%->string object 'UTF8-STRING)))) (define (%->string object caller) - (cond ((number? object) (number->string object)) - ((not object) "") + (cond ((not object) "") + ((number? object) (number->string object)) + ((uri? object) (uri->string object)) (else (error:wrong-type-argument object "string component" caller)))) (define (char->string char)