Faster all-words

core/collections/hashtables.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: hashtables-internals
 USING: arrays hashtables kernel kernel-internals math
-math-internals sequences sequences-internals ;
+math-internals sequences sequences-internals vectors ;
 
 TUPLE: tombstone ;
 
@@ -108,10 +108,10 @@ TUPLE: tombstone ;
 : all-pairs? ( array quot -- ? )
     swap 0 (all-pairs?) ; inline
 
-: hash>seq ( i hash -- seq )
+: (hash-keys/values) ( hash quot -- accum array )
-    hash-array dup array-capacity 2 /i
+    >r
-    [ 2 * pick + over array-nth ] map
+    hash-array [ length 2 /i <vector> ] keep
-    [ tombstone? not ] subset 2nip ;
+    r> each-pair { } like ; inline
 
 IN: hashtables
 
@@ -177,9 +177,11 @@ IN: hashtables
 : associate ( value key -- hash )
     2 <hashtable> [ set-hash ] keep ;
 
-: hash-keys ( hash -- keys ) 0 swap hash>seq ;
+: hash-keys ( hash -- seq )
+    [ drop over push ] (hash-keys/values) ;
 
-: hash-values ( hash -- values ) 1 swap hash>seq ;
+: hash-values ( hash -- seq )
+    [ nip over push ] (hash-keys/values) ;
 
 : hash>alist ( hash -- alist )
     dup hash-keys swap hash-values 2array flip ;

core/collections/hashtables.facts

@@ -86,11 +86,6 @@ HELP: ?grow-hash
 { $see-also (set-hash) grow-hash set-hash }
 { $side-effects "hash" } ;
 
-HELP: hash>seq
-{ $values { "i" "0 or 1" } { "hash" "a hashtable" } { "seq" "a sequence of keys or values" } }
-{ $description "User code should not call this word. It is unsafe and only used in the implementation of " { $link hash-keys } " and " { $link hash-values } ", both of which are safe." }
-{ $warning "This word is in the " { $vocab-link "hashtables-internals" } " vocabulary because passing an invalid value for " { $snippet "i" } " can lead to memory corruption." } ;
-
 HELP: <hashtable>
 { $values { "n" "a positive integer specifying hashtable capacity" } { "hash" "a new hashtable" } }
 { $description "Create a new hashtable capable of storing " { $snippet "n" } " key/value pairs before growing." }

core/collections/namespaces.factor

@@ -62,8 +62,5 @@ SYMBOL: building
 
 IN: sequences
 
-: concat ( seq -- newseq )
-    dup empty? [ [ [ % ] each ] over first make ] unless ;
-
 : join ( seq glue -- newseq )
     [ swap [ % ] [ dup % ] interleave drop ] over make ;

core/collections/namespaces.facts

@@ -123,12 +123,6 @@ HELP: init-namespaces
     { $code "[ init-namestack do-some-work ] in-thread" }
 } ;
 
-HELP: concat
-{ $values { "seq" "a sequence" } { "newseq" "a sequence" } }
-{ $description "Concatenates a sequence of sequences together into one sequence. The resulting sequence is of the same class as the first element of " { $snippet "seq" } "." }
-{ $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as the first element of " { $snippet "seq" } "." }
-{ $see-also join } ;
-
 HELP: join
 { $values { "seq" "a sequence" } { "glue" "a sequence" } { "newseq" "a sequence" } }
 { $description "Concatenates a sequence of sequences together into one sequence, placing a copy of " { $snippet "glue" } " between each pair of sequences. The resulting sequence is of the same class as " { $snippet "glue" } "." }

core/collections/sequences-epilogue.factor

@@ -88,6 +88,13 @@ sequences-internals strings vectors words ;
 
 : add* ( seq elt -- newseq ) 1array swap dup (append) ; inline
 
+: concat ( seq -- newseq )
+    dup empty? [
+        [ 0 [ length + ] accumulate ] keep
+        rot over first new -rot
+        [ >r over r> copy-into ] 2each
+    ] unless ;
+
 : diff ( seq1 seq2 -- newseq )
     [ swap member? not ] subset-with ;
 

core/collections/sequences-epilogue.facts

@@ -124,6 +124,12 @@ HELP: append3
 { $description "Outputs a new sequence consisting of the elements of " { $snippet "seq1" } ", " { $snippet "seq2" } " and " { $snippet "seq3" } " in turn." }
 { $errors "Throws an error if " { $snippet "seq2" } " or " { $snippet "seq3" } " contain elements not permitted in sequences of the same class as " { $snippet "seq1" } "." } ;
 
+HELP: concat
+{ $values { "seq" "a sequence" } { "newseq" "a sequence" } }
+{ $description "Concatenates a sequence of sequences together into one sequence. The resulting sequence is of the same class as the first element of " { $snippet "seq" } "." }
+{ $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as the first element of " { $snippet "seq" } "." }
+{ $see-also join } ;
+
 HELP: peek
 { $values { "seq" "a sequence" } { "elt" "an object" } }
 { $description "Outputs the last element of a sequence." }

core/words.factor

@@ -144,7 +144,8 @@ SYMBOL: bootstrapping?
 
 : words ( vocab -- seq ) vocab dup [ hash-values ] when ;
 
-: all-words ( -- seq ) vocabs [ words ] map concat ;
+: all-words ( -- seq )
+    vocabularies get hash-values [ hash-values ] map concat ;
 
 : word-subset ( quot -- seq )
     all-words swap subset ; inline