diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index cfe36cd76e..7850129c24 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -61,7 +61,6 @@ + kernel: -- hash-size regression - vectors: ensure its ok with bignum indices - cat, reverse-cat primitives - code gc diff --git a/contrib/cont-responder/eval-responder.factor b/contrib/cont-responder/eval-responder.factor index d2c02418da..b9c06f2959 100644 --- a/contrib/cont-responder/eval-responder.factor +++ b/contrib/cont-responder/eval-responder.factor @@ -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 diff --git a/contrib/cont-responder/todo-example.factor b/contrib/cont-responder/todo-example.factor index f4708b79c0..da3ceb7935 100644 --- a/contrib/cont-responder/todo-example.factor +++ b/contrib/cont-responder/todo-example.factor @@ -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 ( -- ) #! Enter a new item to the current todo list. diff --git a/contrib/cont-responder/todo.factor b/contrib/cont-responder/todo.factor index e748f8536b..5e6aa0b9c0 100644 --- a/contrib/cont-responder/todo.factor +++ b/contrib/cont-responder/todo.factor @@ -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 ( -- alist ) #! Return a list of items for the given todo list. diff --git a/contrib/sqlite/sqlite.factor b/contrib/sqlite/sqlite.factor index bde8be34e3..5eefe0fd8d 100644 --- a/contrib/sqlite/sqlite.factor +++ b/contrib/sqlite/sqlite.factor @@ -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 dup >r + dup string-length dup >r sqlite3_prepare sqlite-check-result r> sqlite3-stmt-indirect-pointer ; diff --git a/examples/format.factor b/examples/format.factor index fa17db9979..671deaafd9 100644 --- a/examples/format.factor +++ b/examples/format.factor @@ -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 diff --git a/examples/irc.factor b/examples/irc.factor index ec930ffad8..128ffcdf47 100644 --- a/examples/irc.factor +++ b/examples/irc.factor @@ -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 -- ) diff --git a/examples/lcd.factor b/examples/lcd.factor index 0f4b93e3fc..8af08e1808 100644 --- a/examples/lcd.factor +++ b/examples/lcd.factor @@ -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 ; diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index da6ea67961..58dba891cb 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -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 ; diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index f783ba4f14..34e7151706 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -30,20 +30,18 @@ vocabularies get [ [ "ifte" "kernel" [ [ object general-list general-list ] [ ] ] ] [ "cons" "lists" [ [ object object ] [ cons ] ] ] [ "" "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 ] ] ] [ "" "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 diff --git a/library/cli.factor b/library/cli.factor index d08db81414..f243758d14 100644 --- a/library/cli.factor +++ b/library/cli.factor @@ -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 ; diff --git a/library/hashtables.factor b/library/hashtables.factor index 4beeb5d82e..1a5fb38dad 100644 --- a/library/hashtables.factor +++ b/library/hashtables.factor @@ -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 [ - hash-array rot hash-array rot copy-array + dup bucket-count + over hash-size over set-hash-size [ + hash-array swap hash-array dup array-capacity copy-array ] keep ; : hash-subset? ( subset of -- ? ) diff --git a/library/httpd/browser-responder.factor b/library/httpd/browser-responder.factor index d9e1abef4e..a8252fb67c 100644 --- a/library/httpd/browser-responder.factor +++ b/library/httpd/browser-responder.factor @@ -56,7 +56,7 @@ errors unparser logging listener url-encoding hashtables memory ; #! Write out the HTML for the list of words in a vocabulary.