diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor index 14d3420a68..b12dcaa807 100755 --- a/basis/help/lint/lint.factor +++ b/basis/help/lint/lint.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors sequences parser kernel help help.markup +USING: fry accessors sequences parser kernel help help.markup help.topics words strings classes tools.vocabs namespaces io io.streams.string prettyprint definitions arrays vectors combinators combinators.short-circuit splitting debugger @@ -39,7 +39,7 @@ IN: help.lint $predicate $class-description $error-description - } swap [ elements f like ] curry contains? ; + } swap '[ , elements empty? not ] contains? ; : check-values ( word element -- ) { @@ -108,12 +108,10 @@ M: help-error error. articles get keys vocabs [ dup vocab-docs-path swap ] H{ } map>assoc H{ } clone [ - [ - [ dup >link where dup ] 2dip - [ >r >r first r> at r> push-at ] 2curry - [ 2drop ] - if - ] 2curry each + '[ + dup >link where dup + [ first , at , push-at ] [ 2drop ] if + ] each ] keep ; : check-about ( vocab -- ) diff --git a/basis/help/topics/topics-tests.factor b/basis/help/topics/topics-tests.factor index 699b2d398a..f53bdee9c7 100644 --- a/basis/help/topics/topics-tests.factor +++ b/basis/help/topics/topics-tests.factor @@ -16,7 +16,7 @@ IN: help.topics.tests SYMBOL: foo -[ ] [ { "test" "a" } "Test A" { { $subsection foo } }
add-article ] unit-test +[ ] [ "Test A" { { $subsection foo } }
{ "test" "a" } add-article ] unit-test ! Test article location recording diff --git a/basis/io/windows/launcher/launcher.factor b/basis/io/windows/launcher/launcher.factor index 9442fa9a72..ed9b53675b 100755 --- a/basis/io/windows/launcher/launcher.factor +++ b/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 [ diff --git a/basis/io/windows/nt/backend/backend.factor b/basis/io/windows/nt/backend/backend.factor index e9df2ddab9..7fbc1dbcf9 100755 --- a/basis/io/windows/nt/backend/backend.factor +++ b/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 diff --git a/basis/io/windows/nt/sockets/sockets.factor b/basis/io/windows/nt/sockets/sockets.factor index a31c41942f..41c5e88f5f 100755 --- a/basis/io/windows/nt/sockets/sockets.factor +++ b/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 : ( 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 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 : ( 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 0 f - [ 0 GetAcceptExSockaddrs ] keep *void* ; + [ 0 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*>> ] + [ sAcceptSocket>> ] [ 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 : ( 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 : ( 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 >>lpNumberOfBytesSent* - (make-overlapped) >>lpOverlapped* ; + r> [ >>lpTo ] [ >>iToLen ] bi* + swap make-send-buffer >>lpBuffers + 1 >>dwBufferCount + 0 >>dwFlags + 0 >>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 -- ) [ diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 553ced5800..f2c154b3b2 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -105,6 +105,10 @@ M: method-body crossref? drop [ dup ] 2keep reveal-method ] if ; +PREDICATE: default-method < word "default" word-prop ; + +M: default-method irrelevant? drop t ; + : ( generic combination -- method ) [ drop object bootstrap-word swap ] [ make-default-method ] 2bi [ define ] [ drop t "default" set-word-prop ] [ drop ] 2tri ; @@ -137,7 +141,7 @@ M: method-body definer M: method-body forget* dup "forgotten" word-prop [ drop ] [ [ - dup "default" word-prop [ drop ] [ + dup default-method? [ drop ] [ [ [ "method-class" word-prop ] [ "method-generic" word-prop ] bi diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 503c72290a..860781e5e2 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -26,10 +26,6 @@ ERROR: no-method object generic ; : error-method ( word -- quot ) picker swap [ no-method ] curry append ; -: default-method ( word -- pair ) - "default-method" word-prop - object bootstrap-word swap 2array ; - : push-method ( method specializer atomic assoc -- ) [ [ H{ } clone ] unless* diff --git a/extra/classes/tuple/lib/authors.txt b/extra/classes/tuple/lib/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/extra/classes/tuple/lib/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/classes/tuple/lib/lib-docs.factor b/extra/classes/tuple/lib/lib-docs.factor deleted file mode 100644 index 0c4c11e46f..0000000000 --- a/extra/classes/tuple/lib/lib-docs.factor +++ /dev/null @@ -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< } ; - diff --git a/extra/classes/tuple/lib/lib-tests.factor b/extra/classes/tuple/lib/lib-tests.factor deleted file mode 100644 index 7f7f24ab56..0000000000 --- a/extra/classes/tuple/lib/lib-tests.factor +++ /dev/null @@ -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 - diff --git a/extra/classes/tuple/lib/lib.factor b/extra/classes/tuple/lib/lib.factor deleted file mode 100755 index a234ce0d41..0000000000 --- a/extra/classes/tuple/lib/lib.factor +++ /dev/null @@ -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 ; - -