Fix Windows monitors, implement new io.pipe protocol

extra/io/pipes/pipes-tests.factor

@@ -14,7 +14,7 @@ IN: io.pipes.tests
 [ { f } ] [ { [ f ] } run-pipeline ] unit-test
 [ { "Hello" } ] [
     "Hello" [
-        { [ input-stream [ utf8 <decoder> ] change readln ] } with-pipeline
+        { [ input-stream [ utf8 <decoder> ] change readln ] } run-pipeline
     ] with-string-reader
 ] unit-test
 

extra/io/windows/nt/launcher/launcher.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays continuations destructors io
-io.windows libc io.nonblocking windows.types
+io.windows libc io.nonblocking io.pipes windows.types
 math windows.kernel32 windows namespaces io.launcher kernel
 sequences windows.errors assocs splitting system strings
 io.windows.launcher io.windows.nt.pipes io.backend io.files
@@ -19,15 +19,25 @@ IN: io.windows.nt.launcher
         DuplicateHandle win32-error=0/f
     ] keep *void* ;
 
+! /dev/null simulation
+: null-input ( -- pipe )
+    (pipe) [ in>> handle>> ] [ out>> close-handle ] bi ;
+
+: null-output ( -- pipe )
+    (pipe) [ in>> close-handle ] [ out>> handle>> ] bi ;
+
+: null-pipe ( mode -- pipe )
+    {
+        { GENERIC_READ [ null-input ] }
+        { GENERIC_WRITE [ null-output ] }
+    } case ;
+
 ! The below code is based on the example given in
 ! http://msdn2.microsoft.com/en-us/library/ms682499.aspx
 
 : redirect-default ( default obj access-mode create-mode -- handle )
     3drop ;
 
-: redirect-inherit ( default obj access-mode create-mode -- handle )
-    4drop f ;
-
 : redirect-closed ( default obj access-mode create-mode -- handle )
     drop 2nip null-pipe ;
 
@@ -44,21 +54,25 @@ IN: io.windows.nt.launcher
 : set-inherit ( handle ? -- )
     >r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
 
-: redirect-stream ( default stream access-mode create-mode -- handle )
+: redirect-handle ( default handle access-mode create-mode -- handle )
     2drop nip
-    underlying-handle win32-file-handle
-    duplicate-handle dup t set-inherit ;
+    handle>> duplicate-handle dup t set-inherit ;
+
+: redirect-stream ( default stream access-mode create-mode -- handle )
+    >r >r underlying-handle r> r> redirect-handle ;
 
 : redirect ( default obj access-mode create-mode -- handle )
     {
         { [ pick not ] [ redirect-default ] }
         { [ pick +closed+ eq? ] [ redirect-closed ] }
         { [ pick string? ] [ redirect-file ] }
+        { [ pick appender? ] [ redirect-file ] }
+        { [ pick win32-file? ] [ redirect-handle ] }
         [ redirect-stream ]
     } cond ;
 
 : default-stdout ( args -- handle )
-    stdout-pipe>> dup [ pipe-out ] when ;
+    stdout-pipe>> dup [ out>> ] when ;
 
 : redirect-stdout ( process args -- handle )
     default-stdout
@@ -84,7 +98,7 @@ IN: io.windows.nt.launcher
     ] if ;
 
 : default-stdin ( args -- handle )
-    stdin-pipe>> dup [ pipe-in ] when ;
+    stdin-pipe>> dup [ in>> ] when ;
 
 : redirect-stdin ( process args -- handle )
     default-stdin
@@ -94,46 +108,8 @@ IN: io.windows.nt.launcher
     redirect
     STD_INPUT_HANDLE GetStdHandle or ;
 
-: add-pipe-dtors ( pipe -- )
-    dup
-    in>> close-later
-    out>> close-later ;
-
-: fill-stdout-pipe ( args -- args )
-    <unique-incoming-pipe>
-    dup add-pipe-dtors
-    dup pipe-in f set-inherit
-    >>stdout-pipe ;
-
-: fill-stdin-pipe ( args -- args )
-    <unique-outgoing-pipe>
-    dup add-pipe-dtors
-    dup pipe-out f set-inherit
-    >>stdin-pipe ;
-
 M: winnt fill-redirection ( process args -- )
     [ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput
     [ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError
     [ 2dup redirect-stdin  ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput
     2drop ;
-
-M: winnt (process-stream)
-    [
-        current-directory get (normalize-path) cd
-
-        dup make-CreateProcess-args
-
-        fill-stdout-pipe
-        fill-stdin-pipe
-
-        tuck fill-redirection
-
-        dup call-CreateProcess
-
-        dup stdin-pipe>> pipe-in CloseHandle drop
-        dup stdout-pipe>> pipe-out CloseHandle drop
-
-        dup lpProcessInformation>>
-        over stdout-pipe>> in>> f <win32-file>
-        rot stdin-pipe>> out>> f <win32-file>
-    ] with-destructors ;

extra/io/windows/nt/launcher/test/stderr.factor

@@ -2,4 +2,4 @@ USE: io
 USE: namespaces
 
 "output" write flush
-"error" stderr get stream-write stderr get stream-flush
+"error" error-stream get stream-write error-stream get stream-flush

extra/io/windows/nt/monitors/monitors.factor

@@ -3,9 +3,9 @@
 USING: alien alien.c-types libc destructors locals
 kernel math assocs namespaces continuations sequences hashtables
 sorting arrays combinators math.bitfields strings system
-accessors threads
-io.backend io.windows io.windows.nt.backend io.monitors
-io.nonblocking io.buffers io.files io.timeouts io
+accessors threads splitting
+io.backend io.windows io.windows.nt.backend io.windows.nt.files
+io.monitors io.nonblocking io.buffers io.files io.timeouts io
 windows windows.kernel32 windows.types ;
 IN: io.windows.nt.monitors
 
@@ -79,9 +79,12 @@ TUPLE: win32-monitor < monitor port ;
 : file-notify-records ( buffer -- seq )
     [ (file-notify-records) drop ] { } make ;
 
-: parse-notify-records ( monitor buffer -- )
-    file-notify-records
-    [ parse-notify-record rot queue-change ] with each ;
+:: parse-notify-records ( monitor buffer -- )
+    buffer file-notify-records [
+        parse-notify-record
+        [ monitor path>> prepend-path normalize-path ] dip
+        monitor queue-change
+    ] each ;
 
 : fill-queue ( monitor -- )
     dup port>> check-closed

extra/io/windows/nt/pipes/pipes.factor

@@ -1,16 +1,16 @@
 ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays destructors io io.windows libc
-windows.types math windows.kernel32 windows namespaces kernel
-sequences windows.errors assocs math.parser system random
-combinators accessors io.pipes ;
+windows.types math.bitfields windows.kernel32 windows namespaces
+kernel sequences windows.errors assocs math.parser system random
+combinators accessors io.pipes io.nonblocking ;
 IN: io.windows.nt.pipes
 
 ! This code is based on
 ! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
 
-: create-named-pipe ( name in-mode -- handle )
-    FILE_FLAG_OVERLAPPED bitor
+: create-named-pipe ( name -- handle )
+    { PIPE_ACCESS_INBOUND FILE_FLAG_OVERLAPPED } flags
     PIPE_TYPE_BYTE
     1
     4096
@@ -19,30 +19,20 @@ IN: io.windows.nt.pipes
     security-attributes-inherit
     CreateNamedPipe
     dup win32-error=0/f
-    dup add-completion ;
+    dup add-completion
+    f <win32-file> ;
 
-: open-other-end ( name out-mode -- handle )
-    FILE_SHARE_READ FILE_SHARE_WRITE bitor
+: open-other-end ( name -- handle )
+    GENERIC_WRITE
+    { FILE_SHARE_READ FILE_SHARE_WRITE } flags
     security-attributes-inherit
     OPEN_EXISTING
     FILE_FLAG_OVERLAPPED
     f
     CreateFile
     dup win32-error=0/f
-    dup add-completion ;
-
-: <pipe> ( name in-mode out-mode -- pipe )
-    [
-        >r over >r create-named-pipe dup close-later
-        r> r> open-other-end dup close-later
-        pipe boa
-    ] with-destructors ;
-
-: <incoming-pipe> ( name -- pipe )
-    PIPE_ACCESS_INBOUND GENERIC_WRITE <pipe> ;
-
-: <outgoing-pipe> ( name -- pipe )
-    PIPE_ACCESS_OUTBOUND GENERIC_READ <pipe> ;
+    dup add-completion
+    f <win32-file> ;
 
 : unique-pipe-name ( -- string )
     [
@@ -54,23 +44,10 @@ IN: io.windows.nt.pipes
         millis #
     ] "" make ;
 
-: <unique-incoming-pipe> ( -- pipe )
-    unique-pipe-name <incoming-pipe> ;
-
-: <unique-outgoing-pipe> ( -- pipe )
-    unique-pipe-name <outgoing-pipe> ;
-
-! /dev/null simulation
-: null-input ( -- pipe )
-    <unique-outgoing-pipe>
-    [ in>> ] [ out>> CloseHandle drop ] bi ;
-
-: null-output ( -- pipe )
-    <unique-incoming-pipe>
-    [ in>> CloseHandle drop ] [ out>> ] bi ;
-
-: null-pipe ( mode -- pipe )
-    {
-        { GENERIC_READ [ null-input ] }
-        { GENERIC_WRITE [ null-output ] }
-    } case ;
+M: winnt (pipe) ( -- pipe )
+    [
+        unique-pipe-name
+        [ create-named-pipe dup close-later ]
+        [ open-other-end dup close-later ]
+        bi pipe boa
+    ] with-destructors ;

extra/tools/vocabs/monitor/monitor.factor

@@ -13,9 +13,9 @@ IN: tools.vocabs.monitor
     dup ".factor" tail? [ parent-directory ] when ;
 
 : chop-vocab-root ( path -- path' )
-    "resource:" prepend-path (normalize-path)
+    "resource:" prepend-path normalize-path
     dup vocab-roots get
-    [ (normalize-path) ] map
+    [ normalize-path ] map
     [ head? ] with find nip
     ?head drop ;
 
@@ -29,17 +29,17 @@ IN: tools.vocabs.monitor
     reset-cache
     monitor-loop ;
 
-: add-monitor-for-path ( path -- ) 
-    normalize-path dup exists? [ t my-mailbox (monitor) ] when drop ;
-    
+: add-monitor-for-path ( path -- )
+    dup exists? [ t my-mailbox (monitor) ] when drop ;
+
 : monitor-thread ( -- )
     [
         [
             vocab-roots get prune [ add-monitor-for-path ] each
-            
+
             H{ } clone changed-vocabs set-global
             vocabs [ changed-vocab ] each
-            
+
             monitor-loop
         ] with-monitors
     ] ignore-errors ;