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