From 055276ca25f896936719ff4e7ba01e0a3c63e01b Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Tue, 27 Nov 2007 15:36:26 +1300
Subject: [PATCH] Add 'sp' parser to skip whitespace

---
 extra/peg/peg-docs.factor |  8 ++++++++
 extra/peg/peg.factor      | 15 +++++++++++++++
 2 files changed, 23 insertions(+)

diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor
index 1ba30fe06e..bb610dce18 100644
--- a/extra/peg/peg-docs.factor
+++ b/extra/peg/peg-docs.factor
@@ -120,3 +120,11 @@ HELP: action
     "the default AST." }
 { $example "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;
 
+HELP: sp
+{ $values 
+  { "p1" "a parser" } 
+  { "parser" "a parser" } 
+}
+{ $description 
+    "Returns a parser that calls the original parser 'p1' after stripping any whitespace "
+    " from the left of the input string." } ;
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 6dd3700291..df492ddcf2 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -156,6 +156,18 @@ M: action-parser parse ( state parser -- result )
      nip
    ] if ;
 
+: left-trim-slice ( string -- string )
+  #! Return a new string without any leading whitespace
+  #! from the original string.
+  dup empty? [
+    dup first blank? [ 1 tail-slice left-trim-slice ] when
+  ] unless ;
+
+TUPLE: sp-parser p1 ;
+
+M: sp-parser parse ( state parser -- result )
+  [ left-trim-slice ] dip sp-parser-p1 parse ;
+
 PRIVATE>
 
 : token ( string -- parser )
@@ -190,3 +202,6 @@ PRIVATE>
 
 : action ( parser quot -- parser )
   action-parser construct-boa init-parser ;
+
+: sp ( parser -- parser )
+  sp-parser construct-boa init-parser ;