From af9e27823a3840438ab1ba0b74a7bb899e38ff84 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 17:17:31 +1300 Subject: [PATCH 1/4] Add => action rule for an entire sequence --- extra/peg/ebnf/ebnf-tests.factor | 17 +++++++++++++++++ extra/peg/ebnf/ebnf.factor | 23 ++++++++++++++++++----- 2 files changed, 35 insertions(+), 5 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index c2c0a50a59..7aa61e84da 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -144,6 +144,23 @@ IN: peg.ebnf.tests "Z" [EBNF foo=[^A-Z] EBNF] call ] unit-test +{ V{ "1" "+" "foo" } } [ + "1+1" [EBNF foo='1' '+' '1' [[ drop "foo" ]] EBNF] call parse-result-ast +] unit-test + +{ "foo" } [ + "1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] EBNF] call parse-result-ast +] unit-test + +{ "foo" } [ + "1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast +] unit-test + +{ "bar" } [ + "1-1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast +] 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 diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index c1e2ce8546..af61c3aae0 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -111,7 +111,10 @@ C: ebnf 'range-parser' , 'any-character' , ] choice* , - "=" syntax ensure-not , + [ + "=" syntax ensure-not , + "=>" syntax ensure , + ] choice* , ] seq* [ first ] action ; DEFER: 'choice' @@ -176,7 +179,10 @@ DEFER: 'choice' 'repeat0' sp , 'repeat1' sp , 'optional' sp , - ] choice* ; + ] choice* ; + +: 'action' ( -- parser ) + "[[" 'factor-code' "]]" syntax-pack ; : 'sequence' ( -- parser ) #! A sequence of terminals and non-terminals, including @@ -184,15 +190,21 @@ DEFER: 'choice' [ [ ('sequence') , - "[[" 'factor-code' "]]" syntax-pack , + 'action' , ] seq* [ first2 ] action , ('sequence') , ] choice* repeat1 [ dup length 1 = [ first ] [ ] if ] action ; + +: 'actioned-sequence' ( -- parser ) + [ + [ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 ] action , + 'sequence' , + ] choice* ; : 'choice' ( -- parser ) - 'sequence' sp "|" token sp list-of [ + 'actioned-sequence' sp "|" token sp list-of [ dup length 1 = [ first ] [ ] if ] action ; @@ -200,7 +212,8 @@ DEFER: 'choice' [ 'non-terminal' [ symbol>> ] action , "=" syntax , - 'choice' , + ">" token ensure-not , + 'choice' , ] seq* [ first2 ] action ; : 'ebnf' ( -- parser ) From d002e029485339ff7c15cdbfb20867e59304c3d0 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 17:23:11 +1300 Subject: [PATCH 2/4] Use left recursive grammar in peg.expr --- extra/peg/expr/expr.factor | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/extra/peg/expr/expr.factor b/extra/peg/expr/expr.factor index 6b690cb5ee..e16d9db0a7 100644 --- a/extra/peg/expr/expr.factor +++ b/extra/peg/expr/expr.factor @@ -4,24 +4,19 @@ USING: kernel arrays strings math.parser sequences peg peg.ebnf peg.parsers memoize math ; IN: peg.expr -: operator-fold ( lhs seq -- value ) - #! Perform a fold of a lhs, followed by a sequence of pairs being - #! { operator rhs } in to a tree structure of the correct precedence. - swap [ first2 swap call ] reduce ; - EBNF: expr -times = "*" [[ drop [ * ] ]] -divide = "/" [[ drop [ / ] ]] -add = "+" [[ drop [ + ] ]] -subtract = "-" [[ drop [ - ] ]] +digit = [0-9] => [[ digit> ]] +number = (digit)+ => [[ 10 digits>integer ]] +value = number + | ("(" exp ")") => [[ second ]] -digit = [0-9] [[ digit> ]] -number = (digit)+ [[ unclip [ swap 10 * + ] reduce ]] +fac = fac "*" value => [[ first3 nip * ]] + | fac "/" value => [[ first3 nip / ]] + | number -value = number | ("(" expr ")") [[ second ]] -product = (value ((times | divide) value)*) [[ first2 operator-fold ]] -sum = (product ((add | subtract) product)*) [[ first2 operator-fold ]] -expr = sum +exp = exp "+" fac => [[ first3 nip + ]] + | exp "-" fac => [[ first3 nip - ]] + | fac ;EBNF : eval-expr ( string -- number ) From a23e0ce15c97e58ea0f4de621ea4f77c5422b791 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 17:35:47 +1300 Subject: [PATCH 3/4] Fix hashcode* on parsers --- extra/peg/peg.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 247a64eac2..8621b43a7f 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -12,6 +12,8 @@ TUPLE: parse-result remaining ast ; TUPLE: parser id compiled ; M: parser equal? [ id>> ] 2apply = ; +M: parser hashcode* ( depth obj -- code ) + id>> hashcode* ; C: parser SYMBOL: ignore From 8eb55b4c591d3da3b316b3c54485eb571c5ed428 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 23:48:06 -0500 Subject: [PATCH 4/4] More doc fixes --- core/kernel/kernel-docs.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 587839f685..a446869096 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -295,12 +295,12 @@ HELP: hashcode* { $values { "depth" integer } { "obj" object } { "code" fixnum } } { $contract "Outputs the hashcode of an object. The hashcode operation must satisfy the following properties:" { $list - { "if two objects are equal under " { $link = } ", they must have equal hashcodes" } - { "if the hashcode of an object depends on the values of its slots, the hashcode of the slots must be computed recursively by calling " { $link hashcode* } " with a " { $snippet "level" } " parameter decremented by one. This avoids excessive work while still computing well-distributed hashcodes. The " { $link recursive-hashcode } " combinator can help with implementing this logic" } - { "the hashcode should be a " { $link fixnum } ", however returning a " { $link bignum } " will not cause any problems other than potential performance degradation." - "the hashcode is only permitted to change between two invocations if the object was mutated in some way" } + { "If two objects are equal under " { $link = } ", they must have equal hashcodes." } + { "If the hashcode of an object depends on the values of its slots, the hashcode of the slots must be computed recursively by calling " { $link hashcode* } " with a " { $snippet "level" } " parameter decremented by one. This avoids excessive work while still computing well-distributed hashcodes. The " { $link recursive-hashcode } " combinator can help with implementing this logic," } + { "The hashcode should be a " { $link fixnum } ", however returning a " { $link bignum } " will not cause any problems other than potential performance degradation." } + { "The hashcode is only permitted to change between two invocations if the object or one of its slot values was mutated." } } -"If mutable objects are used as hashtable keys, they must not be mutated in such a way that their hashcode changes. Doing so will violate bucket sorting invariants and result in undefined behavior." } ; +"If mutable objects are used as hashtable keys, they must not be mutated in such a way that their hashcode changes. Doing so will violate bucket sorting invariants and result in undefined behavior. See " { $link "hashtables.keys" } " for details." } ; HELP: hashcode { $values { "obj" object } { "code" fixnum } }