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= '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 #! 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 [ [ 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 define-declared "ebnf-parser" set-word-prop ; parsing