From d22a24a90eef38975b6eb5bacfc010477730d453 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Fri, 20 Jun 2008 14:13:50 +1200
Subject: [PATCH] Fix some failing ebnf unit tests
---
extra/peg/ebnf/ebnf-tests.factor | 2 +-
extra/peg/ebnf/ebnf.factor | 31 +++++++++++++++++++------------
2 files changed, 20 insertions(+), 13 deletions(-)
diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index 0a16fc8007..e3c6586c89 100644
--- 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 e78757be34..cba48f5892 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -63,6 +63,20 @@ C: <ebnf> ebnf
#! begin and end.
[ syntax ] 2dip syntax pack ;
+: replace-escapes ( string -- string )
+ [
+ "\\t" token [ drop "\t" ] action ,
+ "\\n" token [ drop "\n" ] action ,
+ "\\r" token [ drop "\r" ] action ,
+ ] choice* replace ;
+
+: insert-escapes ( string -- string )
+ [
+ "\t" token [ drop "\\t" ] action ,
+ "\n" token [ drop "\\n" ] action ,
+ "\r" token [ drop "\\r" ] action ,
+ ] choice* replace ;
+
: 'identifier' ( -- parser )
#! Return a parser that parses an identifer delimited by
#! a quotation character. The quotation can be single
@@ -71,7 +85,7 @@ C: <ebnf> ebnf
[
[ CHAR: " = not ] satisfy repeat1 "\"" "\"" surrounded-by ,
[ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,
- ] choice* [ >string ] action ;
+ ] choice* [ >string replace-escapes ] action ;
: 'non-terminal' ( -- parser )
#! A non-terminal is the name of another rule. It can
@@ -401,11 +415,11 @@ M: object build-locals ( code ast -- )
} cond ;
M: ebnf-action (transform) ( ast -- parser )
- [ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals
+ [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals
string-lines parse-lines check-action-effect action ;
M: ebnf-semantic (transform) ( ast -- parser )
- [ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals
+ [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals
string-lines parse-lines semantic ;
M: ebnf-var (transform) ( ast -- parser )
@@ -453,17 +467,10 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
parse-result-ast transform dup dup parser [ main swap at compile ] with-variable
[ compiled-parse ] curry [ with-scope ] curry ;
-: replace-escapes ( string -- string )
- [
- "\\t" token [ drop "\t" ] action ,
- "\\n" token [ drop "\n" ] action ,
- "\\r" token [ drop "\r" ] action ,
- ] choice* replace ;
-
-: [EBNF "EBNF]" parse-multiline-string replace-escapes ebnf>quot nip parsed ; parsing
+: [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing
: EBNF:
CREATE-WORD dup
- ";EBNF" parse-multiline-string replace-escapes
+ ";EBNF" parse-multiline-string
ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop ; parsing