refactor some error handling in peg, more unit tests

diff --git a/basis/peg/ebnf/ebnf-tests.factor b/basis/peg/ebnf/ebnf-tests.factor
index a6d3cf0b21c610414d4dd4e2626f8b5529c0d702..cc83a55c7e65c2aed4ccf87afa2278e1fff37c3e 100644 (file)
--- a/basis/peg/ebnf/ebnf-tests.factor
+++ b/basis/peg/ebnf/ebnf-tests.factor
@@ -3,7 +3,7 @@
 !
 USING: kernel tools.test peg peg.ebnf words math math.parser 
        sequences accessors peg.parsers parser namespaces arrays 
-       strings eval ;
+       strings eval unicode.data multiline ;
 IN: peg.ebnf.tests
 
 { T{ ebnf-non-terminal f "abc" } } [
@@ -520,3 +520,13 @@ Tok                = Spaces (Number | Special )
 { "\\" } [
   "\\" [EBNF foo="\\" EBNF]
 ] unit-test
+
+[ "USE: peg.ebnf [EBNF EBNF]" eval ] must-fail
+
+[ <" USE: peg.ebnf [EBNF
+    lol = a
+    lol = b
+  EBNF] "> eval
+] [
+    error>> [ redefined-rule? ] [ name>> "lol" = ] bi and
+] must-fail-with

diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor
index 9f730831e79e11184a71d04814b20df6e88fc6de..b50ba685b8c06582583cb370ca972ac4660859a8 100644 (file)
--- a/basis/peg/ebnf/ebnf.factor
+++ b/basis/peg/ebnf/ebnf.factor
@@ -5,13 +5,18 @@ sequences quotations vectors namespaces make math assocs
 continuations peg peg.parsers unicode.categories multiline\r
 splitting accessors effects sequences.deep peg.search\r
 combinators.short-circuit lexer io.streams.string stack-checker\r
-io combinators parser ;\r
+io combinators parser summary ;\r
 IN: peg.ebnf\r
 \r
 : rule ( name word -- parser )\r
   #! Given an EBNF word produced from EBNF: return the EBNF rule\r
   "ebnf-parser" word-prop at ;\r
 \r
+ERROR: no-rule rule parser ;\r
+\r
+: lookup-rule ( rule parser -- rule' )\r
+    2dup rule [ 2nip ] [ no-rule ] if* ; \r
+\r
 TUPLE: tokenizer any one many ;\r
 \r
 : default-tokenizer ( -- tokenizer )\r
@@ -34,8 +39,13 @@ TUPLE: tokenizer any one many ;
 : reset-tokenizer ( -- )\r
   default-tokenizer \ tokenizer set-global ;\r
 \r
+ERROR: no-tokenizer name ;\r
+\r
+M: no-tokenizer summary\r
+    drop "Tokenizer not found" ;\r
+\r
 SYNTAX: TOKENIZER: \r
-  scan search [ "Tokenizer not found" throw ] unless*\r
+  scan dup search [ nip ] [ no-tokenizer ] if*\r
   execute( -- tokenizer ) \ tokenizer set-global ;\r
 \r
 TUPLE: ebnf-non-terminal symbol ;\r
@@ -258,7 +268,7 @@ DEFER: 'choice'
     "]]" token ensure-not ,\r
     "]?" token ensure-not ,\r
     [ drop t ] satisfy ,\r
-  ] seq* [ first ] action repeat0 [ >string ] action ;\r
+  ] seq* repeat0 [ concat >string ] action ;\r
 \r
 : 'ensure-not' ( -- parser )\r
   #! Parses the '!' syntax to ensure that \r
@@ -367,15 +377,16 @@ M: ebnf-tokenizer (transform) ( ast -- parser )
   (transform) \r
   dup parser-tokenizer \ tokenizer set-global\r
   ] if ;\r
+\r
+ERROR: redefined-rule name ;\r
+\r
+M: redefined-rule summary\r
+  name>> "Rule '" "' defined more than once" surround ;\r
   \r
 M: ebnf-rule (transform) ( ast -- parser )\r
   dup elements>> \r
   (transform) [\r
-    swap symbol>> dup get parser? [ \r
-      "Rule '" over append "' defined more than once" append throw \r
-    ] [ \r
-      set \r
-    ] if\r
+    swap symbol>> dup get parser? [ redefined-rule ] [ set ] if\r
   ] keep ;\r
 \r
 M: ebnf-sequence (transform) ( ast -- parser )\r
@@ -466,14 +477,18 @@ ERROR: bad-effect quot effect ;
     { [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] }\r
     [ bad-effect ]\r
   } cond ;\r
+\r
+: ebnf-transform ( ast -- parser quot )\r
+  [ parser>> (transform) ]\r
+  [ code>> insert-escapes ]\r
+  [ parser>> ] tri build-locals  \r
+  [ string-lines parse-lines ] call( string -- quot ) ;\r
  \r
 M: ebnf-action (transform) ( ast -- parser )\r
-  [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals  \r
-  [ string-lines parse-lines ] call( string -- quot ) check-action-effect action ;\r
+  ebnf-transform check-action-effect action ;\r
 \r
 M: ebnf-semantic (transform) ( ast -- parser )\r
-  [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals \r
-  [ string-lines parse-lines ] call( string -- quot ) semantic ;\r
+  ebnf-transform semantic ;\r
 \r
 M: ebnf-var (transform) ( ast -- parser )\r
   parser>> (transform) ;\r
@@ -481,19 +496,20 @@ M: ebnf-var (transform) ( ast -- parser )
 M: ebnf-terminal (transform) ( ast -- parser )\r
   symbol>> tokenizer one>> call( symbol -- parser ) ;\r
 \r
+ERROR: ebnf-foreign-not-found name ;\r
+\r
+M: ebnf-foreign-not-found summary\r
+  name>> "Foreign word '" "' not found" surround ;\r
+\r
 M: ebnf-foreign (transform) ( ast -- parser )\r
-  dup word>> search\r
-  [ "Foreign word '" swap word>> append "' not found" append throw ] unless*\r
+  dup word>> search [ word>> ebnf-foreign-not-found ] unless*\r
   swap rule>> [ main ] unless* over rule [\r
     nip\r
   ] [\r
     execute( -- parser )\r
   ] if* ;\r
 \r
-: parser-not-found ( name -- * )\r
-  [\r
-    "Parser '" % % "' not found." %\r
-  ] "" make throw ;\r
+ERROR: parser-not-found name ;\r
 \r
 M: ebnf-non-terminal (transform) ( ast -- parser )\r
   symbol>>  [\r
@@ -504,16 +520,16 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
   'ebnf' parse transform ;\r
 \r
 : check-parse-result ( result -- result )\r
-  dup [\r
-    dup remaining>> [ blank? ] trim empty? [\r
+  [\r
+    dup remaining>> [ blank? ] trim [\r
       [ \r
         "Unable to fully parse EBNF. Left to parse was: " %\r
         remaining>> % \r
       ] "" make throw\r
-    ] unless\r
+    ] unless-empty\r
   ] [\r
     "Could not parse EBNF" throw\r
-  ] if ;\r
+  ] if* ;\r
 \r
 : parse-ebnf ( string -- hashtable )\r
   'ebnf' (parse) check-parse-result ast>> transform ;\r
@@ -522,14 +538,18 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
   parse-ebnf dup dup parser [ main swap at compile ] with-variable\r
   [ compiled-parse ] curry [ with-scope ast>> ] curry ;\r
 \r
-SYNTAX: <EBNF "EBNF>" reset-tokenizer parse-multiline-string parse-ebnf main swap at  \r
+SYNTAX: <EBNF\r
+  "EBNF>"\r
+  reset-tokenizer parse-multiline-string parse-ebnf main swap at  \r
   parsed reset-tokenizer ;\r
 \r
-SYNTAX: [EBNF "EBNF]" reset-tokenizer parse-multiline-string ebnf>quot nip \r
+SYNTAX: [EBNF\r
+  "EBNF]"\r
+  reset-tokenizer parse-multiline-string ebnf>quot nip \r
   parsed \ call parsed reset-tokenizer ;\r
 \r
 SYNTAX: EBNF: \r
   reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string  \r
-  ebnf>quot swapd (( input -- ast )) define-declared "ebnf-parser" set-word-prop \r
+  ebnf>quot swapd\r
+  (( input -- ast )) define-declared "ebnf-parser" set-word-prop \r
   reset-tokenizer ;\r
-\r