Fix some failing ebnf unit tests

diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index 0a16fc8007c0194b4a1d8b58872cee0e0335127a..e3c6586c89524992f60ba42cb53ea19e645fc792 100644 (file)
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -444,7 +444,7 @@ foo=<foreign any-char> 'd'
 ] unit-test
 
 { t } [
- "USING: kernel peg.ebnf ; [EBNF foo='a' '\n'  => [[ drop '\n' ]] EBNF]" eval drop t
+ "USING: kernel peg.ebnf ; [EBNF foo='a' '\n'  => [[ drop \"\n\" ]] EBNF]" eval drop t
 ] unit-test
 
 [

diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index e78757be34d3c051bdb533cf36f16158988203f8..cba48f5892e30c7929f2e366da56c3a12c4743ab 100644 (file)
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -63,6 +63,20 @@ C: <ebnf> ebnf
   #! begin and end.\r
   [ syntax ] 2dip syntax pack ;\r
 \r
+: replace-escapes ( string -- string )\r
+  [\r
+    "\\t" token [ drop "\t" ] action ,\r
+    "\\n" token [ drop "\n" ] action ,\r
+    "\\r" token [ drop "\r" ] action ,\r
+  ] choice* replace ;\r
+\r
+: insert-escapes ( string -- string )\r
+  [\r
+    "\t" token [ drop "\\t" ] action ,\r
+    "\n" token [ drop "\\n" ] action ,\r
+    "\r" token [ drop "\\r" ] action ,\r
+  ] choice* replace ;\r
+\r
 : 'identifier' ( -- parser )\r
   #! Return a parser that parses an identifer delimited by\r
   #! a quotation character. The quotation can be single\r
@@ -71,7 +85,7 @@ C: <ebnf> ebnf
   [\r
     [ CHAR: " = not ] satisfy repeat1 "\"" "\"" surrounded-by ,\r
     [ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,\r
-  ] choice* [ >string ] action ;\r
+  ] choice* [ >string replace-escapes ] action ;\r
   \r
 : 'non-terminal' ( -- parser )\r
   #! A non-terminal is the name of another rule. It can\r
@@ -401,11 +415,11 @@ M: object build-locals ( code ast -- )
   } cond ;\r
  \r
 M: ebnf-action (transform) ( ast -- parser )\r
-  [ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals  \r
+  [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals  \r
   string-lines parse-lines check-action-effect action ;\r
 \r
 M: ebnf-semantic (transform) ( ast -- parser )\r
-  [ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals \r
+  [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals \r
   string-lines parse-lines semantic ;\r
 \r
 M: ebnf-var (transform) ( ast -- parser )\r
@@ -453,17 +467,10 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
   parse-result-ast transform dup dup parser [ main swap at compile ] with-variable\r
   [ compiled-parse ] curry [ with-scope ] curry ;\r
 \r
-: replace-escapes ( string -- string )\r
-  [\r
-    "\\t" token [ drop "\t" ] action ,\r
-    "\\n" token [ drop "\n" ] action ,\r
-    "\\r" token [ drop "\r" ] action ,\r
-  ] choice* replace ;\r
-\r
-: [EBNF "EBNF]" parse-multiline-string replace-escapes ebnf>quot nip parsed ; parsing\r
+: [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing\r
 \r
 : EBNF: \r
   CREATE-WORD dup \r
-  ";EBNF" parse-multiline-string replace-escapes\r
+  ";EBNF" parse-multiline-string \r
   ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop ; parsing\r
 \r