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.
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* ;

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
"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'

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

View File

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