More refactoring of EBNF

<EBNF .. EBNF> now produces a quotation that when called does the parsing
EBNF: foo ... ;EBNF creates a 'foo' word with stack effect (string -- result)
when called it parses the string and returns the result.
db4
Chris Double 2008-03-20 17:11:09 +13:00
parent 7dc772db26
commit e7980ebc61
5 changed files with 93 additions and 179 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel parser words tools.test peg peg.ebnf compiler.units ;
USING: kernel tools.test peg peg.ebnf ;
IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [
@ -109,37 +109,37 @@ IN: peg.ebnf.tests
] unit-test
{ V{ "a" "b" } } [
"foo='a' 'b'" ebnf>quot with-compilation-unit "ab" "foo" search execute parse parse-result-ast
"ab" <EBNF foo='a' 'b' EBNF> call parse-result-ast
] unit-test
{ V{ 1 "b" } } [
"foo=('a')[[ drop 1 ]] 'b'" ebnf>quot with-compilation-unit "ab" "foo" search execute parse parse-result-ast
"ab" <EBNF foo=('a')[[ drop 1 ]] 'b' EBNF> call parse-result-ast
] unit-test
{ V{ 1 2 } } [
"foo=('a') [[ drop 1 ]] ('b') [[ drop 2 ]]" ebnf>quot with-compilation-unit "ab" "foo" search execute parse parse-result-ast
"ab" <EBNF foo=('a') [[ drop 1 ]] ('b') [[ drop 2 ]] EBNF> call parse-result-ast
] unit-test
{ CHAR: A } [
"foo=[A-Z]" ebnf>quot with-compilation-unit "A" "foo" search execute parse parse-result-ast
"A" <EBNF foo=[A-Z] EBNF> call parse-result-ast
] unit-test
{ CHAR: Z } [
"foo=[A-Z]" ebnf>quot with-compilation-unit "Z" "foo" search execute parse parse-result-ast
"Z" <EBNF foo=[A-Z] EBNF> call parse-result-ast
] unit-test
{ f } [
"foo=[A-Z]" ebnf>quot with-compilation-unit "0" "foo" search execute parse
"0" <EBNF foo=[A-Z] EBNF> call
] unit-test
{ CHAR: 0 } [
"foo=[^A-Z]" ebnf>quot with-compilation-unit "0" "foo" search execute parse parse-result-ast
"0" <EBNF foo=[^A-Z] EBNF> call parse-result-ast
] unit-test
{ f } [
"foo=[^A-Z]" ebnf>quot with-compilation-unit "A" "foo" search execute parse
"A" <EBNF foo=[^A-Z] EBNF> call
] unit-test
{ f } [
"foo=[^A-Z]" ebnf>quot with-compilation-unit "Z" "foo" search execute parse
"Z" <EBNF foo=[^A-Z] EBNF> call
] unit-test

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel parser words arrays strings math.parser sequences
USING: kernel compiler.units parser words arrays strings math.parser sequences
quotations vectors namespaces math assocs continuations peg
peg.parsers unicode.categories multiline combinators.lib
splitting ;
@ -34,136 +34,6 @@ C: <ebnf-rule> ebnf-rule
C: <ebnf-action> ebnf-action
C: <ebnf> ebnf
GENERIC: (transform) ( ast -- parser )
: transform ( ast -- object )
H{ } clone dup dup [ "parser" set swap (transform) "main" set ] bind ;
M: ebnf (transform) ( ast -- parser )
ebnf-rules [ (transform) ] map peek ;
M: ebnf-rule (transform) ( ast -- parser )
dup ebnf-rule-elements (transform) [
swap ebnf-rule-symbol set
] keep ;
M: ebnf-sequence (transform) ( ast -- parser )
ebnf-sequence-elements [ (transform) ] map seq ;
M: ebnf-choice (transform) ( ast -- parser )
ebnf-choice-options [ (transform) ] map choice ;
M: ebnf-any-character (transform) ( ast -- parser )
drop any-char ;
M: ebnf-range (transform) ( ast -- parser )
ebnf-range-pattern range-pattern ;
M: ebnf-ensure-not (transform) ( ast -- parser )
ebnf-ensure-not-group (transform) ensure-not ;
M: ebnf-repeat0 (transform) ( ast -- parser )
ebnf-repeat0-group (transform) repeat0 ;
M: ebnf-repeat1 (transform) ( ast -- parser )
ebnf-repeat1-group (transform) repeat1 ;
M: ebnf-optional (transform) ( ast -- parser )
ebnf-optional-elements (transform) optional ;
M: ebnf-action (transform) ( ast -- parser )
[ ebnf-action-parser (transform) ] keep
ebnf-action-code string-lines parse-lines action ;
M: ebnf-terminal (transform) ( ast -- parser )
ebnf-terminal-symbol token sp ;
M: ebnf-non-terminal (transform) ( ast -- parser )
ebnf-non-terminal-symbol [
, "parser" get , \ at ,
] [ ] make delay ;
SYMBOL: parsers
SYMBOL: non-terminals
: reset-parser-generation ( -- )
V{ } clone parsers set
H{ } clone non-terminals set ;
: store-parser ( parser -- number )
parsers get [ push ] keep length 1- ;
: get-parser ( index -- parser )
parsers get nth ;
: non-terminal-index ( name -- number )
dup non-terminals get at [
nip
] [
f store-parser [ swap non-terminals get set-at ] keep
] if* ;
GENERIC: (generate-parser) ( ast -- id )
: generate-parser ( ast -- id )
(generate-parser) ;
M: ebnf-terminal (generate-parser) ( ast -- id )
ebnf-terminal-symbol token sp store-parser ;
M: ebnf-non-terminal (generate-parser) ( ast -- id )
[
ebnf-non-terminal-symbol dup non-terminal-index ,
parsers get , \ nth , [ search ] [ 2drop f ] recover , \ or ,
] [ ] make delay sp store-parser ;
M: ebnf-any-character (generate-parser) ( ast -- id )
drop [ drop t ] satisfy store-parser ;
M: ebnf-range (generate-parser) ( ast -- id )
ebnf-range-pattern range-pattern store-parser ;
M: ebnf-choice (generate-parser) ( ast -- id )
ebnf-choice-options [
generate-parser get-parser
] map choice store-parser ;
M: ebnf-sequence (generate-parser) ( ast -- id )
ebnf-sequence-elements [
generate-parser get-parser
] map seq store-parser ;
M: ebnf-ensure-not (generate-parser) ( ast -- id )
ebnf-ensure-not-group generate-parser get-parser ensure-not store-parser ;
M: ebnf-repeat0 (generate-parser) ( ast -- id )
ebnf-repeat0-group generate-parser get-parser repeat0 store-parser ;
M: ebnf-repeat1 (generate-parser) ( ast -- id )
ebnf-repeat1-group generate-parser get-parser repeat1 store-parser ;
M: ebnf-optional (generate-parser) ( ast -- id )
ebnf-optional-elements generate-parser get-parser optional store-parser ;
M: ebnf-rule (generate-parser) ( ast -- id )
dup ebnf-rule-symbol non-terminal-index swap
ebnf-rule-elements generate-parser get-parser ! nt-id body
swap [ parsers get set-nth ] keep ;
M: ebnf-action (generate-parser) ( ast -- id )
[ ebnf-action-parser generate-parser get-parser ] keep
ebnf-action-code string-lines parse-lines action store-parser ;
M: vector (generate-parser) ( ast -- id )
[ generate-parser ] map peek ;
M: ebnf (generate-parser) ( ast -- id )
ebnf-rules [
generate-parser
] map peek ;
DEFER: 'rhs'
: syntax ( string -- parser )
#! Parses the string, ignoring white space, and
#! does not put the result in the AST.
@ -323,28 +193,81 @@ DEFER: 'choice'
: 'ebnf' ( -- parser )
'rule' sp repeat1 [ <ebnf> ] action ;
: ebnf>quot ( string -- quot )
'ebnf' parse [
parse-result-ast [
reset-parser-generation
generate-parser drop
[
non-terminals get
[
get-parser [
swap , \ in , \ get , \ create ,
1quotation , \ define ,
] [
drop
] if*
] assoc-each
] [ ] make
] with-scope
] [
f
] if* ;
GENERIC: (transform) ( ast -- parser )
SYMBOL: parser
SYMBOL: main
: transform ( ast -- object )
H{ } clone dup dup [ parser set swap (transform) main set ] bind ;
M: ebnf (transform) ( ast -- parser )
ebnf-rules [ (transform) ] map peek ;
M: ebnf-rule (transform) ( ast -- parser )
dup ebnf-rule-elements (transform) [
swap ebnf-rule-symbol set
] keep ;
M: ebnf-sequence (transform) ( ast -- parser )
ebnf-sequence-elements [ (transform) ] map seq ;
M: ebnf-choice (transform) ( ast -- parser )
ebnf-choice-options [ (transform) ] map choice ;
M: ebnf-any-character (transform) ( ast -- parser )
drop any-char ;
M: ebnf-range (transform) ( ast -- parser )
ebnf-range-pattern range-pattern ;
M: ebnf-ensure-not (transform) ( ast -- parser )
ebnf-ensure-not-group (transform) ensure-not ;
M: ebnf-repeat0 (transform) ( ast -- parser )
ebnf-repeat0-group (transform) repeat0 ;
M: ebnf-repeat1 (transform) ( ast -- parser )
ebnf-repeat1-group (transform) repeat1 ;
M: ebnf-optional (transform) ( ast -- parser )
ebnf-optional-elements (transform) optional ;
M: ebnf-action (transform) ( ast -- parser )
[ ebnf-action-parser (transform) ] keep
ebnf-action-code string-lines [ parse-lines ] with-compilation-unit action ;
M: ebnf-terminal (transform) ( ast -- parser )
ebnf-terminal-symbol token sp ;
M: ebnf-non-terminal (transform) ( ast -- parser )
ebnf-non-terminal-symbol [
, parser get , \ at ,
] [ ] make delay sp ;
: transform-ebnf ( string -- object )
'ebnf' parse parse-result-ast transform ;
: <EBNF "EBNF>" parse-multiline-string ebnf>quot call ; parsing
: check-parse-result ( result -- result )
dup [
dup parse-result-remaining empty? [
[
"Unable to fully parse EBNF. Left to parse was: " %
parse-result-remaining %
] "" make throw
] unless
] [
"Could not parse EBNF" throw
] if ;
: ebnf>quot ( string -- hashtable quot )
'ebnf' parse check-parse-result
parse-result-ast transform dup main swap at compile ;
: <EBNF "EBNF>" parse-multiline-string ebnf>quot nip parsed ; parsing
: EBNF:
CREATE-WORD dup
";EBNF" parse-multiline-string
ebnf>quot swapd define "ebnf-parser" set-word-prop ; parsing

View File

@ -9,8 +9,7 @@ IN: peg.expr
#! { operator rhs } in to a tree structure of the correct precedence.
swap [ first2 swap call ] reduce ;
<EBNF
EBNF: expr
times = ("*") [[ drop [ * ] ]]
divide = ("/") [[ drop [ / ] ]]
add = ("+") [[ drop [ + ] ]]
@ -23,8 +22,8 @@ value = number | ("(" expr ")") [[ second ]]
product = (value ((times | divide) value)*) [[ first2 operator-fold ]]
sum = (product ((add | subtract) product)*) [[ first2 operator-fold ]]
expr = sum
EBNF>
;EBNF
: eval-expr ( string -- number )
expr parse parse-result-ast ;
expr parse-result-ast ;

View File

@ -4,14 +4,6 @@
USING: kernel tools.test peg peg.pl0 multiline sequences ;
IN: peg.pl0.tests
{ "abc" } [
"abc" ident parse parse-result-ast
] unit-test
{ 55 } [
"55abc" number parse parse-result-ast
] unit-test
{ t } [
<"
VAR x, squ;
@ -29,7 +21,7 @@ BEGIN
x := x + 1;
END
END.
"> program parse parse-result-remaining empty?
"> pl0 parse-result-remaining empty?
] unit-test
{ f } [
@ -95,5 +87,5 @@ BEGIN
y := 36;
CALL gcd;
END.
"> program parse parse-result-remaining empty?
"> pl0 parse-result-remaining empty?
] unit-test

View File

@ -6,8 +6,7 @@ IN: peg.pl0
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
<EBNF
program = block "."
EBNF: pl0
block = ( "CONST" ident "=" number ( "," ident "=" number )* ";" )?
( "VAR" ident ( "," ident )* ";" )?
( "PROCEDURE" ident ";" ( block ";" )? )* statement
@ -23,4 +22,5 @@ factor = ident | number | "(" expression ")"
ident = (([a-zA-Z])+) [[ >string ]]
digit = ([0-9]) [[ digit> ]]
number = ((digit)+) [[ unclip [ swap 10 * + ] reduce ]]
EBNF>
program = block "."
;EBNF