Add PEG: word

extra/farkup/farkup-tests.factor

@@ -1,44 +1,44 @@
 USING: farkup kernel tools.test ;
 IN: farkup.tests
 
-[ "<ul><li>foo</li></ul>" ] [ "-foo" parse-farkup ] unit-test
+[ "<ul><li>foo</li></ul>" ] [ "-foo" convert-farkup ] unit-test
-[ "<ul><li>foo</li></ul>\n" ] [ "-foo\n" parse-farkup ] unit-test
+[ "<ul><li>foo</li></ul>\n" ] [ "-foo\n" convert-farkup ] unit-test
-[ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar" parse-farkup ] unit-test
+[ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar" convert-farkup ] unit-test
-[ "<ul><li>foo</li><li>bar</li></ul>\n" ] [ "-foo\n-bar\n" parse-farkup ] unit-test
+[ "<ul><li>foo</li><li>bar</li></ul>\n" ] [ "-foo\n-bar\n" convert-farkup ] unit-test
 
-[ "<ul><li>foo</li></ul>\n<p>bar\n</p>" ] [ "-foo\nbar\n" parse-farkup ] unit-test
+[ "<ul><li>foo</li></ul>\n<p>bar\n</p>" ] [ "-foo\nbar\n" convert-farkup ] unit-test
-[ "<p>*foo\nbar\n</p>" ] [ "*foo\nbar\n" parse-farkup ] unit-test
+[ "<p>*foo\nbar\n</p>" ] [ "*foo\nbar\n" convert-farkup ] unit-test
-[ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" parse-farkup ] unit-test
+[ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" convert-farkup ] unit-test
-[ "<p><em>Wow.</em></p>" ] [ "_Wow._" parse-farkup ] unit-test
+[ "<p><em>Wow.</em></p>" ] [ "_Wow._" convert-farkup ] unit-test
 
-[ "<p>*</p>" ] [ "*" parse-farkup ] unit-test
+[ "<p>*</p>" ] [ "*" convert-farkup ] unit-test
-[ "<p>*</p>" ] [ "\\*" parse-farkup ] unit-test
+[ "<p>*</p>" ] [ "\\*" convert-farkup ] unit-test
-[ "<p>**</p>" ] [ "\\**" parse-farkup ] unit-test
+[ "<p>**</p>" ] [ "\\**" convert-farkup ] unit-test
 
-[ "" ] [ "\n\n" parse-farkup ] unit-test
+[ "" ] [ "\n\n" convert-farkup ] unit-test
-[ "\n" ] [ "\n\n\n" parse-farkup ] unit-test
+[ "\n" ] [ "\n\n\n" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" parse-farkup ] unit-test
+[ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" convert-farkup ] unit-test
 
-[ "\n<p>bar\n</p>" ] [ "\nbar\n" parse-farkup ] unit-test
+[ "\n<p>bar\n</p>" ] [ "\nbar\n" convert-farkup ] unit-test
 
-[ "<p>foo</p>\n<p>bar</p>" ] [ "foo\n\n\nbar" parse-farkup ] unit-test
+[ "<p>foo</p>\n<p>bar</p>" ] [ "foo\n\n\nbar" convert-farkup ] unit-test
 
-[ "" ] [ "" parse-farkup ] unit-test
+[ "" ] [ "" convert-farkup ] unit-test
 
 [ "<p>|a</p>" ]
-[ "|a" parse-farkup ] unit-test
+[ "|a" convert-farkup ] unit-test
 
 [ "<p>|a|</p>" ]
-[ "|a|" parse-farkup ] unit-test
+[ "|a|" convert-farkup ] unit-test
 
 [ "<table><tr><td>a</td><td>b</td></tr></table>" ]
-[ "a|b" parse-farkup ] unit-test
+[ "a|b" convert-farkup ] unit-test
 
 [ "<table><tr><td>a</td><td>b</td></tr></table>\n<table><tr><td>c</td><td>d</td></tr></table>" ]
-[ "a|b\nc|d" parse-farkup ] unit-test
+[ "a|b\nc|d" convert-farkup ] unit-test
 
 [ "<table><tr><td>a</td><td>b</td></tr></table>\n<table><tr><td>c</td><td>d</td></tr></table>\n" ]
-[ "a|b\nc|d\n" parse-farkup ] unit-test
+[ "a|b\nc|d\n" convert-farkup ] unit-test
 
 [ "<p><strong>foo</strong>\n</p><h1>aheading</h1>\n<p>adfasd</p>" ]
-[ "*foo*\n=aheading=\nadfasd" parse-farkup ] unit-test
+[ "*foo*\n=aheading=\nadfasd" convert-farkup ] unit-test

extra/farkup/farkup.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io kernel memoize namespaces peg
+USING: arrays io kernel memoize namespaces peg sequences strings
-peg.ebnf sequences strings html.elements xml.entities
+html.elements xml.entities xmode.code2html splitting
-xmode.code2html splitting io.streams.string html peg.parsers
+io.streams.string html peg.parsers html.elements sequences.deep
-html.elements sequences.deep unicode.categories ;
+unicode.categories ;
-USE: tools.walker
 IN: farkup
 
 : delimiters ( -- string )
@@ -118,28 +117,13 @@ MEMO: paragraph ( -- parser )
         [ "<p>" swap "</p>" 3array ] unless
     ] action ;
 
-MEMO: farkup ( -- parser )
+PEG: parse-farkup ( -- parser )
     [
         list , table , h1 , h2 , h3 , h4 , code , paragraph , 2nl , nl ,
     ] choice* repeat0 "\n" token optional 2seq ;
 
-: farkup. ( parse-result  -- )
+: write-farkup ( parse-result  -- )
-    parse-result-ast
     [ dup string? [ write ] [ drop ] if ] deep-each ;
 
-: parse-farkup ( string -- string' )
+: convert-farkup ( string -- string' )
-    farkup parse [ farkup. ] with-string-writer ;
+    parse-farkup [ write-farkup ] with-string-writer ;
-
-! MEMO: table-column ( -- parser )
-    ! text [ "td" surround-with-foo ] action ;
-! 
-! MEMO: table-row ( -- parser )
-    ! [
-        ! "|" token hide ,
-        ! table-column "|" token hide list-of ,
-        ! "|" token "\n" token 2array choice hide ,
-    ! ] seq* [ "tr" surround-with-foo ] action ;
-! 
-! MEMO: table ( -- parser )
-    ! table-row repeat1
-    ! [ "table" surround-with-foo ] action ;

extra/io/unix/launcher/parser/parser.factor

@@ -1,47 +1,34 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
+USING: peg peg.parsers kernel sequences strings words
+memoize ;
 IN: io.unix.launcher.parser
-USING: peg peg.parsers kernel sequences strings qualified
-words ;
-QUALIFIED: compiler.units
 
 ! Our command line parser. Supported syntax:
 ! foo bar baz -- simple tokens
 ! foo\ bar -- escaping the space
 ! 'foo bar' -- quotation
 ! "foo bar" -- quotation
-: 'escaped-char'
+MEMO: 'escaped-char'
     "\\" token [ drop t ] satisfy 2seq [ second ] action ;
 
-: 'quoted-char' ( delimiter -- parser' )
+MEMO: 'quoted-char' ( delimiter -- parser' )
     'escaped-char'
     swap [ member? not ] curry satisfy
     2choice ; inline
 
-: 'quoted' ( delimiter -- parser )
+MEMO: 'quoted' ( delimiter -- parser )
     dup 'quoted-char' repeat0 swap dup surrounded-by ;
 
-: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ;
+MEMO: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ;
 
-: 'argument' ( -- parser )
+MEMO: 'argument' ( -- parser )
     "\"" 'quoted'
     "'" 'quoted'
     'unquoted' 3choice
     [ >string ] action ;
 
-: 'arguments' ( -- parser )
+PEG: tokenize-command ( command -- ast/f )
     'argument' " " token repeat1 list-of
     " " token repeat0 swap over pack
     just ;
-
-DEFER: argument-parser
-
-[
-    \ argument-parser
-    'arguments' compile
-    define
-] compiler.units:with-compilation-unit
-
-: tokenize-command ( command -- arguments )
-    argument-parser
-    dup [ parse-result-ast ] [ "Parse failed" throw ] if ;

extra/peg/parsers/parsers.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings namespaces math assocs shuffle 
      vectors arrays combinators.lib memoize math.parser match
-     unicode.categories sequences.deep peg ;
+     unicode.categories sequences.deep peg peg.private ;
 IN: peg.parsers
 
 TUPLE: just-parser p1 ;
@@ -16,7 +16,7 @@ TUPLE: just-parser p1 ;
 
 
 M: just-parser compile ( parser -- quot )
-  just-parser-p1 compile just-pattern swap append ;
+  just-parser-p1 compile just-pattern append ;
 
 MEMO: just ( parser -- parser )
   just-parser construct-boa init-parser ;

extra/peg/peg.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings namespaces math assocs shuffle 
        vectors arrays combinators.lib memoize math.parser match
-       unicode.categories sequences.lib ;
+       unicode.categories sequences.lib compiler.units parser
+       words ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;
@@ -359,3 +360,12 @@ MEMO: hide ( parser -- parser )
 
 MEMO: delay ( parser -- parser )
   delay-parser construct-boa init-parser ;
+
+: PEG:
+  (:) [
+    [
+        call compile
+        [ dup [ parse-result-ast ] [ "Parse failed" throw ] if ]
+        append define
+    ] with-compilation-unit
+  ] 2curry over push-all ; parsing