Clean up Windows I/O a bit, remove classes.tuple.lib

basis/io/windows/launcher/launcher.factor

@@ -6,7 +6,7 @@ windows.types math windows.kernel32
 namespaces io.launcher kernel sequences windows.errors
 splitting system threads init strings combinators
 io.backend accessors concurrency.flags io.files assocs
-io.files.private windows destructors classes.tuple.lib ;
+io.files.private windows destructors ;
 IN: io.windows.launcher
 
 TUPLE: CreateProcess-args
@@ -30,7 +30,19 @@ TUPLE: CreateProcess-args
     0 >>dwCreateFlags ;
 
 : call-CreateProcess ( CreateProcess-args -- )
-    CreateProcess-args >tuple< CreateProcess win32-error=0/f ;
+    {
+        [ lpApplicationName>> ]
+        [ lpCommandLine>> ]
+        [ lpProcessAttributes>> ]
+        [ lpThreadAttributes>> ]
+        [ bInheritHandles>> ]
+        [ dwCreateFlags>> ]
+        [ lpEnvironment>> ]
+        [ lpCurrentDirectory>> ]
+        [ lpStartupInfo>> ]
+        [ lpProcessInformation>> ]
+    } cleave
+    CreateProcess win32-error=0/f ;
 
 : count-trailing-backslashes ( str n -- str n )
     >r "\\" ?tail r> swap [

basis/io/windows/nt/backend/backend.factor

@@ -1,9 +1,8 @@
 USING: alien alien.c-types arrays assocs combinators
 continuations destructors io io.backend io.ports io.timeouts
 io.windows io.windows.files libc kernel math namespaces
-sequences threads classes.tuple.lib windows windows.errors
-windows.kernel32 strings splitting io.files
-io.buffers qualified ascii system
+sequences threads windows windows.errors windows.kernel32
+strings splitting io.files io.buffers qualified ascii system
 accessors locals ;
 QUALIFIED: windows.winsock
 IN: io.windows.nt.backend

basis/io/windows/nt/sockets/sockets.factor

@@ -1,9 +1,8 @@
 USING: alien alien.accessors alien.c-types byte-arrays
 continuations destructors io.ports io.timeouts io.sockets
 io.sockets io namespaces io.streams.duplex io.windows
-io.windows.sockets
-io.windows.nt.backend windows.winsock kernel libc math sequences
-threads classes.tuple.lib system combinators accessors ;
+io.windows.sockets io.windows.nt.backend windows.winsock kernel
+libc math sequences threads system combinators accessors ;
 IN: io.windows.nt.sockets
 
 : malloc-int ( object -- object )
@@ -28,71 +27,89 @@ M: winnt WSASocket-flags ( -- DWORD )
     ] keep *void* ;
 
 TUPLE: ConnectEx-args port
-    s* name* namelen* lpSendBuffer* dwSendDataLength*
-    lpdwBytesSent* lpOverlapped* ptr* ;
+    s name namelen lpSendBuffer dwSendDataLength
+    lpdwBytesSent lpOverlapped ptr ;
 
 : wait-for-socket ( args -- n )
-    [ lpOverlapped*>> ] [ port>> ] bi twiddle-thumbs ;
+    [ lpOverlapped>> ] [ port>> ] bi twiddle-thumbs ; inline
 
 : <ConnectEx-args> ( sockaddr size -- ConnectEx )
     ConnectEx-args new
-        swap >>namelen*
-        swap >>name*
-        f >>lpSendBuffer*
-        0 >>dwSendDataLength*
-        f >>lpdwBytesSent*
-        (make-overlapped) >>lpOverlapped* ;
+        swap >>namelen
+        swap >>name
+        f >>lpSendBuffer
+        0 >>dwSendDataLength
+        f >>lpdwBytesSent
+        (make-overlapped) >>lpOverlapped ; inline
 
 : call-ConnectEx ( ConnectEx -- )
-    ConnectEx-args >tuple*<
+    {
+        [ s>> ]
+        [ name>> ]
+        [ namelen>> ]
+        [ lpSendBuffer>> ]
+        [ dwSendDataLength>> ]
+        [ lpdwBytesSent>> ]
+        [ lpOverlapped>> ]
+        [ ptr>> ]
+    } cleave
     "int"
     { "SOCKET" "sockaddr_in*" "int" "PVOID" "DWORD" "LPDWORD" "void*" }
     "stdcall" alien-indirect drop
-    winsock-error-string [ throw ] when* ;
+    winsock-error-string [ throw ] when* ; inline
 
 M: object establish-connection ( client-out remote -- )
     make-sockaddr/size <ConnectEx-args>
         swap >>port
-        dup port>> handle>> handle>> >>s*
-        dup s*>> get-ConnectEx-ptr >>ptr*
+        dup port>> handle>> handle>> >>s
+        dup s>> get-ConnectEx-ptr >>ptr
         dup call-ConnectEx
         wait-for-socket drop ;
 
 TUPLE: AcceptEx-args port
-    sListenSocket* sAcceptSocket* lpOutputBuffer* dwReceiveDataLength*
-    dwLocalAddressLength* dwRemoteAddressLength* lpdwBytesReceived* lpOverlapped* ;
+    sListenSocket sAcceptSocket lpOutputBuffer dwReceiveDataLength
+    dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ;
 
 : init-accept-buffer ( addr AcceptEx -- )
     swap sockaddr-type heap-size 16 +
-        [ >>dwLocalAddressLength* ] [ >>dwRemoteAddressLength* ] bi
-        dup dwLocalAddressLength*>> 2 * malloc &free >>lpOutputBuffer*
-        drop ;
+        [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi
+        dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer
+        drop ; inline
 
 : <AcceptEx-args> ( server addr -- AcceptEx )
     AcceptEx-args new
         2dup init-accept-buffer
-        swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket*
-        over handle>> handle>> >>sListenSocket*
+        swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket
+        over handle>> handle>> >>sListenSocket
         swap >>port
-        0 >>dwReceiveDataLength*
-        f >>lpdwBytesReceived*
-        (make-overlapped) >>lpOverlapped* ;
+        0 >>dwReceiveDataLength
+        f >>lpdwBytesReceived
+        (make-overlapped) >>lpOverlapped ; inline
 
 : call-AcceptEx ( AcceptEx -- )
-    AcceptEx-args >tuple*< AcceptEx drop
-    winsock-error-string [ throw ] when* ;
+    {
+        [ sListenSocket>> ]
+        [ sAcceptSocket>> ]
+        [ lpOutputBuffer>> ]
+        [ dwReceiveDataLength>> ]
+        [ dwLocalAddressLength>> ]
+        [ dwRemoteAddressLength>> ]
+        [ lpdwBytesReceived>> ]
+        [ lpOverlapped>> ]
+    } cleave AcceptEx drop
+    winsock-error-string [ throw ] when* ; inline
 
 : extract-remote-address ( AcceptEx -- sockaddr )
     {
-        [ lpOutputBuffer*>> ]
-        [ dwReceiveDataLength*>> ]
-        [ dwLocalAddressLength*>> ]
-        [ dwRemoteAddressLength*>> ]
+        [ lpOutputBuffer>> ]
+        [ dwReceiveDataLength>> ]
+        [ dwLocalAddressLength>> ]
+        [ dwRemoteAddressLength>> ]
     } cleave
     f <void*>
     0 <int>
     f <void*>
-    [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
+    [ 0 <int> GetAcceptExSockaddrs ] keep *void* ; inline
 
 M: object (accept) ( server addr -- handle sockaddr )
     [
@@ -100,39 +117,49 @@ M: object (accept) ( server addr -- handle sockaddr )
         {
             [ call-AcceptEx ]
             [ wait-for-socket drop ]
-            [ sAcceptSocket*>> <win32-socket> ]
+            [ sAcceptSocket>> <win32-socket> ]
             [ extract-remote-address ]
         } cleave
     ] with-destructors ;
 
 TUPLE: WSARecvFrom-args port
-       s* lpBuffers* dwBufferCount* lpNumberOfBytesRecvd*
-       lpFlags* lpFrom* lpFromLen* lpOverlapped* lpCompletionRoutine* ;
+       s lpBuffers dwBufferCount lpNumberOfBytesRecvd
+       lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ;
 
 : make-receive-buffer ( -- WSABUF )
     "WSABUF" malloc-object &free
     default-buffer-size get over set-WSABUF-len
-    default-buffer-size get malloc &free over set-WSABUF-buf ;
+    default-buffer-size get malloc &free over set-WSABUF-buf ; inline
 
 : <WSARecvFrom-args> ( datagram -- WSARecvFrom )
     WSARecvFrom-args new
         swap >>port
-        dup port>> handle>> handle>> >>s*
+        dup port>> handle>> handle>> >>s
         dup port>> addr>> sockaddr-type heap-size
-            [ malloc &free >>lpFrom* ]
-            [ malloc-int &free >>lpFromLen* ] bi
-        make-receive-buffer >>lpBuffers*
-        1 >>dwBufferCount*
-        0 malloc-int &free >>lpFlags*
-        0 malloc-int &free >>lpNumberOfBytesRecvd*
-        (make-overlapped) >>lpOverlapped* ;
+            [ malloc &free >>lpFrom ]
+            [ malloc-int &free >>lpFromLen ] bi
+        make-receive-buffer >>lpBuffers
+        1 >>dwBufferCount
+        0 malloc-int &free >>lpFlags
+        0 malloc-int &free >>lpNumberOfBytesRecvd
+        (make-overlapped) >>lpOverlapped ; inline
 
 : call-WSARecvFrom ( WSARecvFrom -- )
-    WSARecvFrom-args >tuple*< WSARecvFrom socket-error* ;
+    {
+        [ s>> ]
+        [ lpBuffers>> ]
+        [ dwBufferCount>> ]
+        [ lpNumberOfBytesRecvd>> ]
+        [ lpFlags>> ]
+        [ lpFrom>> ]
+        [ lpFromLen>> ]
+        [ lpOverlapped>> ]
+        [ lpCompletionRoutine>> ]
+    } cleave WSARecvFrom socket-error* ; inline
 
 : parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
-    [ lpBuffers*>> WSABUF-buf swap memory>byte-array ]
-    [ [ lpFrom*>> ] [ lpFromLen*>> *int ] bi memory>byte-array ] bi ;
+    [ lpBuffers>> WSABUF-buf swap memory>byte-array ]
+    [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline
 
 M: winnt (receive) ( datagram -- packet addrspec )
     [
@@ -144,31 +171,41 @@ M: winnt (receive) ( datagram -- packet addrspec )
     ] with-destructors ;
 
 TUPLE: WSASendTo-args port
-       s* lpBuffers* dwBufferCount* lpNumberOfBytesSent*
-       dwFlags* lpTo* iToLen* lpOverlapped* lpCompletionRoutine* ;
+       s lpBuffers dwBufferCount lpNumberOfBytesSent
+       dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ;
 
 : make-send-buffer ( packet -- WSABUF )
     "WSABUF" malloc-object &free
     [ >r malloc-byte-array &free r> set-WSABUF-buf ]
     [ >r length r> set-WSABUF-len ]
     [ nip ]
-    2tri ;
+    2tri ; inline
 
 : <WSASendTo-args> ( packet addrspec datagram -- WSASendTo )
     WSASendTo-args new
         swap >>port
-        dup port>> handle>> handle>> >>s*
+        dup port>> handle>> handle>> >>s
         swap make-sockaddr/size
             >r malloc-byte-array &free
-            r> [ >>lpTo* ] [ >>iToLen* ] bi*
-        swap make-send-buffer >>lpBuffers*
-        1 >>dwBufferCount*
-        0 >>dwFlags*
-        0 <uint> >>lpNumberOfBytesSent*
-        (make-overlapped) >>lpOverlapped* ;
+            r> [ >>lpTo ] [ >>iToLen ] bi*
+        swap make-send-buffer >>lpBuffers
+        1 >>dwBufferCount
+        0 >>dwFlags
+        0 <uint> >>lpNumberOfBytesSent
+        (make-overlapped) >>lpOverlapped ; inline
 
 : call-WSASendTo ( WSASendTo -- )
-    WSASendTo-args >tuple*< WSASendTo socket-error* ;
+    {
+        [ s>> ]
+        [ lpBuffers>> ]
+        [ dwBufferCount>> ]
+        [ lpNumberOfBytesSent>> ]
+        [ dwFlags>> ]
+        [ lpTo>> ]
+        [ iToLen>> ]
+        [ lpOverlapped>> ]
+        [ lpCompletionRoutine>> ]
+    } cleave WSASendTo socket-error* ; inline
 
 M: winnt (send) ( packet addrspec datagram -- )
     [

extra/classes/tuple/lib/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

extra/classes/tuple/lib/lib-docs.factor

@@ -1,29 +0,0 @@
-USING: help.syntax help.markup kernel prettyprint sequences ;
-IN: classes.tuple.lib
-
-HELP: >tuple<
-{ $values { "class" "a tuple class" } }
-{ $description "Explodes the tuple so that tuple slots are on the stack in the order listed in the tuple." }
-{ $example
-    "USING: kernel prettyprint classes.tuple.lib ;"
-    "IN: scratchpad"
-    "TUPLE: foo a b c ;"
-    "1 2 3 \\ foo boa \\ foo >tuple< .s"
-    "1\n2\n3"
-}
-{ $notes "Words using " { $snippet ">tuple<" } " may be compiled." }
-{ $see-also >tuple*< } ;
-
-HELP: >tuple*<
-{ $values { "class" "a tuple class" } }
-{ $description "Explodes the tuple so that tuple slots ending with '*' are on the stack in the order listed in the tuple." }
-{ $example
-    "USING: kernel prettyprint classes.tuple.lib ;"
-    "IN: scratchpad"
-    "TUPLE: foo a bb* ccc dddd* ;"
-    "1 2 3 4 \\ foo boa \\ foo >tuple*< .s"
-    "2\n4"
-}
-{ $notes "Words using " { $snippet ">tuple*<" } " may be compiled." }
-{ $see-also >tuple< } ;
-

extra/classes/tuple/lib/lib-tests.factor

@@ -1,8 +0,0 @@
-USING: kernel tools.test classes.tuple.lib ;
-IN: classes.tuple.lib.tests
-
-TUPLE: foo a b* c d* e f* ;
-
-[ 1 2 3 4 5 6 ] [ 1 2 3 4 5 6 \ foo boa \ foo >tuple< ] unit-test
-[ 2 4 6 ] [ 1 2 3 4 5 6 \ foo boa \ foo >tuple*< ] unit-test
-

extra/classes/tuple/lib/lib.factor

@@ -1,18 +0,0 @@
-! Copyright (C) 2007 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel macros sequences slots words classes.tuple
-quotations combinators accessors ;
-IN: classes.tuple.lib
-
-: reader-slots ( seq -- quot )
-    [ reader>> 1quotation ] map [ cleave ] curry ;
-
-MACRO: >tuple< ( class -- )
-    all-slots rest-slice reader-slots ;
-
-MACRO: >tuple*< ( class -- )
-    all-slots
-    [ slot-spec-name "*" tail? ] filter
-    reader-slots ;
-
-