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

extra/editors/vim/vim.factor

@@ -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
+    <process> swap >>command
-    [ run-detached ] [ run-process ] if drop ;
+    vim-detach get-global [ t >>detached ] when
+    try-process ;
 
 "vim" vim-path set-global
 [ vim-location ] edit-hook set-global

extra/io/launcher/launcher-docs.factor

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

extra/io/launcher/launcher.factor

@@ -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 ;
+ERROR: process-failed code ;
-
-: process-failed ( code -- * )
-    \ process-failed boa throw ;
 
 : try-process ( desc -- )
     run-process wait-for-process dup zero?

extra/newfx/newfx.factor

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

extra/shell/parser/parser.factor

@@ -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: factor-expr        expr ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: <single-quoted-expr> single-quoted-expr boa ;
+: ast>basic-expr ( ast -- obj ) first4 basic-expr boa ;
-: <double-quoted-expr> double-quoted-expr boa ;
+
-: <back-quoted-expr>   back-quoted-expr boa ;
+: ast>pipeline-expr ( ast -- obj )
-: <glob-expr>          glob-expr boa ;
+  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        = '"'
+variable = "$" other => [[ ast>variable-expr ]]
-
-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 ]]
 
 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
 

extra/shell/shell.factor

@@ -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 ]
+    [ run-background ]
-    [ [ try-process ] [ print-error drop ] recover ]
+    [ run-foreground ]
   if ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: chant ( incantation -- )
+: basic-chant ( basic-expr -- )
   dup command>> first swords member-of?
-    [ command>> unclip "shell" lookup execute ]
+    [ run-sword ]
-    [ run-incantation ]
+    [ run-basic-expr ]
+  if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: pipeline-chant ( pipeline-chant -- )
+  drop "ix: pipelines not supported" print ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: chant ( obj -- )
+  dup basic-expr?
+    [ basic-chant    ]
+    [ pipeline-chant ]
   if ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!