Merge branch 'master' of git://factorcode.org/git/factor

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 } }

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  

extra/peg/ebnf/ebnf.factor

@@ -111,7 +111,10 @@ C: <ebnf> 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 <ebnf-action> ] action ,
     ('sequence') ,
   ] choice* repeat1 [ 
      dup length 1 = [ first ] [ <ebnf-sequence> ] if
   ] action ;
+
+: 'actioned-sequence' ( -- parser )
+  [
+    [ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 <ebnf-action> ] action ,
+    'sequence' ,
+  ] choice* ;
   
 : 'choice' ( -- parser )
-  'sequence' sp "|" token sp list-of [ 
+  'actioned-sequence' sp "|" token sp list-of [ 
     dup length 1 = [ first ] [ <ebnf-choice> ] if
   ] action ;
  
@@ -200,7 +212,8 @@ DEFER: 'choice'
   [
     'non-terminal' [ symbol>> ] action  ,
     "=" syntax  ,
-    'choice'  ,
+    ">" token ensure-not ,
+    'choice' ,
   ] seq* [ first2 <ebnf-rule> ] action ;
 
 : 'ebnf' ( -- parser )

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 )

extra/peg/peg.factor

@@ -11,7 +11,11 @@ USE: prettyprint
 TUPLE: parse-result remaining ast ;
 
 TUPLE: parser id compiled ;
+
 M: parser equal? [ id>> ] bi@ = ;
+
+M: parser hashcode* id>> hashcode* ;
+
 C: <parser> parser
 
 SYMBOL: ignore