io.launcher: cleanup public interface, make some things private or in…

…ternal.
factor · Dec 30, 2014 · 83f7b31 · 83f7b31
1 parent e68c0ae
commit 83f7b31
Show file tree

Hide file tree

Showing 7 changed files with 93 additions and 76 deletions.
diff --git a/basis/io/launcher/launcher-docs.factor b/basis/io/launcher/launcher-docs.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: calendar help.markup help.syntax io io.files kernel literals math
-quotations sequences ;
+USING: assocs calendar help.markup help.syntax io io.files
+io.launcher.private kernel literals quotations sequences ;
 IN: io.launcher
 
 ARTICLE: "io.launcher.command" "Specifying a command"
@@ -93,21 +93,21 @@ ARTICLE: "io.launcher.timeouts" "Process run-time timeouts"
 "The " { $snippet "timeout" } " slot of a " { $link process } " can be set to a " { $link duration } " specifying a maximum running time for the process. If " { $link wait-for-process } " is called and the process does not exit before the duration expires, it will be killed." ;
 
 HELP: get-environment
-{ $values { "process" process } { "env" "an association" } }
+{ $values { "process" process } { "env" assoc } }
 { $description "Combines the current environment with the value of the " { $snippet "environment" } " slot of the " { $link process } " using the " { $snippet "environment-mode" } " slot." } ;
 
-HELP: current-process-handle
+HELP: (current-process)
 { $values { "handle" "a process handle" } }
 { $description "Returns the handle of the current process." }
 { $examples
   { $example
     "USING: io.launcher math prettyprint ;"
-    "current-process-handle number? ."
+    "(current-process) number? ."
     "t"
   }
 } ;
 
-HELP: run-process*
+HELP: (run-process)
 { $values { "process" process } { "handle" "a process handle" } }
 { $contract "Launches a process." }
 { $notes "User code should call " { $link run-process } " instead." } ;
@@ -176,7 +176,7 @@ HELP: kill-process
   }
 } ;
 
-HELP: kill-process*
+HELP: (kill-process)
 { $values { "process" "process" } }
 { $contract "Kills a running process." }
 { $notes "User code should call " { $link kill-process } " instead." } ;

diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor
@@ -1,11 +1,12 @@
 ! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel namespaces strings hashtables sequences
-assocs combinators vocabs init threads continuations math
-accessors concurrency.flags destructors environment fry io
-io.encodings.ascii io.backend io.timeouts io.pipes
-io.pipes.private io.encodings io.encodings.utf8
-io.streams.duplex io.ports debugger prettyprint summary calendar ;
+
+USING: accessors assocs calendar combinators concurrency.flags
+debugger destructors environment fry init io io.backend
+io.encodings io.encodings.utf8 io.pipes io.pipes.private
+io.ports io.streams.duplex io.timeouts kernel namespaces
+prettyprint sequences strings system threads vocabs ;
+
 IN: io.launcher
 
 TUPLE: process < identity-tuple
@@ -35,7 +36,7 @@ SYMBOL: +stdout+
 
 TUPLE: appender path ;
 
-: <appender> ( path -- appender ) appender boa ;
+C: <appender> appender
 
 SYMBOL: +prepend-environment+
 SYMBOL: +replace-environment+
@@ -54,9 +55,9 @@ SYMBOL: +new-session+
 
 : <process> ( -- process )
     process new
-    H{ } clone >>environment
-    +append-environment+ >>environment-mode
-    +same-group+ >>group ;
+        H{ } clone >>environment
+        +append-environment+ >>environment-mode
+        +same-group+ >>group ;
 
 : process-started? ( process -- ? )
     [ handle>> ] [ status>> ] bi or ;
@@ -67,14 +68,16 @@ SYMBOL: +new-session+
 ! Non-blocking process exit notification facility
 SYMBOL: processes
 
-HOOK: wait-for-processes io-backend ( -- ? )
+HOOK: (wait-for-processes) io-backend ( -- ? )
+
+<PRIVATE
 
 SYMBOL: wait-flag
 
 : wait-loop ( -- )
     processes get assoc-empty?
     [ wait-flag get-global lower-flag ]
-    [ wait-for-processes [ 100 milliseconds sleep ] when ] if ;
+    [ (wait-for-processes) [ 100 milliseconds sleep ] when ] if ;
 
 : start-wait-thread ( -- )
     <flag> wait-flag set-global
@@ -95,15 +98,13 @@ SYMBOL: wait-flag
     swap environment-mode>> +replace-environment+ eq? or ;
 
 : get-environment ( process -- env )
-    dup environment>>
-    swap environment-mode>> {
+    [ environment>> ] [ environment-mode>> ] bi {
         { +prepend-environment+ [ os-envs assoc-union ] }
         { +append-environment+ [ os-envs swap assoc-union ] }
         { +replace-environment+ [ ] }
     } case ;
 
-: string-array? ( obj -- ? )
-    dup sequence? [ [ string? ] all? ] [ drop f ] if ;
+PRIVATE>
 
 GENERIC: >process ( obj -- process )
 
@@ -115,16 +116,12 @@ M: process-already-started error.
     process>> . ;
 
 M: process >process
-    dup process-started? [
-        process-already-started
-    ] when
+    dup process-started? [ process-already-started ] when
     clone ;
 
 M: object >process <process> swap >>command ;
 
-HOOK: current-process-handle io-backend ( -- handle )
-
-HOOK: run-process* io-backend ( process -- handle )
+HOOK: (current-process) io-backend ( -- handle )
 
 ERROR: process-was-killed process ;
 
@@ -143,8 +140,10 @@ M: process-was-killed error.
 : wait-for-process ( process -- status )
     [ (wait-for-process) ] with-timeout ;
 
+HOOK: (run-process) io-backend ( process -- handle )
+
 : run-detached ( desc -- process )
-    >process [ dup run-process* process-started ] keep ;
+    >process [ dup (run-process) process-started ] keep ;
 
 : run-process ( desc -- process )
     run-detached
@@ -164,12 +163,12 @@ M: process-failed error.
 : try-process ( desc -- )
     run-process wait-for-success ;
 
-HOOK: kill-process* io-backend ( process -- )
+HOOK: (kill-process) io-backend ( process -- )
 
 : kill-process ( process -- )
     t >>killed
     [ pipe>> [ dispose ] when* ]
-    [ dup handle>> [ kill-process* ] [ drop ] if ] bi ;
+    [ dup handle>> [ (kill-process) ] [ drop ] if ] bi ;
 
 M: process timeout timeout>> ;
 
@@ -178,19 +177,23 @@ M: process set-timeout timeout<< ;
 M: process cancel-operation kill-process ;
 
 M: object run-pipeline-element
-    [ >process swap >>stdout swap >>stdin run-detached ]
-    [ [ drop [ [ &dispose drop ] when* ] bi@ ] with-destructors ]
-    3bi
-    wait-for-process ;
+    [
+        >process
+            swap >>stdout
+            swap >>stdin
+        run-detached
+    ] [
+        [
+            drop [ [ &dispose drop ] when* ] bi@
+        ] with-destructors
+    ] 3bi wait-for-process ;
 
 <PRIVATE
 
 : <process-with-pipe> ( desc -- process pipe )
     >process (pipe) |dispose [ >>pipe ] keep ;
 
-PRIVATE>
-
-: <process-reader*> ( desc encoding -- stream process )
+: (process-reader) ( desc encoding -- stream process )
     [
         [
             <process-with-pipe> {
@@ -202,15 +205,19 @@ PRIVATE>
         ] dip <decoder> swap
     ] with-destructors ;
 
+PRIVATE>
+
 : <process-reader> ( desc encoding -- stream )
-    <process-reader*> drop ; inline
+    (process-reader) drop ; inline
 
 : with-process-reader ( desc encoding quot -- )
-    [ <process-reader*> ] dip
-    swap [ with-input-stream ] dip
+    [ (process-reader) ] dip
+    '[ _ with-input-stream ] dip
     wait-for-success ; inline
 
-: <process-writer*> ( desc encoding -- stream process )
+<PRIVATE
+
+: (process-writer) ( desc encoding -- stream process )
     [
         [
             <process-with-pipe> {
@@ -222,15 +229,19 @@ PRIVATE>
         ] dip <encoder> swap
     ] with-destructors ;
 
+PRIVATE>
+
 : <process-writer> ( desc encoding -- stream )
-    <process-writer*> drop ; inline
+    (process-writer) drop ; inline
 
 : with-process-writer ( desc encoding quot -- )
-    [ <process-writer*> ] dip
-    swap [ with-output-stream ] dip
+    [ (process-writer) ] dip
+    '[ _ with-output-stream ] dip
     wait-for-success ; inline
 
-: <process-stream*> ( desc encoding -- stream process )
+<PRIVATE
+
+: (process-stream) ( desc encoding -- stream process )
     [
         [
             (pipe) |dispose
@@ -247,12 +258,14 @@ PRIVATE>
         ] dip <encoder-duplex> swap
     ] with-destructors ;
 
+PRIVATE>
+
 : <process-stream> ( desc encoding -- stream )
-    <process-stream*> drop ; inline
+    (process-stream) drop ; inline
 
 : with-process-stream ( desc encoding quot -- )
-    [ <process-stream*> ] dip
-    swap [ with-stream ] dip
+    [ (process-stream) ] dip
+    '[ _ with-stream ] dip
     wait-for-success ; inline
 
 ERROR: output-process-error { output string } { process process } ;
@@ -266,16 +279,20 @@ M: output-process-error error.
     >process
     +stdout+ >>stderr
     [ +closed+ or ] change-stdin
-    utf8 <process-reader*>
+    utf8 (process-reader)
     [ [ stream-contents ] [ dup (wait-for-process) ] bi* ] with-timeout
     0 = [ 2drop ] [ output-process-error ] if ;
 
+<PRIVATE
+
 : notify-exit ( process status -- )
     >>status
     [ processes get delete-at* drop [ resume ] each ] keep
     f >>handle
     drop ;
 
+PRIVATE>
+
 {
     { [ os unix? ] [ "io.launcher.unix" require ] }
     { [ os windows? ] [ "io.launcher.windows" require ] }

diff --git a/basis/io/launcher/unix/unix-tests.factor b/basis/io/launcher/unix/unix-tests.factor
@@ -161,7 +161,7 @@ IN: io.launcher.unix.tests
             [ p fulfill ] [ wait-for-process s fulfill ] bi
         ] in-thread
 
-        p 1 seconds ?promise-timeout kill-process*
+        p 1 seconds ?promise-timeout (kill-process)
         s 3 seconds ?promise-timeout 0 =
     ]
 ] unit-test
@@ -173,7 +173,7 @@ IN: io.launcher.unix.tests
     "SIGPIPE" signal-names index 1 +
     kill io-error ;
 
-[ ] [ current-process-handle send-sigpipe ] unit-test
+[ ] [ (current-process) send-sigpipe ] unit-test
 
 ! Spawn a process
 [ T{ signal f 13 } ] [

diff --git a/basis/io/launcher/unix/unix.factor b/basis/io/launcher/unix/unix.factor
@@ -1,11 +1,10 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.data arrays assocs
-combinators continuations environment io io.backend
-io.backend.unix io.files io.files.private io.files.unix
-io.launcher io.pathnames io.ports kernel libc math
-namespaces sequences strings system threads unix unix.process
-unix.ffi simple-tokenizer ;
+USING: accessors alien.c-types alien.data assocs combinators
+continuations environment io.backend io.backend.unix
+io.files.private io.files.unix io.launcher io.launcher.private
+io.pathnames io.ports kernel libc math namespaces sequences
+simple-tokenizer strings system unix unix.ffi unix.process ;
 IN: io.launcher.unix
 
 : get-arguments ( process -- seq )
@@ -90,12 +89,12 @@ IN: io.launcher.unix
     255 _exit
     f throw ;
 
-M: unix current-process-handle ( -- handle ) getpid ;
+M: unix (current-process) ( -- handle ) getpid ;
 
-M: unix run-process* ( process -- pid )
+M: unix (run-process) ( process -- pid )
     [ spawn-process ] curry [ ] with-fork ;
 
-M: unix kill-process* ( process -- )
+M: unix (kill-process) ( process -- )
     [ handle>> SIGTERM ] [ group>> ] bi {
         { +same-group+ [ kill ] }
         { +new-group+ [ killpg ] }
@@ -111,7 +110,7 @@ TUPLE: signal n ;
 : code>status ( code -- obj )
     dup WIFSIGNALED [ WTERMSIG signal boa ] [ WEXITSTATUS ] if ;
 
-M: unix wait-for-processes ( -- ? )
+M: unix (wait-for-processes) ( -- ? )
     { int } [ -1 swap WNOHANG waitpid ] with-out-parameters
     swap dup 0 <= [
         2drop t