From 732065d7759d5b5368948808a48d4185540c91c7 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Thu, 9 Apr 2009 21:32:57 -0500
Subject: [PATCH] more work on sequence-parser

---
 .../sequence-parser-tests.factor               | 12 ++++++++++++
 extra/sequence-parser/sequence-parser.factor   | 18 +++++++++++++++++-
 2 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/extra/sequence-parser/sequence-parser-tests.factor b/extra/sequence-parser/sequence-parser-tests.factor
index 715beae5da..f6339b7127 100644
--- 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 22f133bf70..d5adc56800 100644
--- 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 ;