diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 0393b13c7f..444a662c32 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/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* ; diff --git a/extra/io/unix/launcher/parser/parser-tests.factor b/extra/io/unix/launcher/parser/parser-tests.factor new file mode 100755 index 0000000000..63aadcabbe --- /dev/null +++ b/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 diff --git a/extra/io/unix/launcher/parser/parser.factor b/extra/io/unix/launcher/parser/parser.factor new file mode 100755 index 0000000000..9be5a48d1d --- /dev/null +++ b/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 ; diff --git a/extra/peg/parsers/parsers-docs.factor b/extra/peg/parsers/parsers-docs.factor old mode 100644 new mode 100755 index 00d98acb71..437edc1007 --- a/extra/peg/parsers/parsers-docs.factor +++ b/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' diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor old mode 100644 new mode 100755 index 86a301bcbf..60002a450a --- a/extra/peg/parsers/parsers.factor +++ b/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 ; + 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 ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index a843c460a1..91877d680c 100755 --- a/extra/peg/peg.factor +++ b/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 ;