back out skip word

CHANGES.txt

@@ -6,9 +6,6 @@ data could fill up the buffer and cause a denial-of-service attack.
 
 The alien interface now supports "float" and "double" types.
 
-Moved the 'skip' combinator from the 'parser' vocabulary to 'sequences',
-since its generic now. Implemented 'index*' in terms of 'skip'.
-
 Factor 0.74:
 ------------
 

TODO.FACTOR.txt

@@ -29,6 +29,8 @@
 - PPC #box-float #unbox-float
 - weird bug uncovered during bootstrap stress-test
 - images saved from plugin do not work
+- making an image from plugin hangs
+- generic skip
 
 + plugin:
 

library/bootstrap/primitives.factor

@@ -45,7 +45,6 @@ vocabularies get [
     [ "<vector>" "vectors"                    [ [ integer ] [ vector ] ] ]
     [ "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 ] ] ]
     [ "<sbuf>" "strings"                      [ [ integer ] [ sbuf ] ] ]
@@ -54,9 +53,7 @@ vocabularies get [
     [ "sbuf-nth" "strings"                    [ [ integer sbuf ] [ integer ] ] ]
     [ "set-sbuf-nth" "strings"                [ [ integer integer sbuf ] [ ] ] ]
     [ "sbuf-append" "strings"                 [ [ text 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 ] ] ]
     [ ">fixnum" "math"                        [ [ number ] [ fixnum ] ] ]
     [ ">bignum" "math"                        [ [ number ] [ bignum ] ] ]

library/collections/namespaces.factor

@@ -132,10 +132,10 @@ SYMBOL: building
     100 <sbuf> make-seq ; inline
 
 : make-string ( quot -- string )
-    make-sbuf sbuf>string ; inline
+    make-sbuf >string ; inline
 
 : make-rstring ( quot -- string )
-    make-sbuf dup nreverse sbuf>string ; inline
+    make-sbuf dup nreverse >string ; inline
 
 ! Building hashtables, and computing a transitive closure.
 SYMBOL: hash-buffer

library/collections/sbuf.factor

@@ -1,20 +1,45 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: strings
-USING: generic kernel lists math namespaces sequences strings ;
+USING: generic kernel kernel-internals lists math namespaces
+sequences strings ;
 
 M: sbuf length sbuf-length ;
 M: sbuf set-length set-sbuf-length ;
 M: sbuf nth sbuf-nth ;
 M: sbuf set-nth set-sbuf-nth ;
 M: sbuf clone sbuf-clone ;
-M: sbuf = sbuf= ;
+
+M: sbuf =
+    over sbuf? [
+        2dup eq? [
+            2drop t
+        ] [
+            swap >string swap >string =
+        ] ifte
+    ] [
+        2drop f
+    ] ifte ;
 
 : >sbuf ( seq -- sbuf ) 0 <sbuf> [ swap nappend ] keep ;
 
-GENERIC: >string ( seq -- string )
+M: sbuf >string
-M: string >string ;
+    [ 0 swap length ] keep sbuf-string substring ;
-M: object >string >sbuf sbuf>string ;
+
+M: object >string >sbuf >string ;
+
+: cat2 ( "a" "b" -- "ab" )
+    swap
+    80 <sbuf>
+    [ sbuf-append ] keep
+    [ sbuf-append ] keep
+    >string ;
+
+: cat3 ( "a" "b" "c" -- "abc" )
+    >r >r >r 80 <sbuf>
+    r> over sbuf-append
+    r> over sbuf-append
+    r> over sbuf-append >string ;
 
 : fill ( count char -- string ) <repeated> >string ;
 
@@ -58,7 +83,7 @@ M: object >string >sbuf sbuf>string ;
     #! Split a string into n-character chunks.
     [ 0 -rot (split-n) ] make-list ;
 
-: ch>string ( ch -- str ) 1 <sbuf> [ push ] keep sbuf>string ;
+: ch>string ( ch -- str ) 1 <sbuf> [ push ] keep >string ;
 
 M: string thaw >sbuf ;
-M: string freeze drop sbuf>string ;
+M: string freeze drop >string ;

library/collections/sequences-epilogue.factor

@@ -92,23 +92,14 @@ M: sequence (tree-each) [ (tree-each) ] seq-each-with ;
 : seq-2map ( seq1 seq2 quot -- seq | quot: elt1 elt2 -- elt3 )
     swap [ swap 2nmap ] immutable ; inline
 
-: skip ( i seq quot -- n | quot: elt -- ? )
-    #! Find the next element starting at i that satisfies the
-    #! quotation.
-    >r 2dup length < [
-        2dup nth r> dup >r call [
-            r> 2drop
-        ] [
-            >r 1 + r> r> skip
-        ] ifte
-    ] [
-        r> drop nip length
-    ] ifte ; inline
-
 ! Operations
 : index* ( obj i seq -- n )
     #! The index of the object in the sequence, starting from i.
-    [ dupd = ] skip nip ;
+    2dup length >= [
+        3drop -1
+    ] [
+        3dup nth = [ drop nip ] [ >r 1 + r> index* ] ifte
+    ] ifte ;
 
 : index ( obj seq -- n )
     #! The index of the object in the sequence.

library/collections/strings.factor

@@ -1,18 +1,35 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: strings USING: generic kernel kernel-internals lists math
+IN: kernel-internals
-sequences ;
+DEFER: sbuf-string
+DEFER: set-sbuf-string
+
+IN: strings
+USING: generic kernel kernel-internals lists math sequences ;
 
 ! Strings
 BUILTIN: string 12 [ 1 length f ] [ 2 hashcode f ] ;
 UNION: text string integer ;
 
-M: string = string= ;
+M: string =
-
+    over string? [
-BUILTIN: sbuf 13 ;
+        over hashcode over hashcode number= [
+            string-compare 0 eq?
+        ] [
+            2drop f
+        ] ifte
+    ] [
+        2drop f
+    ] ifte ;
 
 M: string nth string-nth ;
 
+GENERIC: >string ( seq -- string )
+
+M: string >string ;
+
+BUILTIN: sbuf 13 [ 2 sbuf-string set-sbuf-string ] ;
+
 : string> ( str1 str2 -- ? )
     ! Returns if the first string lexicographically follows str2
     string-compare 0 > ;
@@ -21,19 +38,6 @@ M: string nth string-nth ;
     #! Compare sequence lengths.
     swap length swap length < ;
 
-: cat2 ( "a" "b" -- "ab" )
-    swap
-    80 <sbuf>
-    [ sbuf-append ] keep
-    [ sbuf-append ] keep
-    sbuf>string ;
-
-: cat3 ( "a" "b" "c" -- "abc" )
-    >r >r >r 80 <sbuf>
-    r> over sbuf-append
-    r> over sbuf-append
-    r> over sbuf-append sbuf>string ;
-
 : index-of ( string substring -- index )
     0 -rot index-of* ;
 

library/collections/vectors.factor

@@ -76,9 +76,3 @@ M: vector clone ( vector -- vector )
     dup length dup empty-vector [
         vector-array rot vector-array rot copy-array
     ] keep ;
-
-IN: vectors
-
-: vector-nth nth ;
-: set-vector-nth set-nth ;
-: vector-length length ; 

library/io/stdio.factor

@@ -35,7 +35,7 @@ SYMBOL: stdio
 : with-string ( quot -- str )
     #! Execute a quotation, and push a string containing all
     #! text printed by the quotation.
-    1024 <sbuf> [ call stdio get sbuf>string ] with-stream ;
+    1024 <sbuf> [ call stdio get >string ] with-stream ;
 
 TUPLE: stdio-stream ;
 C: stdio-stream ( stream -- stream ) [ set-delegate ] keep ;

library/syntax/parse-stream.factor

@@ -17,7 +17,7 @@ USING: kernel lists namespaces sequences streams strings ;
     ] with-parser ;
 
 : parse-stream ( name stream -- quot )
-    [ file-vocabs [ (parse-stream) ] with-parser ] with-scope ;
+    [ file-vocabs (parse-stream) ] with-scope ;
 
 : parse-file ( file -- quot )
     dup <file-reader> parse-stream ;

library/test/math/matrices.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: kernel lists matrices namespaces test ;
+USING: kernel lists math matrices namespaces test ;
 
 [
     M[ [ 0 ] [ 0 ] [ 0 ] ]M

library/test/sbuf.factor

@@ -6,7 +6,7 @@ USING: kernel namespaces sequences strings test ;
     "Hello" "buf" get swap nappend
     "buf" get clone "buf-clone" set
     "World" "buf-clone" get swap nappend
-    "buf" get sbuf>string
+    "buf" get >string
 ] unit-test
 
 [ CHAR: h ] [ 0 SBUF" hello world" nth ] unit-test

library/unix/io.factor

@@ -119,7 +119,7 @@ C: reader ( handle -- reader )
     [ >r buffered-port r> set-delegate ] keep ;
 
 : pop-line ( reader -- str )
-    dup reader-line dup [ sbuf>string ] when >r
+    dup reader-line dup [ >string ] when >r
     f over set-reader-line
     f swap set-reader-ready? r> ;
 

library/win32/win32-stream.factor

@@ -95,8 +95,8 @@ M: string do-write ( str -- )
     dup in-buffer get buffer-first-n
     swap in-buffer get buffer-consume ;
 
-: sbuf>string-or-f ( sbuf -- str-or-? )
+: >string-or-f ( sbuf -- str-or-? )
-    dup sbuf-length 0 > [ sbuf>string ] [ drop f ] ifte ;
+    dup length 0 > [ >string ] [ drop f ] ifte ;
 
 : do-read-count ( sbuf count -- str )
     dup 0 = [ 
@@ -104,7 +104,7 @@ M: string do-write ( str -- )
     ] [
         dup consume-input
         dup length dup 0 = [
-            3drop sbuf>string-or-f
+            3drop >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 length 0 = [ drop sbuf>string-or-f ] [
+    1 consume-input dup length 0 = [ drop >string-or-f ] [
         dup "\r" = [
             peek-input "\n" = [ 1 consume-input drop ] when 
-            drop sbuf>string
+            drop >string
         ] [ 
             dup "\n" = [
                 peek-input "\r" = [ 1 consume-input drop ] when 
-                drop sbuf>string
+                drop >string
             ] [
                 over sbuf-append do-read-line 
             ] ifte

native/primitives.c

@@ -11,7 +11,6 @@ void* primitives[] = {
 	primitive_vector,
 	primitive_string_nth,
 	primitive_string_compare,
-	primitive_string_eq,
 	primitive_index_of,
 	primitive_substring,
 	primitive_sbuf,
@@ -20,9 +19,7 @@ void* primitives[] = {
 	primitive_sbuf_nth,
 	primitive_set_sbuf_nth,
 	primitive_sbuf_append,
-	primitive_sbuf_to_string,
 	primitive_sbuf_clone,
-	primitive_sbuf_eq,
 	primitive_arithmetic_type,
 	primitive_to_fixnum,
 	primitive_to_bignum,

native/sbuf.c

@@ -120,19 +120,6 @@ void primitive_sbuf_append(void)
 	}
 }
 
-void primitive_sbuf_to_string(void)
-{
-	F_SBUF* sbuf;
-	F_STRING* s;
-
-	maybe_garbage_collection();
-
-	sbuf = untag_sbuf(dpeek());
-	s = string_clone(untag_string(sbuf->string),sbuf->top);
-	rehash_string(s);
-	drepl(tag_object(s));
-}
-
 void primitive_sbuf_clone(void)
 {
 	F_SBUF* s;
@@ -147,29 +134,6 @@ void primitive_sbuf_clone(void)
 	drepl(tag_object(new_s));
 }
 
-bool sbuf_eq(F_SBUF* s1, F_SBUF* s2)
-{
-	if(s1 == s2)
-		return true;
-	else if(s1->top == s2->top)
-	{
-		return (string_compare_head(untag_string(s1->string),
-			untag_string(s2->string),s1->top) == 0);
-	}
-	else
-		return false;
-}
-
-void primitive_sbuf_eq(void)
-{
-	F_SBUF* s1 = untag_sbuf(dpop());
-	CELL with = dpop();
-	if(type_of(with) == SBUF_TYPE)
-		dpush(tag_boolean(sbuf_eq(s1,(F_SBUF*)UNTAG(with))));
-	else
-		dpush(F);
-}
-
 void fixup_sbuf(F_SBUF* sbuf)
 {
 	data_fixup(&sbuf->string);

native/sbuf.h

@@ -24,9 +24,6 @@ void set_sbuf_nth(F_SBUF* sbuf, CELL index, u16 value);
 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_clone(void);
-bool sbuf_eq(F_SBUF* s1, F_SBUF* s2);
-void primitive_sbuf_eq(void);
 void fixup_sbuf(F_SBUF* sbuf);
 void collect_sbuf(F_SBUF* sbuf);

native/string.c

@@ -193,24 +193,6 @@ void primitive_string_compare(void)
 	dpush(tag_fixnum(string_compare(s1,s2)));
 }
 
-void primitive_string_eq(void)
-{
-	F_STRING* s1 = untag_string(dpop());
-	CELL with = dpop();
-	if(type_of(with) == STRING_TYPE)
-	{
-		F_STRING* s2 = (F_STRING*)UNTAG(with);
-		if(s1->hashcode != s2->hashcode)
-			dpush(F);
-		else if(s1 == s2)
-			dpush(T);
-		else
-			dpush(tag_boolean((string_compare(s1,s2) == 0)));
-	}
-	else
-		dpush(F);
-}
-
 CELL index_of_ch(CELL index, F_STRING* string, CELL ch)
 {
 	CELL capacity = string_capacity(string);

native/string.h

@@ -53,7 +53,6 @@ void primitive_string_nth(void);
 F_FIXNUM string_compare_head(F_STRING* s1, F_STRING* s2, CELL len);
 F_FIXNUM string_compare(F_STRING* s1, F_STRING* s2);
 void primitive_string_compare(void);
-void primitive_string_eq(void);
 void primitive_index_of(void);
 void primitive_substring(void);
 F_STRING* string_clone(F_STRING* s, int len);