Unix <process-stream> now compiles
parent
2c23357f25
commit
05a02ade7a
|
@ -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* ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
|
@ -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 ;
|
|
@ -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'
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
|
||||||
|
|
Loading…
Reference in New Issue