suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add string-append-immutable

Browse Source 
original commit: 353ee30534757fb37bfe231e9be21482d9f858ce
This commit is contained in:
Matthew Flatt 2019-12-17 18:53:33 -07:00
parent c8ea435c85
commit ecaec06f64
7 changed files with 79 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
csug/objects.stex
View File

@ -430,7 +430,8 @@ recently.
\index{immutable strings}\index{mutable strings}%
All strings are mutable by default, including constants.
A program can create immutable strings via
\index{\scheme{string->immutable-string}}\scheme{string->immutable-string}.
\index{\scheme{string->immutable-string}}\scheme{string->immutable-string}
or \index{\scheme{string-append-immutable}}\scheme{string-append-immutable}.
Any attempt to modify an immutable string causes an exception to be raised.
The length and indices of a string in {\ChezScheme} are always fixnums.
@ -583,6 +584,16 @@ is immutable; otherwise, the result is an immutable string with the same content
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{string-append-immutable}{\categoryprocedure}{(string-append-immutable \var{string} \dots)}
\returns an immutable string that appends the argument \var{string}s
\listlibraries
\endentryheader
\noindent
Like \scheme{string-append}, but produces an immutable string.
\section{Vectors}
{\ChezScheme} extends the syntax of vectors to allow the length of the

2
makefiles/Mf-install.in
View File

@ -62,7 +62,7 @@ InstallLZ4Target=
# no changes should be needed below this point #
###############################################################################
Version=csv9.5.3.8
Version=csv9.5.3.9
Include=boot/$m
PetiteBoot=boot/$m/petite.boot
SchemeBoot=boot/$m/scheme.boot

17
mats/5_5.ms
View File

@ -661,13 +661,30 @@
(and (equal? x " ")
(not (eq? x (string-append x)))))
(equal? (string-append "abc") "abc")
(not (immutable-string? (string-append (string->immutable-string "abc"))))
(equal? (string-append "abc" "xyz") "abcxyz")
(equal? (string-append "hi " "there " "mom") "hi there mom")
(not (immutable-string? (string-append "hi " "there " "mom")))
(equal? (string-append "" "there") "there")
(equal? (string-append "hi " "") "hi ")
(eqv? (string-append "" "") "")
)
(mat string-append-immutable
(error? (string-append-immutable 'a))
(error? (string-append-immutable "hi" 'b))
(error? (string-append-immutable "hi" 'b "there"))
(eqv? (string-append-immutable) (string->immutable-string ""))
(equal? (string-append-immutable "abc") "abc")
(immutable-string? (string-append-immutable "abc"))
(equal? (string-append-immutable "abc" "xyz") "abcxyz")
(equal? (string-append-immutable "hi " "there " "mom") "hi there mom")
(immutable-string? (string-append-immutable "hi " "there " "mom"))
(equal? (string-append-immutable "" "there") "there")
(equal? (string-append-immutable "hi " "") "hi ")
(eqv? (string-append-immutable "" "") (string->immutable-string ""))
)
(mat substring
(error? (substring))
(error? (substring "hi"))

3
mats/root-experr-compile-0-f-f-f
View File

@ -2136,6 +2136,9 @@ primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input
5_5.mo:Expected error in mat string-append: "string-append: b is not a string".
5_5.mo:Expected error in mat string-append: "string-append: b is not a string".
5_5.mo:Expected error in mat string-append: "string-copy: a is not a string".
5_5.mo:Expected error in mat string-append-immutable: "string-append-immutable: a is not a string".
5_5.mo:Expected error in mat string-append-immutable: "string-append-immutable: b is not a string".
5_5.mo:Expected error in mat string-append-immutable: "string-append-immutable: b is not a string".
5_5.mo:Expected error in mat substring: "incorrect argument count in call (substring)".
5_5.mo:Expected error in mat substring: "incorrect argument count in call (substring "hi")".
5_5.mo:Expected error in mat substring: "incorrect argument count in call (substring "hi" 0)".

66
s/5_4.ss
View File

@ -30,30 +30,48 @@
((fx= i n) s2)
(string-set! s2 j (string-ref s1 i)))))))
(define-who string-append
(case-lambda
[(s1 s2)
(unless (string? s1) ($oops who "~s is not a string" s1))
(unless (string? s2) ($oops who "~s is not a string" s2))
(let ([n1 (string-length s1)] [n2 (string-length s2)])
(let ([n (+ n1 n2)])
(unless (fixnum? n) ($oops who "result string size ~s is not a fixnum" n))
(let ([s (make-string n)])
(string-copy! s1 0 s 0 n1)
(string-copy! s2 0 s n1 n2)
s)))]
[args
(let f ([ls args] [n 0])
(if (null? ls)
(if (fixnum? n)
(make-string n)
($oops who "result string size ~s is not a fixnum" n))
(let ([s1 (car ls)])
(unless (string? s1) ($oops who "~s is not a string" s1))
(let ([m (string-length s1)])
(let ([s2 (f (cdr ls) (+ n m))])
(string-copy! s1 0 s2 n m)
s2)))))]))
(let ()
(define do-string-append2
(lambda (who s1 s2)
(unless (string? s1) ($oops who "~s is not a string" s1))
(unless (string? s2) ($oops who "~s is not a string" s2))
(let ([n1 (string-length s1)] [n2 (string-length s2)])
(let ([n (+ n1 n2)])
(unless (fixnum? n) ($oops who "result string size ~s is not a fixnum" n))
(let ([s (make-string n)])
(string-copy! s1 0 s 0 n1)
(string-copy! s2 0 s n1 n2)
s)))))
(define do-string-append
(lambda (who args)
(let f ([ls args] [n 0])
(if (null? ls)
(if (fixnum? n)
(make-string n)
($oops who "result string size ~s is not a fixnum" n))
(let ([s1 (car ls)])
(unless (string? s1) ($oops who "~s is not a string" s1))
(let ([m (string-length s1)])
(let ([s2 (f (cdr ls) (+ n m))])
(string-copy! s1 0 s2 n m)
s2)))))))
(define (immutable! str)
(cond
[(eqv? str "") ($tc-field 'null-immutable-string ($tc))]
[else ($string-set-immutable! str)
str]))
(set-who! string-append
(case-lambda
[(s1 s2) (do-string-append2 who s1 s2)]
[args (do-string-append who args)]))
(set-who! string-append-immutable
(case-lambda
[(s1 s2) (immutable! (do-string-append2 who s1 s2))]
[args (immutable! (do-string-append who args))])))
(define string->list
(lambda (s)

2
s/cmacros.ss
View File

@ -328,7 +328,7 @@
[(_ foo e1 e2) e1] ...
[(_ bar e1 e2) e2]))))])))
(define-constant scheme-version #x09050308)
(define-constant scheme-version #x09050309)
(define-syntax define-machine-types
(lambda (x)

5
s/primdata.ss
View File

@ -300,8 +300,6 @@
(symbol->string [sig [(symbol) -> (string)]] [flags true mifoldable discard safeongoodargs ieee r5rs])
(symbol=? [sig [(symbol symbol symbol ...) -> (boolean)]] [flags pure mifoldable discard cp03 safeongoodargs])
(string->symbol [sig [(string) -> (interned-symbol)]] [flags true mifoldable discard safeongoodargs ieee r5rs])
(string->uninterned-symbol [sig [(string) -> (uninterned-symbol)]] [flags true discard safeongoodargs])
(uninterned-symbol? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
(char? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard ieee r5rs])
(char->integer [sig [(char) -> (fixnum)]] [flags pure mifoldable discard safeongoodargs true ieee r5rs])
(integer->char [sig [(sub-ufixnum) -> (char)]] [flags pure mifoldable discard true ieee r5rs])
@ -1672,6 +1670,7 @@
(statistics [sig [() -> (sstats)]] [flags unrestricted alloc])
(string->multibyte [feature windows] [sig [(sub-uint string) -> (bytevector)]] [flags true discard])
(string->number [sig [(string) (string sub-ufixnum) -> (maybe-number)]] [flags discard]) ; radix not restricted to 2, 4, 8, 16
(string-append-immutable [sig [(string ...) -> (string)]] [flags alloc safeongoodargs ieee r5rs])
(string<=? [sig [(string string ...) -> (boolean)]] [flags mifoldable discard safeongoodargs]) ; not restricted to 2+ arguments
(string<? [sig [(string string ...) -> (boolean)]] [flags mifoldable discard safeongoodargs]) ; not restricted to 2+ arguments
(string=? [sig [(string string ...) -> (boolean)]] [flags mifoldable discard cp03 safeongoodargs]) ; not restricted to 2+ arguments
@ -1684,6 +1683,7 @@
(string-ci>? [sig [(string string ...) -> (boolean)]] [flags mifoldable discard safeongoodargs ieee r5rs]) ; not restricted to 2+ arguments
(string-copy! [sig [(string sub-length string sub-length sub-length) -> (void)]] [flags true])
(string->immutable-string [sig [(string) -> (string)]] [flags alloc safeongoodargs])
(string->uninterned-symbol [sig [(string) -> (uninterned-symbol)]] [flags true discard safeongoodargs])
(string-truncate! [sig [(string length) -> (string)]] [flags true])
(strip-fasl-file [sig [(pathname pathname fasl-strip-options) -> (void)]] [flags true])
(sub1 [sig [(number) -> (number)]] [flags arith-op mifoldable discard safeongoodargs])
@ -1733,6 +1733,7 @@
(unbox [sig [(box) -> (ptr)]] [flags mifoldable discard safeongoodargs])
(unget-u8 [sig [(binary-input-port eof/u8) -> (void)]] [flags true])
(unget-char [sig [(textual-input-port eof/char) -> (void)]] [flags true])
(uninterned-symbol? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
(unlock-object [sig [(ptr) -> (void)]] [flags unrestricted true])
(unread-char [sig [(char) (char textual-input-port) -> (void)]] [flags true])
(utf-16-codec [sig [() -> (codec)] [(sub-symbol) -> (codec)]] [flags pure true]) ; has optional eness argument