steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-04-19 04:51:56 -05:00
parent 6dedc433d5 d2c6503fe0
commit 942313afa3
6 changed files with 99 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
extra/editors/vim/vim.factor
View File

@ -1,5 +1,5 @@
USING: definitions io io.launcher kernel math math.parser
namespaces parser prettyprint sequences editors ;
namespaces parser prettyprint sequences editors accessors ;
IN: editors.vim
SYMBOL: vim-path
@ -17,8 +17,9 @@ M: vim vim-command ( file line -- array )
: vim-location ( file line -- )
vim-command
vim-detach get-global
[ run-detached ] [ run-process ] if drop ;
<process> swap >>command
vim-detach get-global [ t >>detached ] when
try-process ;
"vim" vim-path set-global
[ vim-location ] edit-hook set-global

3
extra/io/launcher/launcher-docs.factor
View File

@ -113,6 +113,8 @@ HELP: try-process
{ $values { "desc" "a launch descriptor" } }
{ $description "Launches a process and waits for it to complete. If it exits with a non-zero status code, throws a " { $link process-failed } " error." } ;
{ run-process try-process run-detached } related-words
HELP: kill-process
{ $values { "process" process } }
{ $description "Kills a running process. Does nothing if the process has already exited." } ;
@ -171,6 +173,7 @@ ARTICLE: "io.launcher.launch" "Launching processes"
"Launching processes:"
{ $subsection run-process }
{ $subsection try-process }
{ $subsection run-detached }
"Redirecting standard input and output to a pipe:"
{ $subsection <process-stream> }
{ $subsection with-process-stream } ;

5
extra/io/launcher/launcher.factor
View File

@ -127,10 +127,7 @@ HOOK: run-process* io-backend ( process -- handle )
run-detached
dup detached>> [ dup wait-for-process drop ] unless ;
TUPLE: process-failed code ;
: process-failed ( code -- * )
\ process-failed boa throw ;
ERROR: process-failed code ;
: try-process ( desc -- )
run-process wait-for-process dup zero?

17
extra/newfx/newfx.factor
View File

@ -155,6 +155,23 @@ METHOD: as-mutate { object object assoc } set-at ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: prefix-on ( elt seq -- seq ) swap prefix ;
: suffix-on ( elt seq -- seq ) swap suffix ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: 1st 0 at ;
: 2nd 1 at ;
: 3rd 2 at ;
: 4th 3 at ;
: 5th 4 at ;
: 6th 5 at ;
: 7th 6 at ;
: 8th 7 at ;
: 9th 8 at ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! A note about the 'mutate' qualifier. Other words also technically mutate
! their primary object. However, the 'mutate' qualifier is supposed to
! indicate that this is the main objective of the word, as a side effect.

78
extra/shell/parser/parser.factor
View File

@ -1,27 +1,43 @@
USING: kernel arrays strings sequences sequences.deep peg peg.ebnf ;
USING: kernel arrays strings sequences sequences.deep accessors peg peg.ebnf
newfx ;
IN: shell.parser
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: incantation command stdin stdout background ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: basic-expr command stdin stdout background ;
TUPLE: pipeline-expr commands stdin stdout background ;
TUPLE: single-quoted-expr expr ;
TUPLE: double-quoted-expr expr ;
TUPLE: back-quoted-expr expr ;
TUPLE: glob-expr expr ;
TUPLE: variable-expr expr ;
TUPLE: variable-expr expr ;
TUPLE: factor-expr expr ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: <single-quoted-expr> single-quoted-expr boa ;
: <double-quoted-expr> double-quoted-expr boa ;
: <back-quoted-expr> back-quoted-expr boa ;
: <glob-expr> glob-expr boa ;
: ast>basic-expr ( ast -- obj ) first4 basic-expr boa ;
: ast>pipeline-expr ( ast -- obj )
pipeline-expr new
over [ 1st ] [ 4th [ 1st ] map ] [ 5th ] tri suffix prefix-on >>commands
over 2nd >>stdin
over 5th >>stdout
swap 6th >>background ;
: ast>single-quoted-expr ( ast -- obj )
2nd >string single-quoted-expr boa ;
: ast>double-quoted-expr ( ast -- obj )
2nd >string double-quoted-expr boa ;
: ast>back-quoted-expr ( ast -- obj )
2nd >string back-quoted-expr boa ;
: ast>glob-expr ( ast -- obj ) flatten concat glob-expr boa ;
: ast>variable-expr ( ast -- obj ) 2nd variable-expr boa ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -33,45 +49,43 @@ tab = "\t"
white = (space | tab)
whitespace = (white)* => [[ drop ignore ]]
_ = (white)* => [[ drop ignore ]]
squote = "'"
sq = "'"
dq = '"'
bq = "`"
single-quoted = squote (!(squote) .)* squote => [[ second >string <single-quoted-expr> ]]
single-quoted = sq (!(sq) .)* sq => [[ ast>single-quoted-expr ]]
double-quoted = dq (!(dq) .)* dq => [[ ast>double-quoted-expr ]]
back-quoted = bq (!(bq) .)* bq => [[ ast>back-quoted-expr ]]
dquote = '"'
double-quoted = dquote (!(dquote) .)* dquote => [[ second >string <double-quoted-expr> ]]
bquote = "`"
back-quoted = bquote (!(bquote) .)* bquote => [[ second >string <back-quoted-expr> ]]
variable = "$" other => [[ second variable-expr boa ]]
variable = "$" other => [[ ast>variable-expr ]]
glob-char = ("*" | "?")
non-glob-char = !(glob-char | white) .
glob-beginning-string = (non-glob-char)* [[ >string ]]
glob-beginning-string = (non-glob-char)* => [[ >string ]]
glob-rest-string = (non-glob-char)+ [[ >string ]]
glob-rest-string = (non-glob-char)+ => [[ >string ]]
glob = glob-beginning-string glob-char (glob-rest-string | glob-char)* => [[ flatten concat <glob-expr> ]]
glob = glob-beginning-string glob-char (glob-rest-string | glob-char)* => [[ ast>glob-expr ]]
other = (!(white | "&" | ">" | ">>" | "<") .)+ => [[ >string ]]
other = (!(white | "&" | ">" | ">>" | "<" | "|") .)+ => [[ >string ]]
element = (single-quoted | double-quoted | back-quoted | variable | glob | other)
to-file = ">" whitespace other => [[ second ]]
command = (element _)+
in-file = "<" whitespace other => [[ second ]]
to-file = ">" _ other => [[ second ]]
in-file = "<" _ other => [[ second ]]
ap-file = ">>" _ other => [[ second ]]
ap-file = ">>" whitespace other => [[ second ]]
basic = _ command _ (in-file)? _ (to-file | ap-file)? _ ("&")? => [[ ast>basic-expr ]]
redirection = (in-file)? whitespace (to-file | ap-file)?
pipeline = _ command _ (in-file)? _ "|" _ (command _ "|" _)* command _ (to-file | ap-file)? _ ("&")? => [[ ast>pipeline-expr ]]
line = (element whitespace)+ (in-file)? whitespace (to-file | ap-file)? whitespace ("&")? => [[ first4 incantation boa ]]
submission = (pipeline | basic)
;EBNF

34
extra/shell/shell.factor
View File

@ -49,22 +49,44 @@ METHOD: expand { object } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run-incantation ( incantation -- )
: run-sword ( basic-expr -- ) command>> unclip "shell" lookup execute ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run-foreground ( process -- )
[ try-process ] [ print-error drop ] recover ;
: run-background ( process -- ) run-detached drop ;
: run-basic-expr ( basic-expr -- )
<process>
over command>> expansion >>command
over stdin>> >>stdin
over stdout>> >>stdout
swap background>>
[ run-detached drop ]
[ [ try-process ] [ print-error drop ] recover ]
[ run-background ]
[ run-foreground ]
if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: chant ( incantation -- )
: basic-chant ( basic-expr -- )
dup command>> first swords member-of?
[ command>> unclip "shell" lookup execute ]
[ run-incantation ]
[ run-sword ]
[ run-basic-expr ]
if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: pipeline-chant ( pipeline-chant -- )
drop "ix: pipelines not supported" print ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: chant ( obj -- )
dup basic-expr?
[ basic-chant ]
[ pipeline-chant ]
if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!