more work on sequence-parser

diff --git a/extra/sequence-parser/sequence-parser-tests.factor b/extra/sequence-parser/sequence-parser-tests.factor
index 715beae5dab306c84cc979130c25423ae3d9cdec..f6339b71276f37d1a2a0adab7820193bd8b32904 100644 (file)
--- a/extra/sequence-parser/sequence-parser-tests.factor
+++ b/extra/sequence-parser/sequence-parser-tests.factor
@@ -138,3 +138,15 @@ IN: sequence-parser.tests
 [ 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
+
+[ "asdfasdf" ] [
+    "/*asdfasdf*/" <sequence-parser> take-c-comment 
+] unit-test
+
+[ "k" ] [
+    "/*asdfasdf*/k" <sequence-parser> [ take-c-comment drop ] [ take-rest ] bi
+] unit-test
+
+[ "/*asdfasdf" ] [
+    "/*asdfasdf" <sequence-parser> [ take-c-comment drop ] [ take-rest ] bi
+] unit-test

diff --git a/extra/sequence-parser/sequence-parser.factor b/extra/sequence-parser/sequence-parser.factor
index 22f133bf7031549a79938c983212b2c633b649d2..d5adc568000fc05d7397bde67de08a1baab7f9be 100644 (file)
--- a/extra/sequence-parser/sequence-parser.factor
+++ b/extra/sequence-parser/sequence-parser.factor
@@ -12,6 +12,12 @@ TUPLE: sequence-parser sequence n ;
         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
@@ -33,7 +39,8 @@ TUPLE: sequence-parser sequence n ;
 
 :: skip-until ( sequence-parser quot: ( obj -- ? ) -- )
     sequence-parser current [
-        sequence-parser quot call [ sequence-parser advance quot skip-until ] unless
+        sequence-parser quot call
+        [ sequence-parser advance quot skip-until ] unless
     ] when ; inline recursive
 
 : sequence-parse-end? ( sequence-parser -- ? ) current not ;
@@ -149,5 +156,14 @@ TUPLE: sequence-parser sequence n ;
         sequence-parser [ n + ] change-n drop
     ] if ;
 
+: take-c-comment ( sequence-parser -- seq/f )
+    [
+        dup "/*" take-sequence [
+            "*/" take-until-sequence*
+        ] [
+            drop f
+        ] if
+    ] with-sequence-parser ;
+
 : write-full ( sequence-parser -- ) sequence>> write ;
 : write-rest ( sequence-parser -- ) take-rest write ;