more work on sequence-parser

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

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 ;