From 72bfd57f308a6b2efe7c8b9697282eab00588856 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Tue, 1 Apr 2008 11:28:14 +1300
Subject: [PATCH 01/10] Make ebnf forgiving of whitespace at end of expression
---
extra/peg/ebnf/ebnf.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 4f00edbd3c..26e5d68df8 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -320,7 +320,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
: check-parse-result ( result -- result )
dup [
- dup parse-result-remaining empty? [
+ dup parse-result-remaining [ blank? ] trim empty? [
[
"Unable to fully parse EBNF. Left to parse was: " %
parse-result-remaining %
From 122fd50d4a7fee989bdcf69dc699d7bcf4246600 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Tue, 1 Apr 2008 14:49:20 +1300
Subject: [PATCH 02/10] Throw error when ebnf uses a non-existant non-terminal
---
extra/peg/ebnf/ebnf.factor | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 26e5d68df8..a6567ce8f3 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -310,9 +310,14 @@ M: ebnf-var (transform) ( ast -- parser )
M: ebnf-terminal (transform) ( ast -- parser )
symbol>> token sp ;
+: parser-not-found ( name -- * )
+ [
+ "Parser " % % " not found." %
+ ] "" make throw ;
+
M: ebnf-non-terminal (transform) ( ast -- parser )
symbol>> [
- , parser get , \ at , \ sp ,
+ , \ dup , parser get , \ at , [ parser-not-found ] , \ unless* , \ sp , \ nip ,
] [ ] make box ;
: transform-ebnf ( string -- object )
From 6b454eed36490c35cd928e8b5b932f4e3ba2dc6d Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Wed, 2 Apr 2008 12:59:12 +1300
Subject: [PATCH 03/10] Various peg/ebnf fixes - Box parsers were broken when
involved in left recursion detection - ebnf no longer implicitly ignores
white space between terminates/non-terminals - ebnf now handles \t and \n in
grammars so productions to detect white space work - reset-delegates is now
reset-pegs
---
extra/peg/ebnf/ebnf-tests.factor | 53 ++++++++++++++++++++++++++++++--
extra/peg/ebnf/ebnf.factor | 13 +++++---
extra/peg/peg.factor | 24 +++++++++------
3 files changed, 74 insertions(+), 16 deletions(-)
diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index 4f802c5207..84c492c55a 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -180,6 +180,55 @@ IN: peg.ebnf.tests
{ 1 2 "a" 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call parse-result-ast
] unit-test
+{ f } [
+ "ab" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call
+] unit-test
+
+{ V{ "a" " " "b" } } [
+ "a b" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call parse-result-ast
+] unit-test
+
+{ V{ "a" "\t" "b" } } [
+ "a\tb" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call parse-result-ast
+] unit-test
+
+{ V{ "a" "\n" "b" } } [
+ "a\nb" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call parse-result-ast
+] unit-test
+
+{ V{ "a" f "b" } } [
+ "ab" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call parse-result-ast
+] unit-test
+
+{ V{ "a" " " "b" } } [
+ "a b" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call parse-result-ast
+] unit-test
+
+
+{ V{ "a" "\t" "b" } } [
+ "a\tb" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call parse-result-ast
+] unit-test
+
+{ V{ "a" "\n" "b" } } [
+ "a\nb" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call parse-result-ast
+] unit-test
+
+{ V{ "a" "b" } } [
+ "ab" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call parse-result-ast
+] unit-test
+
+{ V{ "a" "b" } } [
+ "a\tb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call parse-result-ast
+] unit-test
+
+{ V{ "a" "b" } } [
+ "a\nb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call parse-result-ast
+] unit-test
+
+{ f } [
+ "axb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call
+] unit-test
+
{ V{ V{ 49 } "+" V{ 49 } } } [
#! Test direct left recursion.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
@@ -200,7 +249,7 @@ IN: peg.ebnf.tests
EBNF: primary
Primary = PrimaryNoNewArray
-PrimaryNoNewArray = ClassInstanceCreationExpression
+PrimaryNoNewArray = ClassInstanceCreationExpression
| MethodInvocation
| FieldAccess
| ArrayAccess
@@ -211,7 +260,7 @@ MethodInvocation = Primary "." MethodName "(" ")"
| MethodName "(" ")"
FieldAccess = Primary "." Identifier
| "super" "." Identifier
-ArrayAccess = Primary "[" Expression "]"
+ArrayAccess = Primary "[" Expression "]"
| ExpressionName "[" Expression "]"
ClassOrInterfaceType = ClassName | InterfaceTypeName
ClassName = "C" | "D"
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index a6567ce8f3..a4e4fe387d 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -3,7 +3,7 @@
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 accessors effects sequences.deep ;
+ splitting accessors effects sequences.deep peg.search ;
IN: peg.ebnf
TUPLE: ebnf-non-terminal symbol ;
@@ -308,7 +308,7 @@ M: ebnf-var (transform) ( ast -- parser )
dup vars get push [ dupd set ] curry action ;
M: ebnf-terminal (transform) ( ast -- parser )
- symbol>> token sp ;
+ symbol>> token ;
: parser-not-found ( name -- * )
[
@@ -317,7 +317,7 @@ M: ebnf-terminal (transform) ( ast -- parser )
M: ebnf-non-terminal (transform) ( ast -- parser )
symbol>> [
- , \ dup , parser get , \ at , [ parser-not-found ] , \ unless* , \ sp , \ nip ,
+ , \ dup , parser get , \ at , [ parser-not-found ] , \ unless* , \ nip ,
] [ ] make box ;
: transform-ebnf ( string -- object )
@@ -340,10 +340,13 @@ 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 ;
-: [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing
+: replace-escapes ( string -- string )
+ "\\t" token [ drop "\t" ] action "\\n" token [ drop "\n" ] action 2choice replace ;
+
+: [EBNF "EBNF]" parse-multiline-string replace-escapes ebnf>quot nip parsed ; parsing
: EBNF:
CREATE-WORD dup
- ";EBNF" parse-multiline-string
+ ";EBNF" parse-multiline-string replace-escapes
ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop ; parsing
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 9e35c5b9be..ad821635d7 100755
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -30,6 +30,14 @@ SYMBOL: fail
SYMBOL: lrstack
SYMBOL: heads
+: delegates ( -- cache )
+ \ delegates get-global [ H{ } clone dup \ delegates set-global ] unless* ;
+
+: reset-pegs ( -- )
+ H{ } clone \ delegates set-global ;
+
+reset-pegs
+
TUPLE: memo-entry ans pos ;
C: <memo-entry> memo-entry
@@ -253,14 +261,6 @@ SYMBOL: id
1 id set-global 0
] if* ;
-: delegates ( -- cache )
- \ delegates get-global [ H{ } clone dup \ delegates set-global ] unless* ;
-
-: reset-delegates ( -- )
- H{ } clone \ delegates set-global ;
-
-reset-delegates
-
: init-parser ( parser -- parser )
#! Set the delegate for the parser. Equivalent parsers
#! get a delegate with the same id.
@@ -590,7 +590,13 @@ PRIVATE>
#! not a cached one. This is because the same box,
#! compiled twice can have a different compiled word
#! due to running at compile time.
- box-parser construct-boa next-id f <parser> over set-delegate ;
+ #! Why the [ ] action at the end? Box parsers don't get
+ #! memoized during parsing due to all box parsers being
+ #! unique. This breaks left recursion detection during the
+ #! parse. The action adds an indirection with a parser type
+ #! that gets memoized and fixes this. Need to rethink how
+ #! to fix boxes so this isn't needed...
+ box-parser construct-boa next-id f <parser> over set-delegate [ ] action ;
: PEG:
(:) [
From 1b58ba404ec22cef9d8713369c6aa4fa47387864 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Wed, 2 Apr 2008 13:50:29 +1300
Subject: [PATCH 04/10] Fix peg.pl0 test failures
---
extra/peg/pl0/pl0-tests.factor | 47 +++++++++++++++++++++++++++++++++-
extra/peg/pl0/pl0.factor | 26 ++++++++++---------
2 files changed, 60 insertions(+), 13 deletions(-)
diff --git a/extra/peg/pl0/pl0-tests.factor b/extra/peg/pl0/pl0-tests.factor
index b3d2135da7..1ed528d05d 100644
--- a/extra/peg/pl0/pl0-tests.factor
+++ b/extra/peg/pl0/pl0-tests.factor
@@ -1,9 +1,54 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
!
-USING: kernel tools.test peg peg.pl0 multiline sequences ;
+USING: kernel tools.test peg peg.pl0 multiline sequences words assocs ;
IN: peg.pl0.tests
+{ f } [
+ "CONST foo = 1;" \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+] unit-test
+
+{ f } [
+ "VAR foo;" \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+] unit-test
+
+{ f } [
+ "VAR foo,bar , baz;" \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+] unit-test
+
+{ f } [
+ "foo := 5;" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+] unit-test
+
+{ f } [
+ "BEGIN foo := 5; END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+] unit-test
+
+{ f } [
+ "IF 1=1 THEN foo := 5; END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+] unit-test
+
+{ f } [
+ "WHILE 1=1 DO foo := 5; END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+] unit-test
+
+{ f } [
+ "WHILE ODD 1=1 DO foo := 5; END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+] unit-test
+
+{ f } [
+ "PROCEDURE square; BEGIN squ=x*x END" \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+] unit-test
+
+{ f } [
+ <"
+PROCEDURE square;
+BEGIN
+ squ := x * x
+END;
+"> \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+] unit-test
+
{ t } [
<"
VAR x, squ;
diff --git a/extra/peg/pl0/pl0.factor b/extra/peg/pl0/pl0.factor
index f7eb3cad23..8025728285 100644
--- a/extra/peg/pl0/pl0.factor
+++ b/extra/peg/pl0/pl0.factor
@@ -7,18 +7,20 @@ IN: peg.pl0
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
EBNF: pl0
-block = ( "CONST" ident "=" number ( "," ident "=" number )* ";" )?
- ( "VAR" ident ( "," ident )* ";" )?
- ( "PROCEDURE" ident ";" ( block ";" )? )* statement
-statement = ( ident ":=" expression | "CALL" ident |
- "BEGIN" statement (";" statement )* "END" |
- "IF" condition "THEN" statement |
- "WHILE" condition "DO" statement )?
-condition = "ODD" expression |
- expression ("=" | "#" | "<=" | "<" | ">=" | ">") expression
-expression = ("+" | "-")? term (("+" | "-") term )*
-term = factor (("*" | "/") factor )*
-factor = ident | number | "(" expression ")"
+- = (" " | "\t" | "\n")+ => [[ drop ignore ]]
+_ = (" " | "\t" | "\n")* => [[ drop ignore ]]
+block = ( _ "CONST" - ident _ "=" _ number ( _ "," _ ident _ "=" _ number )* _ ";" )?
+ ( _ "VAR" - ident ( _ "," _ ident )* _ ";" )?
+ ( _ "PROCEDURE" - ident _ ";" ( _ block _ ";" )? )* _ statement
+statement = ( ident _ ":=" _ expression | "CALL" - ident |
+ "BEGIN" - statement ( _ ";" _ statement )* _ "END" |
+ "IF" - condition _ "THEN" - statement |
+ "WHILE" - condition _ "DO" - statement )?
+condition = "ODD" - expression |
+ expression _ ("=" | "#" | "<=" | "<" | ">=" | ">") _ expression
+expression = ("+" | "-")? term ( _ ("+" | "-") _ term )*
+term = factor ( _ ("*" | "/") _ factor )*
+factor = ident | number | "(" _ expression _ ")"
ident = (([a-zA-Z])+) [[ >string ]]
digit = ([0-9]) [[ digit> ]]
number = ((digit)+) [[ unclip [ swap 10 * + ] reduce ]]
From bbcc84862f5e2ee038011886b330c3c655e754d4 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Wed, 2 Apr 2008 15:47:21 +1300
Subject: [PATCH 05/10] Tweak ast from sequences in ebnf
---
extra/peg/ebnf/ebnf.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index a4e4fe387d..7c5854cd7d 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -252,7 +252,7 @@ M: ebnf-rule (transform) ( ast -- parser )
] keep ;
M: ebnf-sequence (transform) ( ast -- parser )
- elements>> [ (transform) ] map seq ;
+ elements>> [ (transform) ] map seq [ dup length 1 = [ first ] when ] action ;
M: ebnf-choice (transform) ( ast -- parser )
options>> [ (transform) ] map choice ;
From 34a1505d95891fd516e4f5b176d937fe4641dd8a Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Wed, 2 Apr 2008 15:47:30 +1300
Subject: [PATCH 06/10] PL0 whitespace handling improvement
---
extra/peg/pl0/pl0-tests.factor | 36 +++++++++----------
extra/peg/pl0/pl0.factor | 64 +++++++++++++++++++++++++---------
2 files changed, 65 insertions(+), 35 deletions(-)
diff --git a/extra/peg/pl0/pl0-tests.factor b/extra/peg/pl0/pl0-tests.factor
index 1ed528d05d..039f66637d 100644
--- a/extra/peg/pl0/pl0-tests.factor
+++ b/extra/peg/pl0/pl0-tests.factor
@@ -4,40 +4,40 @@
USING: kernel tools.test peg peg.pl0 multiline sequences words assocs ;
IN: peg.pl0.tests
-{ f } [
- "CONST foo = 1;" \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+{ t } [
+ "CONST foo = 1;" \ pl0 "ebnf-parser" word-prop "block" swap at parse parse-result-remaining empty?
] unit-test
-{ f } [
- "VAR foo;" \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+{ t } [
+ "VAR foo;" \ pl0 "ebnf-parser" word-prop "block" swap at parse parse-result-remaining empty?
] unit-test
-{ f } [
- "VAR foo,bar , baz;" \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+{ t } [
+ "VAR foo,bar , baz;" \ pl0 "ebnf-parser" word-prop "block" swap at parse parse-result-remaining empty?
] unit-test
-{ f } [
- "foo := 5;" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+{ t } [
+ "foo := 5" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
] unit-test
-{ f } [
- "BEGIN foo := 5; END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+{ t } [
+ "BEGIN foo := 5 END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
] unit-test
-{ f } [
- "IF 1=1 THEN foo := 5; END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+{ t } [
+ "IF 1=1 THEN foo := 5" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
] unit-test
-{ f } [
- "WHILE 1=1 DO foo := 5; END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+{ t } [
+ "WHILE 1=1 DO foo := 5" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
] unit-test
-{ f } [
- "WHILE ODD 1=1 DO foo := 5; END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse not
+{ t } [
+ "WHILE ODD 1 DO foo := 5" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
] unit-test
-{ f } [
- "PROCEDURE square; BEGIN squ=x*x END" \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+{ t } [
+ "PROCEDURE square; BEGIN squ:=x*x END" \ pl0 "ebnf-parser" word-prop "block" swap at parse parse-result-remaining empty?
] unit-test
{ f } [
diff --git a/extra/peg/pl0/pl0.factor b/extra/peg/pl0/pl0.factor
index 8025728285..1b97814ca7 100644
--- a/extra/peg/pl0/pl0.factor
+++ b/extra/peg/pl0/pl0.factor
@@ -7,22 +7,52 @@ IN: peg.pl0
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
EBNF: pl0
-- = (" " | "\t" | "\n")+ => [[ drop ignore ]]
_ = (" " | "\t" | "\n")* => [[ drop ignore ]]
-block = ( _ "CONST" - ident _ "=" _ number ( _ "," _ ident _ "=" _ number )* _ ";" )?
- ( _ "VAR" - ident ( _ "," _ ident )* _ ";" )?
- ( _ "PROCEDURE" - ident _ ";" ( _ block _ ";" )? )* _ statement
-statement = ( ident _ ":=" _ expression | "CALL" - ident |
- "BEGIN" - statement ( _ ";" _ statement )* _ "END" |
- "IF" - condition _ "THEN" - statement |
- "WHILE" - condition _ "DO" - statement )?
-condition = "ODD" - expression |
- expression _ ("=" | "#" | "<=" | "<" | ">=" | ">") _ expression
-expression = ("+" | "-")? term ( _ ("+" | "-") _ term )*
-term = factor ( _ ("*" | "/") _ factor )*
-factor = ident | number | "(" _ expression _ ")"
-ident = (([a-zA-Z])+) [[ >string ]]
-digit = ([0-9]) [[ digit> ]]
-number = ((digit)+) [[ unclip [ swap 10 * + ] reduce ]]
-program = block "."
+
+BEGIN = "BEGIN" _
+CALL = "CALL" _
+CONST = "CONST" _
+DO = "DO" _
+END = "END" _
+IF = "IF" _
+THEN = "THEN" _
+ODD = "ODD" _
+PROCEDURE = "PROCEDURE" _
+VAR = "VAR" _
+WHILE = "WHILE" _
+EQ = "=" _
+LTEQ = "<=" _
+LT = "<" _
+GT = ">" _
+GTEQ = ">=" _
+NEQ = "#" _
+COMMA = "," _
+SEMICOLON = ";" _
+ASSIGN = ":=" _
+
+ADD = "+" _
+SUBTRACT = "-" _
+MULTIPLY = "*" _
+DIVIDE = "/" _
+
+LPAREN = "(" _
+RPAREN = ")" _
+
+block = ( CONST ident EQ number ( COMMA ident EQ number )* SEMICOLON )?
+ ( VAR ident ( COMMA ident )* SEMICOLON )?
+ ( PROCEDURE ident SEMICOLON ( block SEMICOLON )? )* statement
+statement = ( ident ASSIGN expression
+ | CALL ident
+ | BEGIN statement ( SEMICOLON statement )* END
+ | IF condition THEN statement
+ | WHILE condition DO statement )?
+condition = ODD expression
+ | expression (EQ | NEQ | LTEQ | LT | GTEQ | GT) expression
+expression = (ADD | SUBTRACT)? term ( (ADD | SUBTRACT) term )* _
+term = factor ( (MULTIPLY | DIVIDE) factor )*
+factor = ident | number | LPAREN expression RPAREN
+ident = (([a-zA-Z])+) _ => [[ >string ]]
+digit = ([0-9]) => [[ digit> ]]
+number = ((digit)+) _ => [[ 10 digits>integer ]]
+program = _ block "."
;EBNF
From eac450bdcf28773813552170bd1091e13148202b Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Wed, 2 Apr 2008 15:55:18 +1300
Subject: [PATCH 07/10] Add ebnf rule word
---
extra/peg/ebnf/ebnf.factor | 3 +++
extra/peg/pl0/pl0-tests.factor | 29 ++++++++++-------------------
2 files changed, 13 insertions(+), 19 deletions(-)
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 7c5854cd7d..b0dfaad5b3 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -350,3 +350,6 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
";EBNF" parse-multiline-string replace-escapes
ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop ; parsing
+: rule ( name word -- parser )
+ #! Given an EBNF word produced from EBNF: return the EBNF rule
+ "ebnf-parser" word-prop at ;
\ No newline at end of file
diff --git a/extra/peg/pl0/pl0-tests.factor b/extra/peg/pl0/pl0-tests.factor
index 039f66637d..88993c354b 100644
--- a/extra/peg/pl0/pl0-tests.factor
+++ b/extra/peg/pl0/pl0-tests.factor
@@ -1,52 +1,43 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
!
-USING: kernel tools.test peg peg.pl0 multiline sequences words assocs ;
+USING: kernel tools.test peg peg.ebnf peg.pl0 multiline sequences ;
IN: peg.pl0.tests
{ t } [
- "CONST foo = 1;" \ pl0 "ebnf-parser" word-prop "block" swap at parse parse-result-remaining empty?
+ "CONST foo = 1;" "block" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
- "VAR foo;" \ pl0 "ebnf-parser" word-prop "block" swap at parse parse-result-remaining empty?
+ "VAR foo;" "block" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
- "VAR foo,bar , baz;" \ pl0 "ebnf-parser" word-prop "block" swap at parse parse-result-remaining empty?
+ "VAR foo,bar , baz;" "block" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
- "foo := 5" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
+ "foo := 5" "statement" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
- "BEGIN foo := 5 END" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
+ "BEGIN foo := 5 END" "statement" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
- "IF 1=1 THEN foo := 5" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
+ "IF 1=1 THEN foo := 5" "statement" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
- "WHILE 1=1 DO foo := 5" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
+ "WHILE 1=1 DO foo := 5" "statement" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
- "WHILE ODD 1 DO foo := 5" \ pl0 "ebnf-parser" word-prop "statement" swap at parse parse-result-remaining empty?
+ "WHILE ODD 1 DO foo := 5" "statement" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
- "PROCEDURE square; BEGIN squ:=x*x END" \ pl0 "ebnf-parser" word-prop "block" swap at parse parse-result-remaining empty?
-] unit-test
-
-{ f } [
- <"
-PROCEDURE square;
-BEGIN
- squ := x * x
-END;
-"> \ pl0 "ebnf-parser" word-prop "block" swap at parse not
+ "PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule parse parse-result-remaining empty?
] unit-test
{ t } [
From 27f2992dc5eca644fb077017746243b5f34e4cf2 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Thu, 3 Apr 2008 16:09:03 +1300
Subject: [PATCH 08/10] Add failing ebnf test
---
extra/peg/ebnf/ebnf-tests.factor | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index 84c492c55a..0879ecda49 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
!
-USING: kernel tools.test peg peg.ebnf words math math.parser ;
+USING: kernel tools.test peg peg.ebnf words math math.parser sequences ;
IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [
@@ -247,6 +247,10 @@ IN: peg.ebnf.tests
"1+1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call parse-result-ast
] unit-test
+{ t } [
+ "abcd='9' | ('8'):x => [[ drop x ]]" 'ebnf' parse parse-result-remaining empty?
+] unit-test
+
EBNF: primary
Primary = PrimaryNoNewArray
PrimaryNoNewArray = ClassInstanceCreationExpression
From cc7d945a80273d4ce966d307424a4f66e72e32ae Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Thu, 3 Apr 2008 17:28:09 +1300
Subject: [PATCH 09/10] Change ebnf variables to not use namespaces
---
extra/peg/ebnf/ebnf.factor | 55 +++++++++++++++++++++++++-------------
1 file changed, 37 insertions(+), 18 deletions(-)
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index b0dfaad5b3..49c2d5a8dd 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -237,17 +237,16 @@ GENERIC: (transform) ( ast -- parser )
SYMBOL: parser
SYMBOL: main
-SYMBOL: vars
: transform ( ast -- object )
- H{ } clone dup dup [ parser set V{ } vars set swap (transform) main set ] bind ;
+ H{ } clone dup dup [ parser set swap (transform) main set ] bind ;
M: ebnf (transform) ( ast -- parser )
rules>> [ (transform) ] map peek ;
M: ebnf-rule (transform) ( ast -- parser )
dup elements>>
- vars get clone vars [ (transform) ] with-variable [
+ (transform) [
swap symbol>> set
] keep ;
@@ -282,30 +281,50 @@ M: ebnf-repeat1 (transform) ( ast -- parser )
M: ebnf-optional (transform) ( ast -- parser )
transform-group optional ;
-: build-locals ( string vars -- string )
- dup empty? [
- drop
- ] [
+GENERIC: build-locals ( code ast -- code )
+
+M: ebnf-sequence build-locals ( code ast -- code )
+ elements>> dup [ ebnf-var? ] subset empty? [
+ drop
+ ] [
[
- "USING: locals namespaces ; [let* | " %
- [ dup % " [ \"" % % "\" get ] " % ] each
- " | " %
- %
- " ] with-locals" %
+ "USING: locals sequences ; [let* | " %
+ dup length swap [
+ dup ebnf-var? [
+ name>> %
+ " [ " % # " over nth ] " %
+ ] [
+ 2drop
+ ] if
+ ] 2each
+ " | " %
+ %
+ " ] with-locals" %
] "" make
] if ;
+M: ebnf-var build-locals ( code ast -- )
+ [
+ "USING: locals kernel ; [let* | " %
+ name>> % " [ dup ] " %
+ " | " %
+ %
+ " ] with-locals" %
+ ] "" make ;
+
+M: object build-locals ( code ast -- )
+ drop ;
+
M: ebnf-action (transform) ( ast -- parser )
- [ parser>> (transform) ] keep
- code>> vars get build-locals string-lines [ parse-lines ] with-compilation-unit action ;
+ [ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals
+ string-lines [ parse-lines ] with-compilation-unit action ;
M: ebnf-semantic (transform) ( ast -- parser )
- [ parser>> (transform) ] keep
- code>> vars get build-locals string-lines [ parse-lines ] with-compilation-unit semantic ;
+ [ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals
+ string-lines [ parse-lines ] with-compilation-unit semantic ;
M: ebnf-var (transform) ( ast -- parser )
- [ parser>> (transform) ] [ name>> ] bi
- dup vars get push [ dupd set ] curry action ;
+ parser>> (transform) ;
M: ebnf-terminal (transform) ( ast -- parser )
symbol>> token ;
From 970f0055c266ab813c177b4c4f545e51ea203479 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Thu, 3 Apr 2008 17:33:37 +1300
Subject: [PATCH 10/10] Fix failing ebnf unit test
---
extra/peg/ebnf/ebnf.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 49c2d5a8dd..e5787e6cf8 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -213,6 +213,7 @@ DEFER: 'choice'
: 'actioned-sequence' ( -- parser )
[
[ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 <ebnf-action> ] action ,
+ [ 'sequence' , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , "=>" syntax , 'action' , ] seq* [ first3 >r <ebnf-var> r> <ebnf-action> ] action ,
[ 'sequence' , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
'sequence' ,
] choice* ;