peg.ebnf: Fix bug with ~ ignore and labels and add *~ +~

~ was only implemented for literals, this patch adds more support for ~

diff --git a/basis/peg/ebnf/ebnf-tests.factor b/basis/peg/ebnf/ebnf-tests.factor
index 3230ae7fe3fbde5c01569f3a13ee1a5c5168cce2..a6952ade8ca7c4aa520dd0e41d872862803cfb6d 100644 (file)
--- a/basis/peg/ebnf/ebnf-tests.factor
+++ b/basis/peg/ebnf/ebnf-tests.factor
@@ -213,7 +213,7 @@ IN: peg.ebnf.tests
 ] must-fail
 
 { 3 } [
-  { 1 2 "a" 4 } EBNF[=[ num=. ?[ number? ]? list=list:x num:y => [[ x y + ]] | num ]=]
+  { 1 2 "a" 4 } PARTIAL-EBNF[=[ num=. ?[ number? ]? list=list:x num:y => [[ x y + ]] | num ]=]
 ] unit-test
 
 [
@@ -405,7 +405,7 @@ main = Primary
 ] unit-test
 
 { V{ } } [
-  "ab cab c" EBNF[=[ a="a" "b" foo=(a "c")* ]=]
+  "ab cab c" PARTIAL-EBNF[=[ a="a" "b" foo=(a "c")* ]=]
 ] unit-test
 
 { V{ V{ V{ "a" "b" } "c" } V{ V{ "a" "b" } "c" } } } [
@@ -417,11 +417,11 @@ main = Primary
 ] unit-test
 
 { V{ } } [
-  "ab c ab c" EBNF[=[ a="a" "b" foo=(a "c")* ]=]
+  "ab c ab c" PARTIAL-EBNF[=[ a="a" "b" foo=(a "c")* ]=]
 ] unit-test
 
 { V{ } } [
-  "ab c ab c" EBNF[=[ a="a" "b" foo=(a "c")* ]=]
+  "ab c ab c" PARTIAL-EBNF[=[ a="a" "b" foo=(a "c")* ]=]
 ] unit-test
 
 { V{ "a" "a" "a" } } [
@@ -572,7 +572,7 @@ Tok                = Spaces (Number | Special )
 ] unit-test
 
 { "++" } [
-  "++--" EBNF[=[ tokenizer=("++" | "--") main="++" ]=]
+  "++--" PARTIAL-EBNF[=[ tokenizer=("++" | "--") main="++" ]=]
 ] unit-test
 
 { "\\" } [
@@ -607,7 +607,8 @@ Tok                = Spaces (Number | Special )
     EBNF: parse-til-right-bracket [=[
     foo = [^\]]+
     ]=]
-    "abc]" parse-til-right-bracket >string
+    PARTIAL-EBNF: parse-til-right-bracket* parse-til-right-bracket
+    "abc]" parse-til-right-bracket* >string
 ] unit-test
 
 ! Doesn't match anything, don't run it.
@@ -615,4 +616,33 @@ Tok                = Spaces (Number | Special )
     EBNF: parse-empty-range [=[
     foo = []+
     ]=]
+] unit-test
+
+[
+    [==[
+      EBNF: parse-empty-squote [=[
+        foo = ''
+      ]=]
+    ]==] parse-string
+] must-fail
+
+[
+    [==[
+      EBNF: parse-empty-squote [=[
+        foo = ""
+      ]=]
+    ]==] parse-string
+] must-fail
+
+! Bugfix, ensure that ~ rules are ignored with local labels
+{ { "a" "c" } } [
+    "abc" EBNF[=[ rule="a":a "b"~ "c":c => [[ a c 2array ]] ]=]
+] unit-test
+
+{ { "a" "c" } } [
+    "abc" EBNF[=[ rule="a":a "b"*~ "c":c => [[ a c 2array ]] ]=]
+] unit-test
+
+{ { "a" "c" } } [
+    "abc" EBNF[=[ rule="a":a "b"+~ "c":c => [[ a c 2array ]] ]=]
 ] unit-test
\ No newline at end of file

diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor
index c83dbfe64e0292e845e5e4622438f26a13343101..f28a22fa4da19a68e8866d483d619281bbe29cc3 100644 (file)
--- a/basis/peg/ebnf/ebnf.factor
+++ b/basis/peg/ebnf/ebnf.factor
@@ -51,9 +51,11 @@ TUPLE: ebnf-ensure group ;
 TUPLE: ebnf-ensure-not group ;
 TUPLE: ebnf-choice options ;
 TUPLE: ebnf-sequence elements ;
-TUPLE: ebnf-ignore group ;
 TUPLE: ebnf-repeat0 group ;
 TUPLE: ebnf-repeat1 group ;
+TUPLE: ebnf-ignore group ;
+TUPLE: ebnf-ignore-repeat0 group ;
+TUPLE: ebnf-ignore-repeat1 group ;
 TUPLE: ebnf-optional group ;
 TUPLE: ebnf-whitespace group ;
 TUPLE: ebnf-tokenizer elements ;
@@ -72,9 +74,11 @@ C: <ebnf-ensure> ebnf-ensure
 C: <ebnf-ensure-not> ebnf-ensure-not
 C: <ebnf-choice> ebnf-choice
 C: <ebnf-sequence> ebnf-sequence
-C: <ebnf-ignore> ebnf-ignore
 C: <ebnf-repeat0> ebnf-repeat0
 C: <ebnf-repeat1> ebnf-repeat1
+C: <ebnf-ignore> ebnf-ignore
+C: <ebnf-ignore-repeat0> ebnf-ignore-repeat0
+C: <ebnf-ignore-repeat1> ebnf-ignore-repeat1
 C: <ebnf-optional> ebnf-optional
 C: <ebnf-whitespace> ebnf-whitespace
 C: <ebnf-tokenizer> ebnf-tokenizer
@@ -84,9 +88,16 @@ C: <ebnf-var> ebnf-var
 C: <ebnf-semantic> ebnf-semantic
 C: <ebnf> ebnf
 
+MIXIN: ebnf-ignored
+
+INSTANCE: ebnf-ignore ebnf-ignored
+INSTANCE: ebnf-ignore-repeat0 ebnf-ignored
+INSTANCE: ebnf-ignore-repeat1 ebnf-ignored
+
 : filter-hidden ( seq -- seq )
     ! Remove elements that produce no AST from sequence
-    [ ebnf-ensure-not? ] reject [ ebnf-ensure? ] reject ;
+    [ ebnf-ensure-not? ] reject [ ebnf-ensure? ] reject
+    [ ebnf-ignored? ] reject ;
 
 : syntax ( string -- parser )
     ! Parses the string, ignoring white space, and
@@ -157,7 +168,7 @@ C: <ebnf> ebnf
     ! A parser to match the symbol for any character match.
     [ CHAR: . = ] satisfy [ drop <ebnf-any-character> ] action ;
 
-: range-parser-parser ( -- parser )
+: range-parser ( -- parser )
     ! Match the syntax for declaring character ranges
     [
         [ "[" syntax , "[" token ensure-not , ] seq* hide ,
@@ -179,10 +190,12 @@ C: <ebnf> ebnf
                 non-terminal-parser ,
                 terminal-parser ,
                 foreign-parser ,
-                range-parser-parser ,
+                range-parser ,
                 any-character-parser ,
             ] choice*
             [ dup , "~" token hide , ] seq* [ first <ebnf-ignore> ] action ,
+            [ dup , "*~" token hide , ] seq* [ first <ebnf-ignore-repeat0> ] action ,
+            [ dup , "+~" token hide , ] seq* [ first <ebnf-ignore-repeat1> ] action ,
             [ dup , "*" token hide , ] seq* [ first <ebnf-repeat0> ] action ,
             [ dup , "+" token hide , ] seq* [ first <ebnf-repeat1> ] action ,
             [ dup , "?[" token ensure-not , "?" token hide , ] seq* [ first <ebnf-optional> ] action ,
@@ -231,15 +244,21 @@ DEFER: choice-parser
         "?" token sp ensure-not ,
     ] seq* hide grouped ;
 
-: ignore-parser ( -- parser )
-    [ <ebnf-ignore> ] "~" syntax grouped ;
-
 : repeat0-parser ( -- parser )
     [ <ebnf-repeat0> ] "*" syntax grouped ;
 
 : repeat1-parser ( -- parser )
     [ <ebnf-repeat1> ] "+" syntax grouped ;
 
+: ignore-parser ( -- parser )
+    [ <ebnf-ignore> ] "~" syntax grouped ;
+
+: ignore-repeat0-parser ( -- parser )
+    [ <ebnf-ignore-repeat0> ] "*~" syntax grouped ;
+
+: ignore-repeat1-parser ( -- parser )
+    [ <ebnf-ignore-repeat1> ] "+~" syntax grouped ;
+
 : optional-parser ( -- parser )
     [ <ebnf-optional> ] "?" syntax grouped ;
 
@@ -278,6 +297,8 @@ DEFER: choice-parser
             element-parser sp ,
             group-parser sp ,
             ignore-parser sp ,
+            ignore-repeat0-parser sp ,
+            ignore-repeat1-parser sp ,
             repeat0-parser sp ,
             repeat1-parser sp ,
             optional-parser sp ,
@@ -410,6 +431,12 @@ M: ebnf-ensure-not (transform)
 M: ebnf-ignore (transform)
     transform-group [ drop ignore ] action ;
 
+M: ebnf-ignore-repeat0 (transform)
+    transform-group repeat0 hide ;
+
+M: ebnf-ignore-repeat1 (transform)
+    transform-group repeat1 hide ;
+
 M: ebnf-repeat0 (transform)
     transform-group repeat0 ;
 
@@ -529,9 +556,9 @@ ERROR: could-not-parse-ebnf ;
 : parse-ebnf ( string -- hashtable )
     ebnf-parser (parse) check-parse-result ast>> transform ;
 
-: ebnf>quot ( string -- hashtable quot )
+: ebnf>quot ( string -- hashtable quot: ( string -- results ) )
     parse-ebnf dup dup parser [ main of compile ] with-variable
-    [ compiled-parse ] curry [ with-scope ast>> ] curry ;
+    '[ [ _ compiled-parse ] with-scope ] ;
 
 PRIVATE>
 
@@ -539,12 +566,25 @@ SYNTAX: EBNF:
     reset-tokenizer
     scan-new-word dup scan-object
     ebnf>quot swapd
-    ( input -- ast ) define-declared "ebnf-parser" set-word-prop
-    reset-tokenizer ;
+    [ "ebnf-quot" set-word-prop ] 2keep
+    [ check-parse-result ast>> ] compose
+    ( input -- ast ) define-declared
+    "ebnf-parser" set-word-prop ;
+
+SYNTAX: PARTIAL-EBNF:
+    scan-new-word
+    scan-word "ebnf-quot" word-prop
+    [ ast>> ] compose
+    ( input -- ast ) define-declared ;
 
 : define-inline-ebnf ( ast string -- quot )
     reset-tokenizer
-    ebnf>quot nip
+    ebnf>quot [ check-parse-result ast>> ] compose nip
+    suffix! \ call suffix! reset-tokenizer ;
+
+: define-partial-inline-ebnf ( ast string -- quot )
+    reset-tokenizer
+    ebnf>quot [ ast>> ] compose nip
     suffix! \ call suffix! reset-tokenizer ;
 
 SYNTAX: EBNF[[ "]]" parse-multiline-string define-inline-ebnf ;
@@ -553,6 +593,12 @@ SYNTAX: EBNF[==[ "]==]" parse-multiline-string define-inline-ebnf ;
 SYNTAX: EBNF[===[ "]===]" parse-multiline-string define-inline-ebnf ;
 SYNTAX: EBNF[====[ "]====]" parse-multiline-string define-inline-ebnf ;
 
+SYNTAX: PARTIAL-EBNF[[ "]]" parse-multiline-string define-partial-inline-ebnf ;
+SYNTAX: PARTIAL-EBNF[=[ "]=]" parse-multiline-string define-partial-inline-ebnf ;
+SYNTAX: PARTIAL-EBNF[==[ "]==]" parse-multiline-string define-partial-inline-ebnf ;
+SYNTAX: PARTIAL-EBNF[===[ "]===]" parse-multiline-string define-partial-inline-ebnf ;
+SYNTAX: PARTIAL-EBNF[====[ "]====]" parse-multiline-string define-partial-inline-ebnf ;
+
 SYNTAX: EBNF-PARSER:
     reset-tokenizer
     scan-new-word