Unix <process-stream> now compiles

db4
Slava Pestov 2008-03-03 16:45:18 -06:00
parent 2c23357f25
commit 05a02ade7a
6 changed files with 101 additions and 48 deletions

View File

@ -2,41 +2,13 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io io.backend io.launcher io.unix.backend io.unix.files USING: io io.backend io.launcher io.unix.backend io.unix.files
io.nonblocking sequences kernel namespaces math system io.nonblocking sequences kernel namespaces math system
alien.c-types debugger continuations arrays assocs alien.c-types debugger continuations arrays assocs combinators
combinators unix.process parser-combinators memoize unix.process strings threads unix ;
promises strings threads unix ;
IN: io.unix.launcher IN: io.unix.launcher
! Search unix first ! Search unix first
USE: unix 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 ) : get-arguments ( -- seq )
+command+ get [ tokenize-command ] [ +arguments+ get ] if* ; +command+ get [ tokenize-command ] [ +arguments+ get ] if* ;

View File

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

View File

@ -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 ;

4
extra/peg/parsers/parsers-docs.factor Normal file → Executable file
View File

@ -112,7 +112,7 @@ HELP: pack
} { $description } { $description
"Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden." "Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
} { $examples } { $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 } ; } { $see-also surrounded-by } ;
HELP: surrounded-by HELP: surrounded-by
@ -124,7 +124,7 @@ HELP: surrounded-by
} { $description } { $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." "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 } { $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 } ; } { $see-also pack } ;
HELP: 'digit' HELP: 'digit'

18
extra/peg/parsers/parsers.factor Normal file → Executable file
View File

@ -5,6 +5,22 @@ USING: kernel sequences strings namespaces math assocs shuffle
unicode.categories sequences.deep peg ; unicode.categories sequences.deep peg ;
IN: peg.parsers 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 <PRIVATE
MEMO: (list-of) ( items separator repeat1? -- parser ) MEMO: (list-of) ( items separator repeat1? -- parser )
>r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq >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 ; [ flatten-vectors ] action ;
MEMO: pack ( begin body end -- parser ) 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' ) MEMO: surrounded-by ( parser begin end -- parser' )
[ token ] 2apply swapd pack ; [ token ] 2apply swapd pack ;

View File

@ -292,18 +292,6 @@ M: delay-parser compile ( parser -- quot )
delay-parser-quot % \ compile , \ call , delay-parser-quot % \ compile , \ call ,
] [ ] make ; ] [ ] 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> PRIVATE>
MEMO: token ( string -- parser ) MEMO: token ( string -- parser )
@ -371,6 +359,3 @@ MEMO: hide ( parser -- parser )
MEMO: delay ( parser -- parser ) MEMO: delay ( parser -- parser )
delay-parser construct-boa init-parser ; delay-parser construct-boa init-parser ;
MEMO: just ( parser -- parser )
just-parser construct-boa init-parser ;