Fix peg tests

extra/peg/ebnf/ebnf-tests.factor

@@ -7,11 +7,11 @@ USING: kernel tools.test peg peg.ebnf words math math.parser
 IN: peg.ebnf.tests
 
 { T{ ebnf-non-terminal f "abc" } } [
-  "abc" 'non-terminal' parse ast>> 
+  "abc" 'non-terminal' parse 
 ] unit-test
 
 { T{ ebnf-terminal f "55" } } [
-  "'55'" 'terminal' parse ast>> 
+  "'55'" 'terminal' parse 
 ] unit-test
 
 {
@@ -22,7 +22,7 @@ IN: peg.ebnf.tests
      }
   } 
 } [
-  "digit = '1' | '2'" 'rule' parse ast>>
+  "digit = '1' | '2'" 'rule' parse
 ] unit-test
 
 {
@@ -33,7 +33,7 @@ IN: peg.ebnf.tests
      }
   }   
 } [
-  "digit = '1' '2'" 'rule' parse ast>>
+  "digit = '1' '2'" 'rule' parse
 ] unit-test
 
 {
@@ -46,7 +46,7 @@ IN: peg.ebnf.tests
      }
   } 
 } [
-  "one two | three" 'choice' parse ast>>
+  "one two | three" 'choice' parse
 ] unit-test
 
 {
@@ -61,7 +61,7 @@ IN: peg.ebnf.tests
      }
   } 
 } [
-  "one {two | three}" 'choice' parse ast>>
+  "one {two | three}" 'choice' parse
 ] unit-test
 
 {
@@ -81,7 +81,7 @@ IN: peg.ebnf.tests
      }
   } 
 } [
-  "one ((two | three) four)*" 'choice' parse ast>>
+  "one ((two | three) four)*" 'choice' parse
 ] unit-test
 
 {
@@ -93,23 +93,23 @@ IN: peg.ebnf.tests
      }
   } 
 } [
-  "one ( two )? three" 'choice' parse ast>>
+  "one ( two )? three" 'choice' parse
 ] unit-test
 
 { "foo" } [
-  "\"foo\"" 'identifier' parse ast>>
+  "\"foo\"" 'identifier' parse
 ] unit-test
 
 { "foo" } [
-  "'foo'" 'identifier' parse ast>>
+  "'foo'" 'identifier' parse
 ] unit-test
 
 { "foo" } [
-  "foo" 'non-terminal' parse ast>> ebnf-non-terminal-symbol
+  "foo" 'non-terminal' parse ebnf-non-terminal-symbol
 ] unit-test
 
 { "foo" } [
-  "foo]" 'non-terminal' parse ast>> ebnf-non-terminal-symbol
+  "foo]" 'non-terminal' parse ebnf-non-terminal-symbol
 ] unit-test
 
 { V{ "a" "b" } } [
@@ -252,7 +252,7 @@ IN: peg.ebnf.tests
 ] unit-test
 
 { t } [
-  "abcd='9' | ('8'):x => [[ x ]]" 'ebnf' parse parse-result-remaining empty?
+  "abcd='9' | ('8'):x => [[ x ]]" 'ebnf' (parse) remaining>> empty?
 ] unit-test
 
 EBNF: primary 
@@ -385,29 +385,29 @@ main = Primary
 ] unit-test
 
 { t } [
-  "number=(digit)+:n 'a'" 'ebnf' parse remaining>> length zero?
+  "number=(digit)+:n 'a'" 'ebnf' (parse) remaining>> length zero?
 ] unit-test
 
 { t } [
-  "number=(digit)+ 'a'" 'ebnf' parse remaining>> length zero?
+  "number=(digit)+ 'a'" 'ebnf' (parse) remaining>> length zero?
 ] unit-test
 
 { t } [
-  "number=digit+ 'a'" 'ebnf' parse remaining>> length zero?
+  "number=digit+ 'a'" 'ebnf' (parse) remaining>> length zero?
 ] unit-test
 
 { t } [
-  "number=digit+:n 'a'" 'ebnf' parse remaining>> length zero?
+  "number=digit+:n 'a'" 'ebnf' (parse) remaining>> length zero?
 ] unit-test
 
 { t } [
-  "foo=(name):n !(keyword) => [[ n ]]" 'rule' parse ast>>
-  "foo=name:n !(keyword) => [[ n ]]" 'rule' parse ast>> =
+  "foo=(name):n !(keyword) => [[ n ]]" 'rule' parse
+  "foo=name:n !(keyword) => [[ n ]]" 'rule' parse =
 ] unit-test
 
 { t } [
-  "foo=!(keyword) (name):n => [[ n ]]" 'rule' parse ast>>
-  "foo=!(keyword) name:n => [[ n ]]" 'rule' parse ast>> =
+  "foo=!(keyword) (name):n => [[ n ]]" 'rule' parse
+  "foo=!(keyword) name:n => [[ n ]]" 'rule' parse =
 ] unit-test
 
 <<
@@ -455,7 +455,7 @@ foo=<foreign any-char> 'd'
 { t } [
   #! Rule lookup occurs in a namespace. This causes an incorrect duplicate rule
   #! if a var in a namespace is set. This unit test is to remind me to fix this.
-  [ "fail" "foo" set "foo='a'" 'ebnf' parse ast>> transform drop t ] with-scope
+  [ "fail" "foo" set "foo='a'" 'ebnf' parse transform drop t ] with-scope
 ] unit-test
 
 #! Tokenizer tests

extra/peg/ebnf/ebnf.factor

@@ -504,7 +504,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
   ] [ ] make box ;
 
 : transform-ebnf ( string -- object )
-  'ebnf' parse parse-result-ast transform ;
+  'ebnf' parse transform ;
 
 : check-parse-result ( result -- result )
   dup [
@@ -519,7 +519,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
   ] if ;
 
 : parse-ebnf ( string -- hashtable )
-  'ebnf' parse check-parse-result ast>> transform ;
+  'ebnf' (parse) check-parse-result ast>> transform ;
 
 : ebnf>quot ( string -- hashtable quot )
   parse-ebnf dup dup parser [ main swap at compile ] with-variable

extra/peg/parsers/parsers-tests.factor

@@ -2,50 +2,50 @@ USING: kernel peg peg.parsers tools.test accessors ;
 IN: peg.parsers.tests
 
 { V{ "a" } }
-[ "a" "a" token "," token list-of parse ast>> ] unit-test
+[ "a" "a" token "," token list-of parse ] unit-test
 
 { V{ "a" "a" "a" "a" } }
-[ "a,a,a,a" "a" token "," token list-of parse ast>> ] unit-test
+[ "a,a,a,a" "a" token "," token list-of parse ] unit-test
 
 [ "a" "a" token "," token list-of-many parse ] must-fail
 
 { V{ "a" "a" "a" "a" } }
-[ "a,a,a,a" "a" token "," token list-of-many parse ast>> ] unit-test
+[ "a,a,a,a" "a" token "," token list-of-many parse ] unit-test
 
 [ "aaa" "a" token 4 exactly-n parse ] must-fail
 
 { V{ "a" "a" "a" "a" } }
-[ "aaaa" "a" token 4 exactly-n parse ast>> ] unit-test
+[ "aaaa" "a" token 4 exactly-n parse ] unit-test
 
 [ "aaa" "a" token 4 at-least-n parse ] must-fail
 
 { V{ "a" "a" "a" "a" } }
-[ "aaaa" "a" token 4 at-least-n parse ast>> ] unit-test
+[ "aaaa" "a" token 4 at-least-n parse ] unit-test
 
 { V{ "a" "a" "a" "a" "a" } }
-[ "aaaaa" "a" token 4 at-least-n parse ast>> ] unit-test
+[ "aaaaa" "a" token 4 at-least-n parse ] unit-test
 
 { V{ "a" "a" "a" "a" } }
-[ "aaaa" "a" token 4 at-most-n parse ast>> ] unit-test
+[ "aaaa" "a" token 4 at-most-n parse ] unit-test
 
 { V{ "a" "a" "a" "a" } }
-[ "aaaaa" "a" token 4 at-most-n parse ast>> ] unit-test
+[ "aaaaa" "a" token 4 at-most-n parse ] unit-test
 
 { V{ "a" "a" "a" } }
-[ "aaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test
+[ "aaa" "a" token 3 4 from-m-to-n parse ] unit-test
 
 { V{ "a" "a" "a" "a" } }
-[ "aaaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test
+[ "aaaa" "a" token 3 4 from-m-to-n parse ] unit-test
 
 { V{ "a" "a" "a" "a" } }
-[ "aaaaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test
+[ "aaaaa" "a" token 3 4 from-m-to-n parse ] unit-test
 
 { 97 }
-[ "a" any-char parse ast>> ] unit-test
+[ "a" any-char parse ] unit-test
 
 { V{ } }
-[ "" epsilon parse ast>> ] unit-test
+[ "" epsilon parse ] unit-test
 
 { "a" } [
-  "a" "a" token just parse ast>>
+  "a" "a" token just parse
 ] unit-test

extra/peg/parsers/parsers.factor

@@ -3,7 +3,7 @@
 USING: kernel sequences strings namespaces math assocs shuffle 
      vectors arrays math.parser 
      unicode.categories sequences.deep peg peg.private 
-     peg.search math.ranges words memoize ;
+     peg.search math.ranges words ;
 IN: peg.parsers
 
 TUPLE: just-parser p1 ;
@@ -19,7 +19,7 @@ TUPLE: just-parser p1 ;
 M: just-parser (compile) ( parser -- quot )
   just-parser-p1 compiled-parser just-pattern curry ;
 
-MEMO: just ( parser -- parser )
+: just ( parser -- parser )
   just-parser boa init-parser ;
 
 : 1token ( ch -- parser ) 1string token ;
@@ -45,10 +45,10 @@ MEMO: just ( parser -- parser )
 
 PRIVATE>
 
-MEMO: exactly-n ( parser n -- parser' )
+: exactly-n ( parser n -- parser' )
   swap <repetition> seq ;
 
-MEMO: at-most-n ( parser n -- parser' )
+: at-most-n ( parser n -- parser' )
   dup zero? [
     2drop epsilon
   ] [
@@ -56,15 +56,15 @@ MEMO: at-most-n ( parser n -- parser' )
     -rot 1- at-most-n 2choice
   ] if ;
 
-MEMO: at-least-n ( parser n -- parser' )
+: at-least-n ( parser n -- parser' )
   dupd exactly-n swap repeat0 2seq
   [ flatten-vectors ] action ;
 
-MEMO: from-m-to-n ( parser m n -- parser' )
+: from-m-to-n ( parser m n -- parser' )
   >r [ exactly-n ] 2keep r> swap - at-most-n 2seq
   [ flatten-vectors ] action ;
 
-MEMO: pack ( begin body end -- parser )
+: pack ( begin body end -- parser )
   >r >r hide r> r> hide 3seq [ first ] action ;
 
 : surrounded-by ( parser begin end -- parser' )

extra/peg/peg-tests.factor

@@ -10,7 +10,7 @@ IN: peg.tests
 ] must-fail
 
 { "begin" "end" } [
-  "beginend" "begin" token parse 
+  "beginend" "begin" token (parse) 
   { ast>> remaining>> } get-slots
   >string
 ] unit-test
@@ -24,11 +24,11 @@ IN: peg.tests
 ] must-fail
 
 { CHAR: a } [
-  "abcd" CHAR: a CHAR: z range parse ast>>
+  "abcd" CHAR: a CHAR: z range parse
 ] unit-test
 
 { CHAR: z } [
-  "zbcd" CHAR: a CHAR: z range parse ast>>
+  "zbcd" CHAR: a CHAR: z range parse
 ] unit-test
 
 [
@@ -36,15 +36,15 @@ IN: peg.tests
 ] must-fail
 
 { V{ "g" "o" } } [
-  "good" "g" token "o" token 2array seq parse ast>>
+  "good" "g" token "o" token 2array seq parse
 ] unit-test
 
 { "a" } [
-  "abcd" "a" token "b" token 2array choice parse ast>>
+  "abcd" "a" token "b" token 2array choice parse
 ] unit-test
 
 { "b" } [
-  "bbcd" "a" token "b" token 2array choice parse ast>>
+  "bbcd" "a" token "b" token 2array choice parse
 ] unit-test
 
 [
@@ -56,15 +56,15 @@ IN: peg.tests
 ] must-fail
 
 { 0 } [
-  "" "a" token repeat0 parse ast>> length
+  "" "a" token repeat0 parse length
 ] unit-test
 
 { 0 } [
-  "b" "a" token repeat0 parse ast>> length
+  "b" "a" token repeat0 parse length
 ] unit-test
 
 { V{ "a" "a" "a" } } [
-  "aaab" "a" token repeat0 parse ast>> 
+  "aaab" "a" token repeat0 parse 
 ] unit-test
 
 [
@@ -76,15 +76,15 @@ IN: peg.tests
 ] must-fail
 
 { V{ "a" "a" "a" } } [
-  "aaab" "a" token repeat1 parse ast>>
+  "aaab" "a" token repeat1 parse
 ] unit-test
 
 { V{ "a" "b" } } [ 
-  "ab" "a" token optional "b" token 2array seq parse ast>> 
+  "ab" "a" token optional "b" token 2array seq parse 
 ] unit-test
 
 { V{ f "b" } } [ 
-  "b" "a" token optional "b" token 2array seq parse ast>> 
+  "b" "a" token optional "b" token 2array seq parse 
 ] unit-test
 
 [ 
@@ -92,7 +92,7 @@ IN: peg.tests
 ] must-fail
 
 { V{ CHAR: a CHAR: b } } [
-  "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse ast>>
+  "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse
 ] unit-test
 
 [
@@ -124,11 +124,11 @@ IN: peg.tests
 ] must-fail
 
 { 1 } [
-  "a" "a" token [ drop 1 ] action parse ast>> 
+  "a" "a" token [ drop 1 ] action parse 
 ] unit-test
 
 { V{ 1 1 } } [
-  "aa" "a" token [ drop 1 ] action dup 2array seq parse ast>> 
+  "aa" "a" token [ drop 1 ] action dup 2array seq parse 
 ] unit-test
 
 [
@@ -140,19 +140,19 @@ IN: peg.tests
 ] must-fail
 
 { CHAR: a } [ 
-  "a" [ CHAR: a = ] satisfy parse ast>>
+  "a" [ CHAR: a = ] satisfy parse
 ] unit-test
 
 { "a" } [
-  "    a" "a" token sp parse ast>>
+  "    a" "a" token sp parse
 ] unit-test
 
 { "a" } [
-  "a" "a" token sp parse ast>>
+  "a" "a" token sp parse
 ] unit-test
 
 { V{ "a" } } [
-  "[a]" "[" token hide "a" token "]" token hide 3array seq parse ast>>
+  "[a]" "[" token hide "a" token "]" token hide 3array seq parse
 ] unit-test
 
 [
@@ -165,8 +165,8 @@ IN: peg.tests
     [ "1" token , "-" token , "1" token , ] seq* ,
     [ "1" token , "+" token , "1" token , ] seq* ,
   ] choice* 
-  "1-1" over parse ast>> swap
-  "1+1" swap parse ast>>
+  "1-1" over parse swap
+  "1+1" swap parse
 ] unit-test
 
 : expr ( -- parser ) 
@@ -175,7 +175,7 @@ IN: peg.tests
   [ expr ] delay "+" token "1" token 3seq "1" token 2choice ;
 
 { V{ V{ "1" "+" "1" } "+" "1" } } [
-  "1+1+1" expr parse ast>>   
+  "1+1+1" expr parse   
 ] unit-test
 
 { t } [
@@ -190,6 +190,6 @@ IN: peg.tests
 ] must-fail
 
 { CHAR: B } [
-  "B" [ drop t ] satisfy [ 66 >= ] semantic parse ast>>
+  "B" [ drop t ] satisfy [ 66 >= ] semantic parse
 ] unit-test
 

extra/peg/peg.factor

@@ -286,9 +286,12 @@ SYMBOL: delayed
 : compiled-parse ( state word -- result )
   swap [ execute [ error-stack get first throw ] unless* ] with-packrat ; inline 
 
-: parse ( input parser -- result )
+: (parse) ( input parser -- result )
   dup word? [ compile ] unless compiled-parse ;
 
+: parse ( input parser -- ast )
+  (parse) ast>> ;
+
 <PRIVATE
 
 SYMBOL: id 

extra/peg/pl0/pl0-tests.factor

@@ -6,39 +6,39 @@ USING: kernel tools.test peg peg.ebnf peg.pl0
 IN: peg.pl0.tests
 
 { t } [
-  "CONST foo = 1;" "block" \ pl0 rule parse remaining>> empty? 
+  "CONST foo = 1;" "block" \ pl0 rule (parse) remaining>> empty? 
 ] unit-test
 
 { t } [
-  "VAR foo;" "block" \ pl0 rule parse remaining>> empty?
+  "VAR foo;" "block" \ pl0 rule (parse) remaining>> empty?
 ] unit-test
 
 { t } [
-  "VAR foo,bar , baz;" "block" \ pl0 rule parse remaining>> empty? 
+  "VAR foo,bar , baz;" "block" \ pl0 rule (parse) remaining>> empty? 
 ] unit-test
 
 { t } [
-  "foo := 5" "statement" \ pl0 rule parse remaining>> empty? 
+  "foo := 5" "statement" \ pl0 rule (parse) remaining>> empty? 
 ] unit-test
 
 { t } [
-  "BEGIN foo := 5 END" "statement" \ pl0 rule parse remaining>> empty? 
+  "BEGIN foo := 5 END" "statement" \ pl0 rule (parse) remaining>> empty? 
 ] unit-test
 
 { t } [
-  "IF 1=1 THEN foo := 5" "statement" \ pl0 rule parse remaining>> empty? 
+  "IF 1=1 THEN foo := 5" "statement" \ pl0 rule (parse) remaining>> empty? 
 ] unit-test
 
 { t } [
-  "WHILE 1=1 DO foo := 5" "statement" \ pl0 rule parse remaining>> empty? 
+  "WHILE 1=1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty? 
 ] unit-test
 
 { t } [
-  "WHILE ODD 1 DO foo := 5" "statement" \ pl0 rule parse remaining>> empty? 
+  "WHILE ODD 1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty? 
 ] unit-test
 
 { t } [
-  "PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule parse remaining>> empty? 
+  "PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule (parse) remaining>> empty? 
 ] unit-test
 
 { t } [

extra/peg/search/search.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math io io.streams.string sequences strings
-combinators peg memoize arrays ;
+combinators peg memoize arrays continuations ;
 IN: peg.search
 
 : tree-write ( object -- )
@@ -16,15 +16,12 @@ MEMO: any-char-parser ( -- parser )
   [ drop t ] satisfy ;
 
 : search ( string parser -- seq )
-  any-char-parser [ drop f ] action 2array choice repeat0 parse dup [
-    parse-result-ast sift
-  ] [
-    drop { }
-  ] if ;
+  any-char-parser [ drop f ] action 2array choice repeat0 
+  [ parse sift ] [ 3drop { } ] recover ;
 
 
 : (replace) ( string parser -- seq )
-  any-char-parser 2array choice repeat0 parse parse-result-ast sift ;
+  any-char-parser 2array choice repeat0 parse sift ;
 
 : replace ( string parser -- result )
  [  (replace) [ tree-write ] each ] with-string-writer ;