sequences.parser: rename and redefine `next`

Change the word `next` to advance the parser and *then* return the
element. Rename the old behavior of `next` to `consume`.

diff --git a/basis/compression/run-length/run-length.factor b/basis/compression/run-length/run-length.factor
index 22650af9b03a5076b3b57db0ce0616dde842fa97..1e1a6609a9df7c594b087392433c2db6d4f5a9db 100644 (file)
--- a/basis/compression/run-length/run-length.factor
+++ b/basis/compression/run-length/run-length.factor
@@ -19,8 +19,8 @@ IN: compression.run-length
     f :> done?!
     [
         ! i j [ number>string ] bi@ " " glue .
-        sp next dup 0 = [
-            sp next dup 0x03 0xff between? [
+        sp consume dup 0 = [
+            sp consume dup 0x03 0xff between? [
                 nip [ sp ] dip dup odd?
                 [ 1 + take-n but-last ] [ take-n ] if
                 [ j matrix i swap nth copy ] [ length j + j! ] bi
@@ -28,11 +28,11 @@ IN: compression.run-length
                 nip {
                     { 0 [ i 1 + i!  0 j! ] }
                     { 1 [ t done?! ] }
-                    { 2 [ sp next j + j!  sp next i + i! ] }
+                    { 2 [ sp consume j + j!  sp consume i + i! ] }
                 } case
             ] if
         ] [
-            [ sp next 8hi-lo 2array <repetition> concat ] [ head ] bi
+            [ sp consume 8hi-lo 2array <repetition> concat ] [ head ] bi
             [ j matrix i swap nth copy ] [ length j + j! ] bi
         ] if
 
@@ -51,8 +51,8 @@ IN: compression.run-length
     f :> done?!
     [
         ! i j [ number>string ] bi@ " " glue .
-        sp next dup 0 = [
-            sp next dup 0x03 0xff between? [
+        sp consume dup 0 = [
+            sp consume dup 0x03 0xff between? [
                 nip [ sp ] dip dup odd?
                 [ 1 + take-n but-last ] [ take-n ] if
                 [ j matrix i swap nth copy ] [ length j + j! ] bi
@@ -60,11 +60,11 @@ IN: compression.run-length
                 nip {
                     { 0 [ i 1 + i!  0 j! ] }
                     { 1 [ t done?! ] }
-                    { 2 [ sp next j + j!  sp next i + i! ] }
+                    { 2 [ sp consume j + j!  sp consume i + i! ] }
                 } case
             ] if
         ] [
-            sp next <array> [ j matrix i swap nth copy ] [ length j + j! ] bi
+            sp consume <array> [ j matrix i swap nth copy ] [ length j + j! ] bi
         ] if
 
         ! j stride >= [ i 1 + i!  0 j! ] when

diff --git a/basis/sequences/parser/authors.txt b/basis/sequences/parser/authors.txt
deleted file mode 100644 (file)
index a07c427..0000000
--- a/basis/sequences/parser/authors.txt
+++ /dev/null
@@ -1,2 +0,0 @@
-Daniel Ehrenberg
-Doug Coleman

diff --git a/basis/sequences/parser/parser-tests.factor b/basis/sequences/parser/parser-tests.factor
deleted file mode 100644 (file)
index d641464..0000000
--- a/basis/sequences/parser/parser-tests.factor
+++ /dev/null
@@ -1,104 +0,0 @@
-USING: tools.test sequences.parser unicode kernel accessors ;
-
-{ "hello" }
-[ "hello" [ take-rest ] parse-sequence ] unit-test
-
-{ "hi" " how are you?" }
-[
-    "hi how are you?"
-    [ [ [ current blank? ] take-until ] [ take-rest ] bi ] parse-sequence
-] unit-test
-
-{ "foo" ";bar" }
-[
-    "foo;bar" [
-        [ CHAR: ; take-until-object ] [ take-rest ] bi
-    ] parse-sequence
-] unit-test
-
-{ "foo " "and bar" }
-[
-    "foo and bar" [
-        [ "and" take-until-sequence ] [ take-rest ] bi
-    ] parse-sequence
-] unit-test
-
-{ "foo " " bar" }
-[
-    "foo and bar" [
-        [ "and" take-until-sequence ]
-        [ "and" take-sequence drop ]
-        [ take-rest ] tri
-    ] parse-sequence
-] unit-test
-
-{ "foo " " bar" }
-[
-    "foo and bar" [
-        [ "and" take-until-sequence* ]
-        [ take-rest ] bi
-    ] parse-sequence
-] unit-test
-
-{ { 1 2 } }
-[ { 1 2 3 4 } <sequence-parser> { 3 4 } take-until-sequence ] unit-test
-
-{ f "aaaa" }
-[
-    "aaaa" <sequence-parser>
-    [ "b" take-until-sequence ] [ take-rest ] bi
-] unit-test
-
-{ 6 }
-[
-    "      foo   " [ skip-whitespace n>> ] parse-sequence
-] unit-test
-
-{ { 1 2 } }
-[ { 1 2 3 } <sequence-parser> [ current 3 = ] take-until ] unit-test
-
-{ "ab" }
-[ "abcd" <sequence-parser> "ab" take-sequence ] unit-test
-
-{ f }
-[ "abcd" <sequence-parser> "lol" take-sequence ] unit-test
-
-{ "ab" }
-[
-    "abcd" <sequence-parser>
-    [ "lol" take-sequence drop ] [ "ab" take-sequence ] bi
-] unit-test
-
-{ "" }
-[ "abcd" <sequence-parser> "" take-sequence ] unit-test
-
-{ "cd" }
-[ "abcd" <sequence-parser> [ "ab" take-sequence drop ] [ "cd" take-sequence ] bi ] unit-test
-
-{ f }
-[ "" <sequence-parser> take-rest ] unit-test
-
-{ f }
-[ "abc" <sequence-parser> dup "abc" take-sequence drop take-rest ] unit-test
-
-{ f }
-[ "abc" <sequence-parser> "abcdefg" take-sequence ] unit-test
-
-{ "1234" }
-[ "1234f" <sequence-parser> take-integer ] unit-test
-
-{ "yes" }
-[
-    "yes1234f" <sequence-parser>
-    [ take-integer drop ] [ "yes" take-sequence ] bi
-] unit-test
-
-{ f } [ "" <sequence-parser> 4 take-n ] unit-test
-{ "abcd" } [ "abcd" <sequence-parser> 4 take-n ] unit-test
-{ "abcd" "efg" } [ "abcdefg" <sequence-parser> [ 4 take-n ] [ take-rest ] bi ] unit-test
-
-{ f }
-[ "\n" <sequence-parser> take-integer ] unit-test
-
-{ "\n" } [ "\n" <sequence-parser> [ ] take-while ] unit-test
-{ f } [ "\n" <sequence-parser> [ not ] take-while ] unit-test

diff --git a/basis/sequences/parser/parser.factor b/basis/sequences/parser/parser.factor
deleted file mode 100644 (file)
index cee5fb4..0000000
--- a/basis/sequences/parser/parser.factor
+++ /dev/null
@@ -1,140 +0,0 @@
-! Copyright (C) 2005, 2009 Daniel Ehrenberg, Doug Coleman.
-! See https://factorcode.org/license.txt for BSD license.
-USING: accessors circular combinators.short-circuit io kernel
-math math.order sequences sequences.parser sequences.private
-sorting unicode ;
-IN: sequences.parser
-
-TUPLE: sequence-parser sequence n ;
-
-: <sequence-parser> ( sequence -- sequence-parser )
-    sequence-parser new
-        swap >>sequence
-        0 >>n ;
-
-:: with-sequence-parser ( sequence-parser quot -- seq/f )
-    sequence-parser n>> :> n
-    sequence-parser quot call [
-        n sequence-parser n<< f
-    ] unless* ; inline
-
-: offset  ( sequence-parser offset -- char/f )
-    swap
-    [ n>> + ] [ sequence>> ?nth ] bi ; inline
-
-: current ( sequence-parser -- char/f ) 0 offset ; inline
-
-: previous ( sequence-parser -- char/f ) -1 offset ; inline
-
-: peek-next ( sequence-parser -- char/f ) 1 offset ; inline
-
-: advance ( sequence-parser -- sequence-parser )
-    [ 1 + ] change-n ; inline
-
-: next ( sequence-parser -- char/f )
-    [ current ] [ advance drop ] bi ; inline
-
-:: skip-until ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... )
-    sequence-parser current [
-        sequence-parser quot call
-        [ sequence-parser advance quot skip-until ] unless
-    ] when ; inline recursive
-
-: sequence-parse-end? ( sequence-parser -- ? ) current not ;
-
-: take-until ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... sequence/f )
-    over sequence-parse-end? [
-        2drop f
-    ] [
-        [ drop n>> ]
-        [ skip-until ]
-        [ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq f like
-    ] if ; inline
-
-: take-while ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... sequence/f )
-    [ not ] compose take-until ; inline
-
-: <safe-slice> ( from to seq -- slice/f )
-    3dup {
-        [ 2drop 0 < ]
-        [ nipd length > ]
-        [ drop > ]
-    } 3|| [ 3drop f ] [ <slice-unsafe> ] if ; inline
-
-:: take-sequence ( sequence-parser sequence -- obj/f )
-    sequence-parser [ n>> dup sequence length + ] [ sequence>> ] bi
-    <safe-slice> sequence sequence= [
-        sequence
-        sequence-parser [ sequence length + ] change-n drop
-    ] [
-        f
-    ] if ;
-
-: take-sequence* ( sequence-parser sequence -- )
-    take-sequence drop ;
-
-:: take-until-sequence ( sequence-parser sequence -- sequence'/f )
-    sequence-parser n>> :> saved
-    sequence length <growing-circular> :> growing
-    sequence-parser
-    [
-        current growing growing-circular-push
-        sequence growing sequence=
-    ] take-until :> found
-    growing sequence sequence= [
-        found dup length
-        growing length 1 - - head
-        sequence-parser [ growing length - 1 + ] change-n drop
-        ! sequence-parser advance drop
-    ] [
-        saved sequence-parser n<<
-        f
-    ] if ;
-
-:: take-until-sequence* ( sequence-parser sequence -- sequence'/f )
-    sequence-parser sequence take-until-sequence :> out
-    out [
-        sequence-parser [ sequence length + ] change-n drop
-    ] when out ;
-
-: skip-whitespace ( sequence-parser -- sequence-parser )
-    [ [ current blank? not ] take-until drop ] keep ;
-
-: skip-whitespace-eol ( sequence-parser -- sequence-parser )
-    [ [ current " \t\r" member? not ] take-until drop ] keep ;
-
-: take-rest-slice ( sequence-parser -- sequence/f )
-    [ sequence>> ] [ n>> ] bi
-    2dup [ length ] dip < [ 2drop f ] [ tail-slice ] if ; inline
-
-: take-rest ( sequence-parser -- sequence )
-    [ take-rest-slice ] [ sequence>> like ] bi f like ;
-
-: take-until-object ( sequence-parser obj -- sequence )
-    '[ current _ = ] take-until ;
-
-: parse-sequence ( sequence quot -- )
-    [ <sequence-parser> ] dip call ; inline
-
-: take-integer ( sequence-parser -- n/f )
-    [ current digit? ] take-while ;
-
-:: take-n ( sequence-parser n -- seq/f )
-    n sequence-parser [ n>> + ] [ sequence>> length ] bi > [
-        sequence-parser take-rest
-    ] [
-        sequence-parser n>> dup n + sequence-parser sequence>> subseq
-        sequence-parser [ n + ] change-n drop
-    ] if ;
-
-: sort-tokens ( seq -- seq' ) [ length ] inv-sort-by ;
-
-: take-first-matching ( sequence-parser seq -- seq )
-    swap
-    '[ _ [ swap take-sequence ] with-sequence-parser ] find nip ;
-
-: take-longest ( sequence-parser seq -- seq )
-    sort-tokens take-first-matching ;
-
-: write-full ( sequence-parser -- ) sequence>> write ;
-: write-rest ( sequence-parser -- ) take-rest write ;

diff --git a/extra/html/parser/parser.factor b/extra/html/parser/parser.factor
index b9c09e41ac91afe22627ad0dd7c75141f4247a7b..ac47cc929bc2fb75922e7e3c98274eb4568c91a0 100644 (file)
--- a/extra/html/parser/parser.factor
+++ b/extra/html/parser/parser.factor
@@ -46,7 +46,7 @@ SYMBOL: tagstack
     CHAR: \" (read-quote) ;
 
 : read-quote ( sequence-parser -- string )
-    dup next CHAR: ' =
+    dup consume CHAR: ' =
     [ read-single-quote ] [ read-double-quote ] if ;
 
 : read-key ( sequence-parser -- string )

diff --git a/extra/lint/vocabs/vocabs.factor b/extra/lint/vocabs/vocabs.factor
index ab1d4dffb73635398df8bfe4f69116694c971c1f..1bc7ca9537c5dd37ec40bbec2e845c4bb2fd8a0e 100644 (file)
--- a/extra/lint/vocabs/vocabs.factor
+++ b/extra/lint/vocabs/vocabs.factor
@@ -167,14 +167,14 @@ DEFER: next-token
 ! Words for finding the words used in a program
 ! and stripping out import statements
 : skip-imports ( sequence-parser -- sequence-parser string/? )
-    dup next { 
+    dup consume { 
         { "USING:"  [ ";" skip-after* f ] }
         { "USE:"    [        advance  f ] }
         [ ]
     } case ;
 
 : take-imports ( sequence-parser -- vector )
-    dup next {
+    dup consume {
         { "USING:" [ ";" take-until-object ] }
         { "USE:"   [  1  take-n ] }
         [ 2drop f ]

diff --git a/extra/sequences/parser/authors.txt b/extra/sequences/parser/authors.txt
new file mode 100644 (file)
index 0000000..a07c427
--- /dev/null
+++ b/extra/sequences/parser/authors.txt
@@ -0,0 +1,2 @@
+Daniel Ehrenberg
+Doug Coleman

diff --git a/extra/sequences/parser/parser-tests.factor b/extra/sequences/parser/parser-tests.factor
new file mode 100644 (file)
index 0000000..d641464
--- /dev/null
+++ b/extra/sequences/parser/parser-tests.factor
@@ -0,0 +1,104 @@
+USING: tools.test sequences.parser unicode kernel accessors ;
+
+{ "hello" }
+[ "hello" [ take-rest ] parse-sequence ] unit-test
+
+{ "hi" " how are you?" }
+[
+    "hi how are you?"
+    [ [ [ current blank? ] take-until ] [ take-rest ] bi ] parse-sequence
+] unit-test
+
+{ "foo" ";bar" }
+[
+    "foo;bar" [
+        [ CHAR: ; take-until-object ] [ take-rest ] bi
+    ] parse-sequence
+] unit-test
+
+{ "foo " "and bar" }
+[
+    "foo and bar" [
+        [ "and" take-until-sequence ] [ take-rest ] bi
+    ] parse-sequence
+] unit-test
+
+{ "foo " " bar" }
+[
+    "foo and bar" [
+        [ "and" take-until-sequence ]
+        [ "and" take-sequence drop ]
+        [ take-rest ] tri
+    ] parse-sequence
+] unit-test
+
+{ "foo " " bar" }
+[
+    "foo and bar" [
+        [ "and" take-until-sequence* ]
+        [ take-rest ] bi
+    ] parse-sequence
+] unit-test
+
+{ { 1 2 } }
+[ { 1 2 3 4 } <sequence-parser> { 3 4 } take-until-sequence ] unit-test
+
+{ f "aaaa" }
+[
+    "aaaa" <sequence-parser>
+    [ "b" take-until-sequence ] [ take-rest ] bi
+] unit-test
+
+{ 6 }
+[
+    "      foo   " [ skip-whitespace n>> ] parse-sequence
+] unit-test
+
+{ { 1 2 } }
+[ { 1 2 3 } <sequence-parser> [ current 3 = ] take-until ] unit-test
+
+{ "ab" }
+[ "abcd" <sequence-parser> "ab" take-sequence ] unit-test
+
+{ f }
+[ "abcd" <sequence-parser> "lol" take-sequence ] unit-test
+
+{ "ab" }
+[
+    "abcd" <sequence-parser>
+    [ "lol" take-sequence drop ] [ "ab" take-sequence ] bi
+] unit-test
+
+{ "" }
+[ "abcd" <sequence-parser> "" take-sequence ] unit-test
+
+{ "cd" }
+[ "abcd" <sequence-parser> [ "ab" take-sequence drop ] [ "cd" take-sequence ] bi ] unit-test
+
+{ f }
+[ "" <sequence-parser> take-rest ] unit-test
+
+{ f }
+[ "abc" <sequence-parser> dup "abc" take-sequence drop take-rest ] unit-test
+
+{ f }
+[ "abc" <sequence-parser> "abcdefg" take-sequence ] unit-test
+
+{ "1234" }
+[ "1234f" <sequence-parser> take-integer ] unit-test
+
+{ "yes" }
+[
+    "yes1234f" <sequence-parser>
+    [ take-integer drop ] [ "yes" take-sequence ] bi
+] unit-test
+
+{ f } [ "" <sequence-parser> 4 take-n ] unit-test
+{ "abcd" } [ "abcd" <sequence-parser> 4 take-n ] unit-test
+{ "abcd" "efg" } [ "abcdefg" <sequence-parser> [ 4 take-n ] [ take-rest ] bi ] unit-test
+
+{ f }
+[ "\n" <sequence-parser> take-integer ] unit-test
+
+{ "\n" } [ "\n" <sequence-parser> [ ] take-while ] unit-test
+{ f } [ "\n" <sequence-parser> [ not ] take-while ] unit-test

diff --git a/extra/sequences/parser/parser.factor b/extra/sequences/parser/parser.factor
new file mode 100644 (file)
index 0000000..f2a0ddd
--- /dev/null
+++ b/extra/sequences/parser/parser.factor
@@ -0,0 +1,143 @@
+! Copyright (C) 2005, 2009 Daniel Ehrenberg, Doug Coleman.
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors circular combinators.short-circuit io kernel
+math math.order sequences sequences.parser sequences.private
+sorting unicode ;
+IN: sequences.parser
+
+TUPLE: sequence-parser sequence n ;
+
+: <sequence-parser> ( sequence -- sequence-parser )
+    sequence-parser new
+        swap >>sequence
+        0 >>n ;
+
+:: with-sequence-parser ( sequence-parser quot -- seq/f )
+    sequence-parser n>> :> n
+    sequence-parser quot call [
+        n sequence-parser n<< f
+    ] unless* ; inline
+
+: offset  ( sequence-parser offset -- char/f )
+    swap
+    [ n>> + ] [ sequence>> ?nth ] bi ; inline
+
+: current ( sequence-parser -- char/f ) 0 offset ; inline
+
+: previous ( sequence-parser -- char/f ) -1 offset ; inline
+
+: peek-next ( sequence-parser -- char/f ) 1 offset ; inline
+
+: advance ( sequence-parser -- sequence-parser )
+    [ 1 + ] change-n ; inline
+
+: consume ( sequence-parser -- char/f )
+    [ current ] [ advance drop ] bi ; inline
+
+: next ( sequence-parser -- char/f )
+    [ advance drop ] [ current ] bi ; inline
+
+:: skip-until ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... )
+    sequence-parser current [
+        sequence-parser quot call
+        [ sequence-parser advance quot skip-until ] unless
+    ] when ; inline recursive
+
+: sequence-parse-end? ( sequence-parser -- ? ) current not ;
+
+: take-until ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... sequence/f )
+    over sequence-parse-end? [
+        2drop f
+    ] [
+        [ drop n>> ]
+        [ skip-until ]
+        [ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq f like
+    ] if ; inline
+
+: take-while ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... sequence/f )
+    [ not ] compose take-until ; inline
+
+: <safe-slice> ( from to seq -- slice/f )
+    3dup {
+        [ 2drop 0 < ]
+        [ nipd length > ]
+        [ drop > ]
+    } 3|| [ 3drop f ] [ <slice-unsafe> ] if ; inline
+
+:: take-sequence ( sequence-parser sequence -- obj/f )
+    sequence-parser [ n>> dup sequence length + ] [ sequence>> ] bi
+    <safe-slice> sequence sequence= [
+        sequence
+        sequence-parser [ sequence length + ] change-n drop
+    ] [
+        f
+    ] if ;
+
+: take-sequence* ( sequence-parser sequence -- )
+    take-sequence drop ;
+
+:: take-until-sequence ( sequence-parser sequence -- sequence'/f )
+    sequence-parser n>> :> saved
+    sequence length <growing-circular> :> growing
+    sequence-parser
+    [
+        current growing growing-circular-push
+        sequence growing sequence=
+    ] take-until :> found
+    growing sequence sequence= [
+        found dup length
+        growing length 1 - - head
+        sequence-parser [ growing length - 1 + ] change-n drop
+        ! sequence-parser advance drop
+    ] [
+        saved sequence-parser n<<
+        f
+    ] if ;
+
+:: take-until-sequence* ( sequence-parser sequence -- sequence'/f )
+    sequence-parser sequence take-until-sequence :> out
+    out [
+        sequence-parser [ sequence length + ] change-n drop
+    ] when out ;
+
+: skip-whitespace ( sequence-parser -- sequence-parser )
+    [ [ current blank? not ] take-until drop ] keep ;
+
+: skip-whitespace-eol ( sequence-parser -- sequence-parser )
+    [ [ current " \t\r" member? not ] take-until drop ] keep ;
+
+: take-rest-slice ( sequence-parser -- sequence/f )
+    [ sequence>> ] [ n>> ] bi
+    2dup [ length ] dip < [ 2drop f ] [ tail-slice ] if ; inline
+
+: take-rest ( sequence-parser -- sequence )
+    [ take-rest-slice ] [ sequence>> like ] bi f like ;
+
+: take-until-object ( sequence-parser obj -- sequence )
+    '[ current _ = ] take-until ;
+
+: parse-sequence ( sequence quot -- )
+    [ <sequence-parser> ] dip call ; inline
+
+: take-integer ( sequence-parser -- n/f )
+    [ current digit? ] take-while ;
+
+:: take-n ( sequence-parser n -- seq/f )
+    n sequence-parser [ n>> + ] [ sequence>> length ] bi > [
+        sequence-parser take-rest
+    ] [
+        sequence-parser n>> dup n + sequence-parser sequence>> subseq
+        sequence-parser [ n + ] change-n drop
+    ] if ;
+
+: sort-tokens ( seq -- seq' ) [ length ] inv-sort-by ;
+
+: take-first-matching ( sequence-parser seq -- seq )
+    swap
+    '[ _ [ swap take-sequence ] with-sequence-parser ] find nip ;
+
+: take-longest ( sequence-parser seq -- seq )
+    sort-tokens take-first-matching ;
+
+: write-full ( sequence-parser -- ) sequence>> write ;
+: write-rest ( sequence-parser -- ) take-rest write ;