Unix <process-stream> now compiles

extra/io/unix/launcher/launcher.factor

@@ -2,41 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.backend io.launcher io.unix.backend io.unix.files
 io.nonblocking sequences kernel namespaces math system
- alien.c-types debugger continuations arrays assocs 
-combinators unix.process parser-combinators memoize 
-promises strings threads unix ;
+alien.c-types debugger continuations arrays assocs combinators
+unix.process strings threads unix ;
 IN: io.unix.launcher
 
 ! Search unix first
 USE: unix
 
-! Our command line parser. Supported syntax:
-! foo bar baz -- simple tokens
-! foo\ bar -- escaping the space
-! 'foo bar' -- quotation
-! "foo bar" -- quotation
-LAZY: 'escaped-char' "\\" token any-char-parser &> ;
-
-LAZY: 'quoted-char' ( delimiter -- parser' )
-    'escaped-char'
-    swap [ member? not ] curry satisfy
-    <|> ; inline
-
-LAZY: 'quoted' ( delimiter -- parser )
-    dup 'quoted-char' <!*> swap dup surrounded-by ;
-
-LAZY: 'unquoted' ( -- parser ) " '\"" 'quoted-char' <!+> ;
-
-LAZY: 'argument' ( -- parser )
-    "\"" 'quoted' "'" 'quoted' 'unquoted' <|> <|>
-    [ >string ] <@ ;
-
-MEMO: 'arguments' ( -- parser )
-    'argument' " " token <!+> nonempty-list-of ;
-
-: tokenize-command ( command -- arguments )
-    'arguments' just parse-1 ;
-
 : get-arguments ( -- seq )
     +command+ get [ tokenize-command ] [ +arguments+ get ] if* ;
 

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

@@ -0,0 +1,33 @@
+IN: io.unix.launcher.parser.tests
+USING: io.unix.launcher.parser tools.test ;
+
+[ "" tokenize-command ] must-fail
+[ "   " tokenize-command ] must-fail
+[ V{ "a" } ] [ "a" tokenize-command ] unit-test
+[ V{ "abc" } ] [ "abc" tokenize-command ] unit-test
+[ V{ "abc" } ] [ "abc   " tokenize-command ] unit-test
+[ V{ "abc" } ] [ "   abc" tokenize-command ] unit-test
+[ V{ "abc" "def" } ] [ "abc def" tokenize-command ] unit-test
+[ V{ "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test
+[ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test
+[ V{ "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test
+[ V{ "abc\\ def" } ] [ "  'abc\\\\ def'" tokenize-command ] unit-test
+[ V{ "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test
+[ V{ "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test
+[ "'abc def' \"hey" tokenize-command ] must-fail
+[ "'abc def" tokenize-command ] must-fail
+[ V{ "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\"  " tokenize-command ] unit-test
+
+[
+    V{
+        "Hello world.app/Contents/MacOS/hello-ui"
+        "-i=boot.macosx-ppc.image"
+        "-include= math compiler ui"
+        "-deploy-vocab=hello-ui"
+        "-output-image=Hello world.app/Contents/Resources/hello-ui.image"
+        "-no-stack-traces"
+        "-no-user-init"
+    }
+] [
+    "\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize-command
+] unit-test

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

@@ -0,0 +1,47 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+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'
+    "\\" token [ drop t ] satisfy 2seq [ second ] action ;
+
+: 'quoted-char' ( delimiter -- parser' )
+    'escaped-char'
+    swap [ member? not ] curry satisfy
+    2choice ; inline
+
+: 'quoted' ( delimiter -- parser )
+    dup 'quoted-char' repeat0 swap dup surrounded-by ;
+
+: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ;
+
+: 'argument' ( -- parser )
+    "\"" 'quoted'
+    "'" 'quoted'
+    'unquoted' 3choice
+    [ >string ] action ;
+
+: 'arguments' ( -- parser )
+    '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-docs.factor

@@ -112,7 +112,7 @@ HELP: pack
 } { $description
     "Returns a parser that parses the begin, body, and end parsers in order.  The begin and end parsers are hidden."
 } { $examples
-    { $example "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "V{ 123 }" }
+    { $example "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "123" }
 } { $see-also surrounded-by } ;
 
 HELP: surrounded-by
@@ -124,7 +124,7 @@ HELP: surrounded-by
 } { $description
     "Calls token on begin and end to make them into string parsers.  Returns a parser that parses the begin, body, and end parsers in order.  The begin and end parsers are hidden."
 } { $examples
-    { $example "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "V{ 123 }" }
+    { $example "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "123" }
 } { $see-also pack } ;
 
 HELP: 'digit'

extra/peg/parsers/parsers.factor

@@ -5,6 +5,22 @@ USING: kernel sequences strings namespaces math assocs shuffle
      unicode.categories sequences.deep peg ;
 IN: peg.parsers
 
+TUPLE: just-parser p1 ;
+
+: just-pattern
+  [
+    dup [
+      dup parse-result-remaining empty? [ drop f ] unless
+    ] when
+  ] ;
+
+
+M: just-parser compile ( parser -- quot )
+  just-parser-p1 compile just-pattern swap append ;
+
+MEMO: just ( parser -- parser )
+  just-parser construct-boa init-parser ;
+
 <PRIVATE
 MEMO: (list-of) ( items separator repeat1? -- parser )
   >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
@@ -48,7 +64,7 @@ MEMO: from-m-to-n ( parser m n -- parser' )
   [ flatten-vectors ] action ;
 
 MEMO: pack ( begin body end -- parser )
-  >r >r hide r> r> hide 3seq ;
+  >r >r hide r> r> hide 3seq [ first ] action ;
 
 MEMO: surrounded-by ( parser begin end -- parser' )
   [ token ] 2apply swapd pack ;

extra/peg/peg.factor

@@ -292,18 +292,6 @@ M: delay-parser compile ( parser -- quot )
     delay-parser-quot % \ compile , \ call ,
   ] [ ] make ;
 
-TUPLE: just-parser p1 ;
-
-: just-pattern
-    [
-        ?quot call dup
-        [ parse-result-remaining empty? [ drop f ] unless ] [ f ] if*
-    ] ;
-
-
-M: just-parser compile ( parser -- quot )
-  just-parser-p1 compile \ ?quot just-pattern match-replace ;
-
 PRIVATE>
 
 MEMO: token ( string -- parser )
@@ -371,6 +359,3 @@ MEMO: hide ( parser -- parser )
 
 MEMO: delay ( parser -- parser )
   delay-parser construct-boa init-parser ;
-
-MEMO: just ( parser -- parser )
-  just-parser construct-boa init-parser ;