steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

hashtables were sized wrong; rename str- words to string-

cvs
Slava Pestov 2005-03-05 21:33:40 +00:00
parent f0dfb77690
commit a74632b243
50 changed files with 231 additions and 242 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO.FACTOR.txt
View File

@ -61,7 +61,6 @@
+ kernel:
- hash-size regression
- vectors: ensure its ok with bignum indices
- cat, reverse-cat primitives
- code gc

2
contrib/cont-responder/eval-responder.factor
View File

@ -72,7 +72,7 @@ USE: logging
: escape-quotes ( string -- string )
#! Replace occurrences of single quotes with
#! backslash quote.
[ dup [ [[ CHAR: ' "\\'" ]] [[ CHAR: " "\\\"" ]] ] assoc dup rot ? ] str-map ;
[ dup [ [[ CHAR: ' "\\'" ]] [[ CHAR: " "\\\"" ]] ] assoc dup rot ? ] string-map ;
: make-eval-javascript ( string -- string )
#! Give a string return some javascript that when

6
contrib/cont-responder/todo-example.factor
View File

@ -208,7 +208,7 @@ USE: kernel
] [
drop CHAR: _
] ifte
] str-map ;
] string-map ;
: is-valid-username? ( username -- bool )
#! Return true if the username parses correctly
@ -334,11 +334,11 @@ USE: kernel
: priority-valid? ( string -- bool )
#! Test the string containing a priority to see if it is
#! valid. It should be a single digit from 0-9.
dup str-length 1 = [ 0 swap str-nth digit? ] [ drop f ] ifte ;
dup string-length 1 = [ 0 swap string-nth digit? ] [ drop f ] ifte ;
: todo-details-valid? ( priority description -- bool )
#! Return true if a valid priority and description were entered.
str-length 0 > [ priority-valid? ] [ drop f ] ifte ;
string-length 0 > [ priority-valid? ] [ drop f ] ifte ;
: get-new-todo-item ( -- <todo-item> )
#! Enter a new item to the current todo list.

2
contrib/cont-responder/todo.factor
View File

@ -151,7 +151,7 @@ USE: hashtables
: priority-comparator ( item1 item2 -- bool )
#! Return true if item1 is a higher priority than item2
>r item-priority r> item-priority str-lexi> ;
>r item-priority r> item-priority string> ;
: todo-items ( <todo> -- alist )
#! Return a list of items for the given todo list.

2
contrib/sqlite/sqlite.factor
View File

@ -172,7 +172,7 @@ END-STRUCT
#! Prepare a SQL statement. Returns the statement which
#! can have values bound to parameters or simply executed.
#! TODO: Support multiple statements in the SQL string.
dup str-length <sqlite3-stmt-indirect> dup >r
dup string-length <sqlite3-stmt-indirect> dup >r
<char*-indirect> sqlite3_prepare sqlite-check-result
r> sqlite3-stmt-indirect-pointer ;

6
examples/format.factor
View File

@ -7,16 +7,16 @@ USE: test
: decimal-split ( string -- string string )
#! Split a string before and after the decimal point.
dup "." index-of dup -1 = [ drop f ] [ str// ] ifte ;
dup "." index-of dup -1 = [ drop f ] [ string// ] ifte ;
: decimal-tail ( count str -- string )
#! Given a decimal, trims all but a count of decimal places.
[ str-length min ] keep str-head ;
[ string-length min ] keep string-head ;
: decimal-cat ( before after -- string )
#! If after is of zero length, return before, otherwise
#! return "before.after".
dup str-length 0 = [
dup string-length 0 = [
drop
] [
"." swap cat3

2
examples/irc.factor
View File

@ -77,7 +77,7 @@ M: privmsg irc-display ( line -- )
: say ( line -- )
channel get [ (msg) ] [ "No channel." print ] ifte* ;
: talk ( input -- ) "/" ?str-head [ command ] [ say ] ifte ;
: talk ( input -- ) "/" ?string-head [ command ] [ say ] ifte ;
: talk-loop ( -- ) read [ talk talk-loop ] when* ;
: irc ( nick server -- )

2
examples/lcd.factor
View File

@ -8,7 +8,7 @@ USING: vectors kernel math stdio strings ;
} vector-nth >r 4 * dup 4 + r> substring ;
: lcd-row ( num row -- )
swap [ CHAR: 0 - over lcd-digit write ] str-each drop ;
swap [ CHAR: 0 - over lcd-digit write ] string-each drop ;
: lcd ( num -- str )
3 [ 2dup lcd-row terpri ] repeat drop ;

11
library/bootstrap/image.factor
View File

@ -233,16 +233,17 @@ M: cons ' ( c -- tagged )
( Strings )
: align-string ( n str -- )
tuck str-length - CHAR: \0 fill cat2 ;
tuck string-length - CHAR: \0 fill cat2 ;
: emit-chars ( str -- )
"big-endian" get [ str-reverse ] unless
0 swap [ swap 16 shift + ] str-each emit ;
string>list "big-endian" get [ reverse ] unless
0 swap [ swap 16 shift + ] each emit ;
: (pack-string) ( n list -- )
#! Emit bytes for a string, with n characters per word.
[
2dup str-length > [ dupd align-string ] when emit-chars
2dup string-length > [ dupd align-string ] when
emit-chars
] each drop ;
: pack-string ( string -- )
@ -251,7 +252,7 @@ M: cons ' ( c -- tagged )
: emit-string ( string -- )
object-tag here-as swap
string-type >header emit
dup str-length emit-fixnum
dup string-length emit-fixnum
dup hashcode emit-fixnum
"\0" cat2 pack-string
align-here ;

12
library/bootstrap/primitives.factor
View File

@ -30,20 +30,18 @@ vocabularies get [
[ "ifte" "kernel" [ [ object general-list general-list ] [ ] ] ]
[ "cons" "lists" [ [ object object ] [ cons ] ] ]
[ "<vector>" "vectors" [ [ integer ] [ vector ] ] ]
[ "str-nth" "strings" [ [ integer string ] [ integer ] ] ]
[ "str-compare" "strings" [ [ string string ] [ integer ] ] ]
[ "str=" "strings" [ [ string string ] [ boolean ] ] ]
[ "string-nth" "strings" [ [ integer string ] [ integer ] ] ]
[ "string-compare" "strings" [ [ string string ] [ integer ] ] ]
[ "string=" "strings" [ [ string string ] [ boolean ] ] ]
[ "index-of*" "strings" [ [ integer string text ] [ integer ] ] ]
[ "substring" "strings" [ [ integer integer string ] [ string ] ] ]
[ "str-reverse" "strings" [ [ string ] [ string ] ] ]
[ "<sbuf>" "strings" [ [ integer ] [ sbuf ] ] ]
[ "sbuf-length" "strings" [ [ sbuf ] [ integer ] ] ]
[ "set-sbuf-length" "strings" [ [ integer sbuf ] [ ] ] ]
[ "sbuf-nth" "strings" [ [ integer sbuf ] [ integer ] ] ]
[ "set-sbuf-nth" "strings" [ [ integer integer sbuf ] [ ] ] ]
[ "sbuf-append" "strings" [ [ text sbuf ] [ ] ] ]
[ "sbuf>str" "strings" [ [ sbuf ] [ string ] ] ]
[ "sbuf-reverse" "strings" [ [ sbuf ] [ ] ] ]
[ "sbuf>string" "strings" [ [ sbuf ] [ string ] ] ]
[ "sbuf-clone" "strings" [ [ sbuf ] [ sbuf ] ] ]
[ "sbuf=" "strings" [ [ sbuf sbuf ] [ boolean ] ] ]
[ "arithmetic-type" "math-internals" [ [ object object ] [ object object fixnum ] ] ]
@ -195,7 +193,7 @@ vocabularies get [
[ "next-object" "memory" [ [ ] [ object ] ] ]
[ "end-scan" "memory" [ [ ] [ ] ] ]
[ "size" "memory" [ [ object ] [ fixnum ] ] ]
] [
] [
3unlist >r create >r 1 + r> 2dup swap f define r>
dup string? [
"stack-effect" set-word-prop

4
library/cli.factor
View File

@ -22,7 +22,7 @@ kernel-internals ;
: cli-var-param ( name value -- ) swap ":" split set-path ;
: cli-bool-param ( name -- ) "no-" ?str-head not put ;
: cli-bool-param ( name -- ) "no-" ?string-head not put ;
: cli-param ( param -- )
#! Handle a command-line argument starting with '-' by
@ -36,7 +36,7 @@ kernel-internals ;
: cli-arg ( argument -- argument )
#! Handle a command-line argument. If the argument was
#! consumed, returns f. Otherwise returns the argument.
dup f-or-"" [ "-" ?str-head [ cli-param f ] when ] unless ;
dup f-or-"" [ "-" ?string-head [ cli-param f ] when ] unless ;
: parse-switches ( args -- args )
[ cli-arg ] map ;

30
library/hashtables.factor
View File

@ -9,6 +9,8 @@ DEFER: set-hash-size
IN: hashtables
USING: generic kernel lists math vectors ;
! We put hash-size in the hashtables vocabulary, and
! the other words in kernel-internals.
BUILTIN: hashtable 10
[ 1 "hash-size" set-hash-size ]
[ 2 hash-array set-hash-array ] ;
@ -35,25 +37,19 @@ IN: kernel-internals
[ array-nth swap call ] 2keep
set-array-nth ; inline
: hash-size+ ( hash -- ) dup hash-size 1 + swap set-hash-size ;
: hash-size- ( hash -- ) dup hash-size 1 - swap set-hash-size ;
IN: hashtables
: hash-size+ ( hash -- )
dup hash-size 1 + swap set-hash-size ;
: hash-size- ( hash -- )
dup hash-size 1 - swap set-hash-size ;
: bucket-count ( hash -- n )
hash-array array-capacity ;
: bucket-count ( hash -- n ) hash-array array-capacity ;
: (hashcode) ( key table -- index )
#! Compute the index of the bucket for a key.
>r hashcode r> bucket-count rem ; inline
: hash* ( key table -- [[ key value ]] )
#! Look up a value in the hashtable. First the bucket is
#! determined using the hash function, then the association
#! list therein is searched linearly.
#! Look up a value in the hashtable.
2dup (hashcode) swap hash-bucket assoc* ;
: hash ( key table -- value )
@ -68,7 +64,7 @@ IN: hashtables
-rot 2dup (hashcode) over [
( quot key hash assoc -- )
swapd 2dup
assoc [ rot hash-size- ] [ rot drop ] ifte
assoc* [ rot hash-size- ] [ rot drop ] ifte
rot call
] change-bucket ; inline
@ -97,7 +93,9 @@ IN: hashtables
: rehash ( hash -- )
#! Increase the hashtable size if its too small.
dup rehash? [
dup hash>alist over grow-hash
dup hash>alist
over grow-hash
0 pick set-hash-size
[ unswons rot (set-hash) ] each-with
] [
drop
@ -115,6 +113,7 @@ IN: hashtables
: hash-clear ( hash -- )
#! Remove all entries from a hashtable.
0 over set-hash-size
dup bucket-count [
[ f swap pick set-hash-bucket ] keep
] repeat drop ;
@ -140,8 +139,9 @@ IN: hashtables
>r hash>alist r> each ; inline
M: hashtable clone ( hash -- hash )
dup bucket-count dup <hashtable> [
hash-array rot hash-array rot copy-array
dup bucket-count <hashtable>
over hash-size over set-hash-size [
hash-array swap hash-array dup array-capacity copy-array
] keep ;
: hash-subset? ( subset of -- ? )

2
library/httpd/browser-responder.factor
View File

@ -56,7 +56,7 @@ errors unparser logging listener url-encoding hashtables memory ;
#! Write out the HTML for the list of words in a vocabulary.
<select name= "words" style= "width: 200" size= "20" onchange= "document.forms.main.submit()" select>
words [
word-name dup "current-word" get [ "" ] unless* str-compare 0 = [
word-name dup "current-word" get [ "" ] unless* string-compare 0 = [
"<option selected>" write
] [
"<option>" write

2
library/httpd/file-responder.factor
View File

@ -73,7 +73,7 @@ USE: unparser
] ifte ;
: serve-directory ( filename -- )
"/" ?str-tail [
"/" ?string-tail [
dup "/index.html" cat2 dup exists? [
serve-file
] [

6
library/httpd/html.factor
View File

@ -18,7 +18,7 @@ url-encoding presentation generic ;
: chars>entities ( str -- str )
#! Convert <, >, &, ' and " to HTML entities.
[ dup html-entities assoc dup rot ? ] str-map ;
[ dup html-entities assoc dup rot ? ] string-map ;
: >hex-color ( triplet -- hex )
[ >hex 2 "0" pad ] map "#" swons cat ;
@ -64,8 +64,8 @@ url-encoding presentation generic ;
#! The file responder needs relative links not absolute
#! links.
"doc-root" get [
?str-head [ "/" ?str-head drop ] when
] when* "/" ?str-tail drop ;
?string-head [ "/" ?string-head drop ] when
] when* "/" ?string-tail drop ;
: file-link-href ( path -- href )
[ "/" , resolve-file-link url-encode , ] make-string ;

4
library/httpd/httpd.factor
View File

@ -13,7 +13,7 @@ stdio streams strings threads url-encoding ;
] ifte ;
: (url>path) ( uri -- path )
url-decode "http://" ?str-head [
url-decode "http://" ?string-head [
"/" split1 dup "" ? nip
] when ;
@ -25,7 +25,7 @@ stdio streams strings threads url-encoding ;
] ifte ;
: secure-path ( path -- path )
".." over str-contains? [ drop f ] when ;
".." over string-contains? [ drop f ] when ;
: request-method ( cmd -- method )
[

4
library/httpd/responder.factor
View File

@ -103,13 +103,13 @@ USE: strings
: trim-/ ( url -- url )
#! Trim a leading /, if there is one.
"/" ?str-head drop ;
"/" ?string-head drop ;
: serve-responder ( method url -- )
#! Responder URLs come in two forms:
#! /foo/bar... - default-responder used
#! /responder/foo/bar - responder foo, argument bar
dup log-responder trim-/ "responder/" ?str-head [
dup log-responder trim-/ "responder/" ?string-head [
serve-explicit-responder
] [
serve-default-responder

8
library/httpd/url-encoding.factor
View File

@ -40,14 +40,14 @@ USE: unparser
dup url-quotable? [
"%" swap >hex 2 "0" pad cat2
] unless
] str-map ;
] string-map ;
: catch-hex> ( str -- n )
#! Push f if string is not a valid hex literal.
[ hex> ] [ [ drop f ] when ] catch ;
: url-decode-hex ( index str -- )
2dup str-length 2 - >= [
2dup string-length 2 - >= [
2drop
] [
>r 1 + dup 2 + r> substring catch-hex> [ , ] when*
@ -60,10 +60,10 @@ USE: unparser
dup CHAR: + = [ drop CHAR: \s ] when , >r 1 + r> ;
: url-decode-iter ( index str -- )
2dup str-length >= [
2dup string-length >= [
2drop
] [
2dup str-nth dup CHAR: % = [
2dup string-nth dup CHAR: % = [
drop url-decode-%
] [
url-decode-+-or-other

6
library/io/buffer.factor
View File

@ -78,15 +78,15 @@ C: buffer ( size -- buffer )
dup buffer-size swap buffer-fill - ;
: buffer-set ( string buffer -- )
2dup buffer-ptr string>memory >r str-length r> buffer-reset ;
2dup buffer-ptr string>memory >r string-length r> buffer-reset ;
: (check-overflow) ( string buffer -- )
buffer-capacity swap str-length < [ "Buffer overflow" throw ] when ;
buffer-capacity swap string-length < [ "Buffer overflow" throw ] when ;
: buffer-append ( string buffer -- )
2dup (check-overflow)
[ dup buffer-ptr swap buffer-fill + string>memory ] 2keep
[ buffer-fill swap str-length + ] keep set-buffer-fill ;
[ buffer-fill swap string-length + ] keep set-buffer-fill ;
: buffer-append-char ( int buffer -- )
#! Append a single character to a buffer

2
library/io/files.factor
View File

@ -12,7 +12,7 @@ strings unparser ;
: directory ( dir -- list )
#! List a directory.
(directory) [ str-lexi> ] sort ;
(directory) [ string> ] sort ;
: file-length ( file -- length )
stat dup [ cdr cdr car ] when ;

6
library/io/io-internals.factor
View File

@ -46,7 +46,7 @@ BUILTIN: port 14 ;
: blocking-write ( str port -- )
over
dup string? [ str-length ] [ drop 1 ] ifte
dup string? [ string-length ] [ drop 1 ] ifte
over wait-to-write write-fd-8 ;
: blocking-fill ( port -- )
@ -56,7 +56,7 @@ BUILTIN: port 14 ;
dup can-read-line? [ drop ] [ blocking-fill ] ifte ;
: blocking-read-line ( port -- line )
dup wait-to-read-line read-line-fd-8 dup [ sbuf>str ] when ;
dup wait-to-read-line read-line-fd-8 dup [ sbuf>string ] when ;
: fill-fd ( count port -- )
[ add-read-count-io-task (yield) ] callcc0 2drop ;
@ -65,7 +65,7 @@ BUILTIN: port 14 ;
2dup can-read-count? [ 2drop ] [ fill-fd ] ifte ;
: blocking-read ( count port -- str )
2dup wait-to-read read-count-fd-8 dup [ sbuf>str ] when ;
2dup wait-to-read read-count-fd-8 dup [ sbuf>string ] when ;
: wait-to-accept ( socket -- )
[ add-accept-io-task (yield) ] callcc0 drop ;

4
library/io/stream.factor
View File

@ -14,7 +14,7 @@ GENERIC: stream-close ( stream -- )
: stream-read1 ( stream -- char/f )
1 swap stream-read
dup f-or-"" [ drop f ] [ 0 swap str-nth ] ifte ;
dup f-or-"" [ drop f ] [ 0 swap string-nth ] ifte ;
: stream-write ( string stream -- )
f swap stream-write-attr ;
@ -37,7 +37,7 @@ M: string-output stream-auto-flush ( stream -- ) drop ;
: stream>str ( stream -- string )
#! Returns the string written to the given string output
#! stream.
string-output-buf sbuf>str ;
string-output-buf sbuf>string ;
C: string-output ( size -- stream )
#! Creates a new stream for writing to a string buffer.

22
library/io/win32-stream.factor
View File

@ -70,11 +70,11 @@ M: integer do-write ( int -- )
buffer-append-char ;
M: string do-write ( str -- )
dup str-length out-buffer get buffer-capacity <= [
dup string-length out-buffer get buffer-capacity <= [
out-buffer get buffer-append
] [
dup str-length out-buffer get buffer-size > [
dup str-length out-buffer get buffer-extend do-write
dup string-length out-buffer get buffer-size > [
dup string-length out-buffer get buffer-extend do-write
] [ flush-output do-write ] ifte
] ifte ;
@ -95,16 +95,16 @@ M: string do-write ( str -- )
dup in-buffer get buffer-first-n
swap in-buffer get buffer-consume ;
: sbuf>str-or-f ( sbuf -- str-or-? )
dup sbuf-length 0 > [ sbuf>str ] [ drop f ] ifte ;
: sbuf>string-or-f ( sbuf -- str-or-? )
dup sbuf-length 0 > [ sbuf>string ] [ drop f ] ifte ;
: do-read-count ( sbuf count -- str )
dup 0 = [
drop sbuf>str
drop sbuf>string
] [
dup consume-input
dup str-length dup 0 = [
3drop sbuf>str-or-f
dup string-length dup 0 = [
3drop sbuf>string-or-f
] [
>r swap r> - >r swap [ sbuf-append ] keep r> do-read-count
] ifte
@ -114,14 +114,14 @@ M: string do-write ( str -- )
1 in-buffer get buffer-first-n ;
: do-read-line ( sbuf -- str )
1 consume-input dup str-length 0 = [ drop sbuf>str-or-f ] [
1 consume-input dup string-length 0 = [ drop sbuf>string-or-f ] [
dup "\r" = [
peek-input "\n" = [ 1 consume-input drop ] when
drop sbuf>str
drop sbuf>string
] [
dup "\n" = [
peek-input "\r" = [ 1 consume-input drop ] when
drop sbuf>str
drop sbuf>string
] [
over sbuf-append do-read-line
] ifte

20
library/sbuf.factor
View File

@ -8,25 +8,25 @@ IN: strings USING: kernel lists math namespaces strings ;
[ swap [ dup , ] times drop ] make-string ;
: pad ( string count char -- string )
>r over str-length - dup 0 <= [
>r over string-length - dup 0 <= [
r> 2drop
] [
r> fill swap cat2
] ifte ;
: str-map ( str code -- str )
: string-map ( str code -- str )
#! Apply a quotation to each character in the string, and
#! push a new string constructed from return values.
#! The quotation must have stack effect ( X -- X ).
over str-length <sbuf> rot [
over string-length <sbuf> rot [
swap >r apply swap r> tuck sbuf-append
] str-each nip sbuf>str ; inline
] string-each nip sbuf>string ; inline
: split-next ( index string split -- next )
3dup index-of* dup -1 = [
>r drop str-tail , r> ( end of string )
>r drop string-tail , r> ( end of string )
] [
swap str-length dupd + >r swap substring , r>
swap string-length dupd + >r swap substring , r>
] ifte ;
: (split) ( index string split -- )
@ -42,10 +42,10 @@ IN: strings USING: kernel lists math namespaces strings ;
[ 0 -rot (split) ] make-list ;
: split-n-advance substring , >r tuck + swap r> ;
: split-n-finish nip dup str-length swap substring , ;
: split-n-finish nip dup string-length swap substring , ;
: (split-n) ( start n str -- )
3dup >r dupd + r> 2dup str-length < [
3dup >r dupd + r> 2dup string-length < [
split-n-advance (split-n)
] [
split-n-finish 3drop
@ -55,5 +55,5 @@ IN: strings USING: kernel lists math namespaces strings ;
#! Split a string into n-character chunks.
[ 0 -rot (split-n) ] make-list ;
: ch>str ( ch -- str )
1 <sbuf> [ sbuf-append ] keep sbuf>str ;
: ch>string ( ch -- str )
1 <sbuf> [ sbuf-append ] keep sbuf>string ;

8
library/sdl/sdl-utils.factor
View File

@ -135,12 +135,12 @@ global [
] when drop ;
: filter-nulls ( str -- str )
"\0" over str-contains? [
[ dup CHAR: \0 = [ drop CHAR: \s ] when ] str-map
"\0" over string-contains? [
[ dup CHAR: \0 = [ drop CHAR: \s ] when ] string-map
] when ;
: draw-string ( x y font text fg -- width )
>r filter-nulls r> over str-length 0 = [
>r filter-nulls r> over string-length 0 = [
2drop 3drop 0
] [
>r >r lookup-font r> r>
@ -151,7 +151,7 @@ global [
] ifte ;
: size-string ( font text -- w h )
>r lookup-font r> filter-nulls dup str-length 0 = [
>r lookup-font r> filter-nulls dup string-length 0 = [
drop TTF_FontHeight 0 swap
] [
<int-box> <int-box> [ TTF_SizeUNICODE drop ] 2keep

80
library/strings.factor
View File

@ -2,8 +2,8 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: strings USING: generic kernel kernel-internals lists math ;
BUILTIN: string 12 [ 1 "str-length" f ] [ 2 hashcode f ] ;
M: string = str= ;
BUILTIN: string 12 [ 1 "string-length" f ] [ 2 hashcode f ] ;
M: string = string= ;
BUILTIN: sbuf 13 ;
M: sbuf = sbuf= ;
@ -13,21 +13,21 @@ UNION: text string integer ;
: f-or-"" ( obj -- ? )
dup not swap "" = or ;
: str-length< ( str str -- boolean )
: string-length< ( str str -- boolean )
#! Compare string lengths.
swap str-length swap str-length < ;
swap string-length swap string-length < ;
: cat ( [ "a" "b" "c" ] -- "abc" )
! If f appears in the list, it is not appended to the
! string.
80 <sbuf> swap [ [ over sbuf-append ] when* ] each sbuf>str ;
80 <sbuf> swap [ [ over sbuf-append ] when* ] each sbuf>string ;
: cat2 ( "a" "b" -- "ab" )
swap
80 <sbuf>
dup >r sbuf-append r>
dup >r sbuf-append r>
sbuf>str ;
sbuf>string ;
: cat3 ( "a" "b" "c" -- "abc" )
[ ] cons cons cons cat ;
@ -35,58 +35,58 @@ UNION: text string integer ;
: index-of ( string substring -- index )
0 -rot index-of* ;
: str-lexi> ( str1 str2 -- ? )
: string> ( str1 str2 -- ? )
! Returns if the first string lexicographically follows str2
str-compare 0 > ;
string-compare 0 > ;
: str-head ( index str -- str )
: string-head ( index str -- str )
#! Returns a new string, from the beginning of the string
#! until the given index.
0 -rot substring ;
: str-contains? ( substr str -- ? )
: string-contains? ( substr str -- ? )
swap index-of -1 = not ;
: str-tail ( index str -- str )
: string-tail ( index str -- str )
#! Returns a new string, from the given index until the end
#! of the string.
[ str-length ] keep substring ;
[ string-length ] keep substring ;
: str/ ( str index -- str str )
: string/ ( str index -- str str )
#! Returns 2 strings, that when concatenated yield the
#! original string.
[ swap str-head ] 2keep swap str-tail ;
[ swap string-head ] 2keep swap string-tail ;
: str// ( str index -- str str )
: string// ( str index -- str str )
#! Returns 2 strings, that when concatenated yield the
#! original string, without the character at the given
#! index.
[ swap str-head ] 2keep 1 + swap str-tail ;
[ swap string-head ] 2keep 1 + swap string-tail ;
: str-head? ( str begin -- ? )
2dup str-length< [
: string-head? ( str begin -- ? )
2dup string-length< [
2drop f
] [
dup str-length rot str-head =
dup string-length rot string-head =
] ifte ;
: ?str-head ( str begin -- str ? )
2dup str-head? [
str-length swap str-tail t
: ?string-head ( str begin -- str ? )
2dup string-head? [
string-length swap string-tail t
] [
drop f
] ifte ;
: str-tail? ( str end -- ? )
2dup str-length< [
: string-tail? ( str end -- ? )
2dup string-length< [
2drop f
] [
dup str-length pick str-length swap - rot str-tail =
dup string-length pick string-length swap - rot string-tail =
] ifte ;
: ?str-tail ( str end -- ? )
2dup str-tail? [
str-length swap [ str-length swap - ] keep str-head t
: ?string-tail ( str end -- ? )
2dup string-tail? [
string-length swap [ string-length swap - ] keep string-head t
] [
drop f
] ifte ;
@ -95,26 +95,26 @@ UNION: text string integer ;
2dup index-of dup -1 = [
2drop f
] [
[ swap str-length + over str-tail ] keep
rot str-head swap
[ swap string-length + over string-tail ] keep
rot string-head swap
] ifte ;
: (str>list) ( i str -- list )
2dup str-length >= [
: (string>list) ( i str -- list )
2dup string-length >= [
2drop [ ]
] [
2dup str-nth >r >r 1 + r> (str>list) r> swons
2dup string-nth >r >r 1 + r> (string>list) r> swons
] ifte ;
: str>list ( str -- list )
0 swap (str>list) ;
: string>list ( str -- list )
0 swap (string>list) ;
: str-each ( str quot -- )
: string-each ( str quot -- )
#! Execute the quotation with each character of the string
#! pushed onto the stack.
>r str>list r> each ; inline
>r string>list r> each ; inline
PREDICATE: integer blank " \t\n\r" str-contains? ;
PREDICATE: integer blank " \t\n\r" string-contains? ;
PREDICATE: integer letter CHAR: a CHAR: z between? ;
PREDICATE: integer LETTER CHAR: A CHAR: Z between? ;
PREDICATE: integer digit CHAR: 0 CHAR: 9 between? ;
@ -123,7 +123,7 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
: quotable? ( ch -- ? )
#! In a string literal, can this character be used without
#! escaping?
dup printable? swap "\"\\" str-contains? not and ;
dup printable? swap "\"\\" string-contains? not and ;
: url-quotable? ( ch -- ? )
#! In a URL, can this character be used without
@ -131,4 +131,4 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
dup letter?
over LETTER? or
over digit? or
swap "/_?." str-contains? or ;
swap "/_?." string-contains? or ;

12
library/syntax/parse-numbers.factor
View File

@ -50,26 +50,26 @@ M: object digit> not-a-number ;
2dup < [ rot * + ] [ not-a-number ] ifte ;
: (base>) ( base str -- num )
dup str-length 0 = [
dup string-length 0 = [
not-a-number
] [
0 swap [ digit> pick digit+ ] str-each nip
0 swap [ digit> pick digit+ ] string-each nip
] ifte ;
: base> ( str base -- num )
#! Convert a string to an integer. Throw an error if
#! conversion fails.
swap "-" ?str-head [ (base>) neg ] [ (base>) ] ifte ;
swap "-" ?string-head [ (base>) neg ] [ (base>) ] ifte ;
GENERIC: str>number ( str -- num )
M: string str>number 10 base> ;
PREDICATE: string potential-ratio "/" swap str-contains? ;
PREDICATE: string potential-ratio "/" swap string-contains? ;
M: potential-ratio str>number ( str -- num )
dup CHAR: / index-of str// swap 10 base> swap 10 base> / ;
dup CHAR: / index-of string// swap 10 base> swap 10 base> / ;
PREDICATE: string potential-float "." swap str-contains? ;
PREDICATE: string potential-float "." swap string-contains? ;
M: potential-float str>number ( str -- num )
str>float ;

2
library/syntax/parse-syntax.factor
View File

@ -96,7 +96,7 @@ math namespaces parser strings words vectors unparse ;
! String literal
: parse-string ( n str -- n )
2dup str-nth CHAR: " = [
2dup string-nth CHAR: " = [
drop 1 +
] [
[ next-char swap , ] keep parse-string

22
library/syntax/parser.factor
View File

@ -20,14 +20,14 @@ unparser ;
: skip ( n line quot -- n )
#! Find the next character that satisfies the quotation,
#! which should have stack effect ( ch -- ? ).
>r 2dup str-length < [
2dup str-nth r> dup >r call [
>r 2dup string-length < [
2dup string-nth r> dup >r call [
r> 2drop
] [
>r 1 + r> r> skip
] ifte
] [
r> drop nip str-length
r> drop nip string-length
] ifte ; inline
: skip-blank ( n line -- n )
@ -41,10 +41,10 @@ unparser ;
#! "hello world"
#!
#! Will call the parsing word ".
"\"" str-contains? ;
"\"" string-contains? ;
: skip-word ( n line -- n )
2dup str-nth denotation? [
2dup string-nth denotation? [
drop 1 +
] [
[ blank? ] skip
@ -52,7 +52,7 @@ unparser ;
: (scan) ( n line -- start end )
[ skip-blank dup ] keep
2dup str-length < [ skip-word ] [ drop ] ifte ;
2dup string-length < [ skip-word ] [ drop ] ifte ;
: scan ( -- token )
"col" get "line" get dup >r (scan) dup "col" set
@ -98,7 +98,7 @@ global [ string-mode off ] bind
ch-search (until) ;
: (until-eol) ( -- index )
"\n" ch-search dup -1 = [ drop "line" get str-length ] when ;
"\n" ch-search dup -1 = [ drop "line" get string-length ] when ;
: until-eol ( -- str )
#! This is just a hack to get "eval" to work with multiline
@ -132,17 +132,17 @@ global [ string-mode off ] bind
] assoc dup [ "Bad escape" throw ] unless ;
: next-escape ( n str -- ch n )
2dup str-nth CHAR: u = [
2dup string-nth CHAR: u = [
swap 1 + dup 4 + [ rot substring hex> ] keep
] [
over 1 + >r str-nth escape r>
over 1 + >r string-nth escape r>
] ifte ;
: next-char ( n str -- ch n )
2dup str-nth CHAR: \\ = [
2dup string-nth CHAR: \\ = [
>r 1 + r> next-escape
] [
over 1 + >r str-nth r>
over 1 + >r string-nth r>
] ifte ;
: doc-comment-here? ( parsed -- ? )

4
library/syntax/unparser.factor
View File

@ -54,7 +54,7 @@ M: ratio unparse ( num -- str )
: fix-float ( str -- str )
#! This is terrible. Will go away when we do our own float
#! output.
"." over str-contains? [ ".0" cat2 ] unless ;
"." over string-contains? [ ".0" cat2 ] unless ;
M: float unparse ( float -- str )
(unparse-float) fix-float ;
@ -90,7 +90,7 @@ M: complex unparse ( num -- str )
M: string unparse ( str -- str )
[
CHAR: " , [ unparse-ch , ] str-each CHAR: " ,
CHAR: " , [ unparse-ch , ] string-each CHAR: " ,
] make-string ;
M: word unparse ( obj -- str )

6
library/test/benchmark/strings.factor
View File

@ -9,10 +9,10 @@ USE: compiler
! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
: string-step ( n str -- )
2dup str-length > [
2dup string-length > [
dup [ "123" , , "456" , , "789" , ] make-string
dup dup str-length 2 /i 0 swap rot substring
swap dup str-length 2 /i 1 + 1 swap rot substring cat2
dup dup string-length 2 /i 0 swap rot substring
swap dup string-length 2 /i 1 + 1 swap rot substring cat2
string-step
] [
2drop

4
library/test/crashes.factor
View File

@ -53,7 +53,7 @@ prettyprint strings test vectors words ;
! Forgot to tag out of bounds index
[ 1 { } vector-nth ] [ garbage-collection drop ] catch
[ -1 { } set-vector-length ] [ garbage-collection drop ] catch
[ 1 "" str-nth ] [ garbage-collection drop ] catch
[ 1 "" string-nth ] [ garbage-collection drop ] catch
! ... and again
[ "" 10 str/ ] [ . ] catch
[ "" 10 string/ ] [ . ] catch

35
library/test/hashtables.factor
View File

@ -84,3 +84,38 @@ f 100000000000000000000000000 "testhash" get set-hash
[ f ] [ {{ }} {{ [[ 1 3 ]] }} = ] unit-test
[ t ] [ {{ [[ 1 3 ]] }} {{ [[ 1 3 ]] }} = ] unit-test
[ f ] [ {{ [[ 1 3 ]] }} {{ [[ 1 "hey" ]] }} = ] unit-test
! Test rehashing
2 <hashtable> "rehash" set
1 1 "rehash" get set-hash
2 2 "rehash" get set-hash
3 3 "rehash" get set-hash
4 4 "rehash" get set-hash
5 5 "rehash" get set-hash
6 6 "rehash" get set-hash
[ 6 ] [ "rehash" get hash-size ] unit-test
[ 6 ] [ "rehash" get clone hash-size ] unit-test
"rehash" get hash-clear
[ 0 ] [ "rehash" get hash-size ] unit-test
[
3
] [
2 {{
[[ 1 2 ]]
[[ 2 3 ]]
}} clone hash
] unit-test
! There was an assoc in place of assoc* somewhere
3 <hashtable> "f-hash-test" set
10 [ f f "f-hash-test" get set-hash ] times
[ 1 ] [ "f-hash-test" get hash-size ] unit-test

4
library/test/line-editor.factor
View File

@ -15,7 +15,7 @@ USE: prettyprint
[ t ] [
"editor" get [ caret get ] bind
"Hello world" str-length =
"Hello world" string-length =
] unit-test
[ "Hello, crazy world" ] [
@ -33,7 +33,7 @@ USE: prettyprint
] unit-test
[ "Hello, crazy" ] [
"editor" get [ caret get line-text get str-head ] bind
"editor" get [ caret get line-text get string-head ] bind
] unit-test
[ 0 ]

2
library/test/lists/combinators.factor
View File

@ -19,7 +19,7 @@ USE: strings
[ "fdsfs" [ > ] sort ] unit-test-fails
[ [ ] ] [ [ ] [ > ] sort ] unit-test
[ [ "2 + 2" ] ] [ [ "2 + 2" ] [ str-lexi> ] sort ] unit-test
[ [ "2 + 2" ] ] [ [ "2 + 2" ] [ string> ] sort ] unit-test
[ [ 1 2 3 4 5 6 7 ] ] [ [ 6 4 5 7 2 1 3 ] [ > ] sort ] unit-test
[ f ] [ [ { } { } "Hello" ] all=? ] unit-test

2
library/test/parsing-word.factor
View File

@ -19,5 +19,5 @@ DEFER: foo
! Test > 1 ( ) comment; only the first one should be used.
[ t ] [
"a" ": foo ( a ) ( b ) ;" parse drop word
"stack-effect" word-prop str-contains?
"stack-effect" word-prop string-contains?
] unit-test

2
library/test/sbuf.factor
View File

@ -11,5 +11,5 @@ USE: test
"Hello" "buf" get sbuf-append
"buf" get sbuf-clone "buf-clone" set
"World" "buf-clone" get sbuf-append
"buf" get sbuf>str
"buf" get sbuf>string
] unit-test

45
library/test/strings.factor
View File

@ -24,29 +24,29 @@ USE: test
[ -1 ] [ "hola" "amigo" index-of ] unit-test
[ -1 ] [ "hola" "holaa" index-of ] unit-test
[ "Beginning" ] [ 9 "Beginning and end" str-head ] unit-test
[ "Beginning" ] [ 9 "Beginning and end" string-head ] unit-test
[ f ] [ "I" "team" str-contains? ] unit-test
[ t ] [ "ea" "team" str-contains? ] unit-test
[ f ] [ "actore" "Factor" str-contains? ] unit-test
[ f ] [ "I" "team" string-contains? ] unit-test
[ t ] [ "ea" "team" string-contains? ] unit-test
[ f ] [ "actore" "Factor" string-contains? ] unit-test
[ "end" ] [ 14 "Beginning and end" str-tail ] unit-test
[ "end" ] [ 14 "Beginning and end" string-tail ] unit-test
[ "Beginning" " and end" ] [ "Beginning and end" 9 str/ ] unit-test
[ "Beginning" " and end" ] [ "Beginning and end" 9 string/ ] unit-test
[ "Beginning" "and end" ] [ "Beginning and end" 9 str// ] unit-test
[ "Beginning" "and end" ] [ "Beginning and end" 9 string// ] unit-test
[ "hello" "world" ] [ "hello world" " " split1 ] unit-test
[ "goodbye" f ] [ "goodbye" " " split1 ] unit-test
[ "" "" ] [ "great" "great" split1 ] unit-test
[ "and end" t ] [ "Beginning and end" "Beginning " ?str-head ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?str-head ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?str-head ] unit-test
[ "and end" t ] [ "Beginning and end" "Beginning " ?string-head ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?string-head ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?string-head ] unit-test
[ "Beginning" t ] [ "Beginning and end" " and end" ?str-tail ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?str-tail ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?str-tail ] unit-test
[ "Beginning" t ] [ "Beginning and end" " and end" ?string-tail ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?string-tail ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?string-tail ] unit-test
[ [ "This" "is" "a" "split" "sentence" ] ]
[ "This is a split sentence" " " split ]
@ -59,10 +59,10 @@ unit-test
[ [ "a" "b" "c" "d" "e" "f" ] ]
[ "aXXbXXcXXdXXeXXf" "XX" split ] unit-test
[ "Hello world" t ] [ "Hello world\n" "\n" ?str-tail ] unit-test
[ "Hello world" f ] [ "Hello world" "\n" ?str-tail ] unit-test
[ "" t ] [ "\n" "\n" ?str-tail ] unit-test
[ "" f ] [ "" "\n" ?str-tail ] unit-test
[ "Hello world" t ] [ "Hello world\n" "\n" ?string-tail ] unit-test
[ "Hello world" f ] [ "Hello world" "\n" ?string-tail ] unit-test
[ "" t ] [ "\n" "\n" ?string-tail ] unit-test
[ "" f ] [ "" "\n" ?string-tail ] unit-test
[ t ] [ CHAR: a letter? ] unit-test
[ f ] [ CHAR: A letter? ] unit-test
@ -71,11 +71,8 @@ unit-test
[ t ] [ CHAR: 0 digit? ] unit-test
[ f ] [ CHAR: x digit? ] unit-test
[ t ] [ "abc" "abd" str-compare 0 < ] unit-test
[ t ] [ "z" "abd" str-compare 0 > ] unit-test
[ "fedcba" ] [ "abcdef" str-reverse ] unit-test
[ "edcba" ] [ "abcde" str-reverse ] unit-test
[ t ] [ "abc" "abd" string-compare 0 < ] unit-test
[ t ] [ "z" "abd" string-compare 0 > ] unit-test
[ f ] [ [ 0 10 "hello" substring ] [ not ] catch ] unit-test
@ -83,13 +80,13 @@ unit-test
[ 4 ] [
0 "There are Four Upper Case characters"
[ LETTER? [ 1 + ] when ] str-each
[ LETTER? [ 1 + ] when ] string-each
] unit-test
[ "Replacing+spaces+with+plus" ]
[
"Replacing spaces with plus"
[ dup CHAR: \s = [ drop CHAR: + ] when ] str-map
[ dup CHAR: \s = [ drop CHAR: + ] when ] string-map
]
unit-test

4
library/tools/jedit-wire.factor
View File

@ -49,7 +49,7 @@ USE: listener
! captured with with-string.
: write-packet ( string -- )
dup str-length write-big-endian-32 write flush ;
dup string-length write-big-endian-32 write flush ;
: read-packet ( -- string )
read-big-endian-32 read ;
@ -75,7 +75,7 @@ USE: listener
: jedit-write-attr ( str style -- )
CHAR: w write
[ swap . . ] with-string
dup str-length write-big-endian-32
dup string-length write-big-endian-32
write ;
TUPLE: jedit-stream delegate ;

2
library/tools/jedit.factor
View File

@ -26,7 +26,7 @@ strings unparser words ;
: send-jedit-request ( request -- )
jedit-server-info swap "localhost" swap <client> [
write-big-endian-32
dup str-length write-big-endian-16
dup string-length write-big-endian-16
write flush
] with-stream ;

6
library/tools/word-tools.factor
View File

@ -42,7 +42,7 @@ M: 2generic word-uses? ( of in -- ? ) generic-uses? ;
: vocab-apropos ( substring vocab -- list )
#! Push a list of all words in a vocabulary whose names
#! contain a string.
words [ word-name dupd str-contains? ] subset nip ;
words [ word-name dupd string-contains? ] subset nip ;
: vocab-apropos. ( substring vocab -- )
#! List all words in a vocabulary that contain a string.
@ -55,7 +55,7 @@ M: 2generic word-uses? ( of in -- ? ) generic-uses? ;
: vocab-completions ( substring vocab -- list )
#! Used by jEdit plugin. Like vocab-apropos, but only
#! matches at the start of a word name are considered.
words [ word-name over ?str-head nip ] subset nip ;
words [ word-name over ?string-head nip ] subset nip ;
: apropos. ( substring -- )
#! List all words that contain a string.
@ -78,7 +78,7 @@ M: 2generic word-uses? ( of in -- ? ) generic-uses? ;
: word-file ( word -- file )
"file" word-prop dup [
"resource:/" ?str-head [
"resource:/" ?string-head [
resource-path swap path+
] when
] when ;

6
library/ui/editors.factor
View File

@ -28,8 +28,8 @@ TUPLE: editor line caret delegate ;
: run-char-widths ( str -- wlist )
#! List of x co-ordinates of each character.
0 swap str>list
[ ch>str shape-w [ + dup ] keep 2 /i - ] map nip ;
0 swap string>list
[ ch>string shape-w [ + dup ] keep 2 /i - ] map nip ;
: (x>offset) ( n x wlist -- offset )
dup [
@ -77,7 +77,7 @@ C: editor ( text -- )
dup editor-actions ;
: offset>x ( offset str -- x )
str-head font get swap size-string drop ;
string-head font get swap size-string drop ;
: caret-pos ( editor -- x y )
editor-line [ caret get line-text get ] bind offset>x 0 ;

2
library/ui/inspector.factor
View File

@ -11,7 +11,7 @@ lists namespaces strings unparser vectors words ;
: sort-sheet ( assoc -- assoc )
#! Sort an association list whose keys are arbitrary objects
[ 2car swap unparse* swap unparse* str-lexi> ] sort ;
[ 2car swap unparse* swap unparse* string> ] sort ;
: alist>sheet ( assoc -- sheet )
unzip swap

14
library/ui/line-editor.factor
View File

@ -60,7 +60,7 @@ SYMBOL: history-index
: set-line-text ( text -- )
#! Call this in the line editor scope.
dup line-text set str-length caret set ;
dup line-text set string-length caret set ;
: goto-history ( n -- )
#! Call this in the line editor scope.
@ -99,7 +99,7 @@ SYMBOL: history-index
: caret-insert ( str offset -- )
#! Call this in the line editor scope.
caret get <= [
str-length caret [ + ] change
string-length caret [ + ] change
] [
drop
] ifte ;
@ -108,12 +108,12 @@ SYMBOL: history-index
#! Call this in the line editor scope.
reset-history
2dup caret-insert
line-text get swap str/
line-text get swap string/
swapd cat3 line-text set ;
: insert-char ( ch -- )
#! Call this in the line editor scope.
ch>str caret get line-insert ;
ch>string caret get line-insert ;
: caret-remove ( offset length -- )
#! Call this in the line editor scope.
@ -131,8 +131,8 @@ SYMBOL: history-index
#! Call this in the line editor scope.
reset-history
2dup caret-remove
dupd + line-text get str-tail
>r line-text get str-head r> cat2
dupd + line-text get string-tail
>r line-text get string-head r> cat2
line-text set ;
: backspace ( -- )
@ -145,4 +145,4 @@ SYMBOL: history-index
: right ( -- )
#! Call this in the line editor scope.
caret [ 1 + line-text get str-length min ] change ;
caret [ 1 + line-text get string-length min ] change ;

4
library/vocabularies.factor
View File

@ -7,7 +7,7 @@ IN: words USING: hashtables kernel lists namespaces strings ;
: vocabs ( -- list )
#! Push a list of vocabularies.
vocabularies get hash-keys [ str-lexi> ] sort ;
vocabularies get hash-keys [ string> ] sort ;
: vocab ( name -- vocab )
#! Get a vocabulary.
@ -15,7 +15,7 @@ IN: words USING: hashtables kernel lists namespaces strings ;
: word-sort ( list -- list )
#! Sort a list of words by name.
[ swap word-name swap word-name str-lexi> ] sort ;
[ swap word-name swap word-name string> ] sort ;
: words ( vocab -- list )
#! Push a list of all words in a vocabulary.

2
native/primitives.c
View File

@ -14,7 +14,6 @@ void* primitives[] = {
primitive_string_eq,
primitive_index_of,
primitive_substring,
primitive_string_reverse,
primitive_sbuf,
primitive_sbuf_length,
primitive_set_sbuf_length,
@ -22,7 +21,6 @@ void* primitives[] = {
primitive_set_sbuf_nth,
primitive_sbuf_append,
primitive_sbuf_to_string,
primitive_sbuf_reverse,
primitive_sbuf_clone,
primitive_sbuf_eq,
primitive_arithmetic_type,

6
native/sbuf.c
View File

@ -133,12 +133,6 @@ void primitive_sbuf_to_string(void)
drepl(tag_object(s));
}
void primitive_sbuf_reverse(void)
{
F_SBUF* sbuf = untag_sbuf(dpop());
string_reverse(untag_string(sbuf->string),sbuf->top);
}
void primitive_sbuf_clone(void)
{
F_SBUF* s;

1
native/sbuf.h
View File

@ -25,7 +25,6 @@ void primitive_set_sbuf_nth(void);
void sbuf_append_string(F_SBUF* sbuf, F_STRING* string);
void primitive_sbuf_append(void);
void primitive_sbuf_to_string(void);
void primitive_sbuf_reverse(void);
void primitive_sbuf_clone(void);
bool sbuf_eq(F_SBUF* s1, F_SBUF* s2);
void primitive_sbuf_eq(void);

30
native/string.c
View File

@ -312,21 +312,6 @@ void primitive_substring(void)
dpush(tag_object(substring(start,end,string)));
}
/* DESTRUCTIVE - don't use with user-visible strings */
void string_reverse(F_STRING* s, int len)
{
int i, j;
uint16_t ch1, ch2;
for(i = 0; i < len / 2; i++)
{
j = len - i - 1;
ch1 = string_nth(s,i);
ch2 = string_nth(s,j);
set_string_nth(s,j,ch1);
set_string_nth(s,i,ch2);
}
}
/* Doesn't rehash the string! */
F_STRING* string_clone(F_STRING* s, int len)
{
@ -334,18 +319,3 @@ F_STRING* string_clone(F_STRING* s, int len)
memcpy(copy + 1,s + 1,len * CHARS);
return copy;
}
void primitive_string_reverse(void)
{
F_STRING* s;
CELL capacity;
maybe_garbage_collection();
s = untag_string(dpeek());
capacity = string_capacity(s);
s = string_clone(s,capacity);
string_reverse(s,capacity);
rehash_string(s);
drepl(tag_object(s));
}

2
native/string.h
View File

@ -54,6 +54,4 @@ void primitive_string_compare(void);
void primitive_string_eq(void);
void primitive_index_of(void);
void primitive_substring(void);
void string_reverse(F_STRING* s, int len);
F_STRING* string_clone(F_STRING* s, int len);
void primitive_string_reverse(void);