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

db4
Guillaume Nargeot 2009-09-06 09:59:41 +09:00
commit 534db0ce4c
9 changed files with 38 additions and 30 deletions

View File

@ -5,8 +5,9 @@ classes.struct classes.tuple.private combinators
compiler.tree.debugger compiler.units destructors compiler.tree.debugger compiler.units destructors
io.encodings.utf8 io.pathnames io.streams.string kernel libc io.encodings.utf8 io.pathnames io.streams.string kernel libc
literals math mirrors multiline namespaces prettyprint literals math mirrors multiline namespaces prettyprint
prettyprint.config see sequences specialized-arrays.char int prettyprint.config see sequences specialized-arrays.char
specialized-arrays.ushort struct-arrays system tools.test ; specialized-arrays.int specialized-arrays.ushort
struct-arrays system tools.test ;
IN: classes.struct.tests IN: classes.struct.tests
<< <<

View File

@ -14,11 +14,11 @@ TUPLE: io-callback port thread ;
C: <io-callback> io-callback C: <io-callback> io-callback
: (make-overlapped) ( -- overlapped-ext ) : (make-overlapped) ( -- overlapped-ext )
"OVERLAPPED" malloc-object &free ; OVERLAPPED malloc-struct &free ;
: make-overlapped ( port -- overlapped-ext ) : make-overlapped ( port -- overlapped-ext )
[ (make-overlapped) ] dip [ (make-overlapped) ] dip
handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ; handle>> ptr>> [ >>offset ] when* ;
M: winnt FileArgs-overlapped ( port -- overlapped ) M: winnt FileArgs-overlapped ( port -- overlapped )
make-overlapped ; make-overlapped ;
@ -40,7 +40,7 @@ M: winnt add-completion ( win32-handle -- )
: twiddle-thumbs ( overlapped port -- bytes-transferred ) : twiddle-thumbs ( overlapped port -- bytes-transferred )
[ [
drop drop
[ pending-overlapped get-global set-at ] curry "I/O" suspend [ >c-ptr pending-overlapped get-global set-at ] curry "I/O" suspend
{ {
{ [ dup integer? ] [ ] } { [ dup integer? ] [ ] }
{ [ dup array? ] [ { [ dup array? ] [
@ -57,11 +57,12 @@ M: winnt add-completion ( win32-handle -- )
f <void*> [ ! overlapped f <void*> [ ! overlapped
us [ 1000 /i ] [ INFINITE ] if* ! timeout us [ 1000 /i ] [ INFINITE ] if* ! timeout
GetQueuedCompletionStatus zero? GetQueuedCompletionStatus zero?
] keep *void* ] keep
*void* dup [ OVERLAPPED memory>struct ] when
] keep *int spin ; ] keep *int spin ;
: resume-callback ( result overlapped -- ) : resume-callback ( result overlapped -- )
pending-overlapped get-global delete-at* drop resume-with ; >c-ptr pending-overlapped get-global delete-at* drop resume-with ;
: handle-overlapped ( us -- ? ) : handle-overlapped ( us -- ? )
wait-for-overlapped [ wait-for-overlapped [

View File

@ -1,5 +1,5 @@
IN: specialized-arrays.tests IN: specialized-arrays.tests
USING: tools.test specialized-arrays sequences USING: tools.test alien.syntax specialized-arrays sequences
specialized-arrays.int specialized-arrays.bool specialized-arrays.int specialized-arrays.bool
specialized-arrays.ushort alien.c-types accessors kernel specialized-arrays.ushort alien.c-types accessors kernel
specialized-arrays.char specialized-arrays.uint arrays combinators ; specialized-arrays.char specialized-arrays.uint arrays combinators ;
@ -30,4 +30,5 @@ specialized-arrays.char specialized-arrays.uint arrays combinators ;
[ ushort-array{ 0 0 0 } ] [ [ ushort-array{ 0 0 0 } ] [
3 ALIEN: 123 100 <direct-ushort-array> new-sequence 3 ALIEN: 123 100 <direct-ushort-array> new-sequence
dup [ drop 0 ] change-each
] unit-test ] unit-test

View File

@ -0,0 +1 @@
unportable

View File

@ -210,12 +210,12 @@ C-ENUM:
TYPEDEF: uint COMPUTER_NAME_FORMAT TYPEDEF: uint COMPUTER_NAME_FORMAT
C-STRUCT: OVERLAPPED STRUCT: OVERLAPPED
{ "UINT_PTR" "internal" } { internal UINT_PTR }
{ "UINT_PTR" "internal-high" } { internal-high UINT_PTR }
{ "DWORD" "offset" } { offset DWORD }
{ "DWORD" "offset-high" } { offset-high DWORD }
{ "HANDLE" "event" } ; { event HANDLE } ;
STRUCT: SYSTEMTIME STRUCT: SYSTEMTIME
{ wYear WORD } { wYear WORD }

View File

@ -1,8 +1,7 @@
! Copyright (C) 2009 Doug Coleman ! Copyright (C) 2009 Doug Coleman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors grouping sequences combinators math USING: kernel accessors grouping sequences combinators math
byte-arrays fry specialized-arrays.direct.ushort byte-arrays fry specialized-arrays.uint specialized-arrays.ushort
specialized-arrays.uint specialized-arrays.ushort
specialized-arrays.float images half-floats ; specialized-arrays.float images half-floats ;
IN: images.normalization IN: images.normalization

View File

@ -24,3 +24,6 @@ IN: sequences.product.tests
[ [ % ] each ] product-each [ [ % ] each ] product-each
] "" make ] "" make
] unit-test ] unit-test
[ { } ] [ { { } { 1 } } [ ] product-map ] unit-test
[ ] [ { { } { 1 } } [ drop ] product-each ] unit-test

View File

@ -37,7 +37,7 @@ M: product-sequence length lengths>> product ;
: product-iter ( ns lengths -- ) : product-iter ( ns lengths -- )
[ 0 over [ 1 + ] change-nth ] dip carry-ns ; [ 0 over [ 1 + ] change-nth ] dip carry-ns ;
: start-product-iter ( sequence-product -- ns lengths ) : start-product-iter ( sequences -- ns lengths )
[ [ drop 0 ] map ] [ [ length ] map ] bi ; [ [ drop 0 ] map ] [ [ length ] map ] bi ;
: end-product-iter? ( ns lengths -- ? ) : end-product-iter? ( ns lengths -- ? )
@ -50,8 +50,10 @@ M: product-sequence nth
:: product-each ( sequences quot -- ) :: product-each ( sequences quot -- )
sequences start-product-iter :> lengths :> ns sequences start-product-iter :> lengths :> ns
lengths [ 0 = ] any? [
[ ns lengths end-product-iter? ] [ ns lengths end-product-iter? ]
[ ns sequences nths quot call ns lengths product-iter ] until ; inline [ ns sequences nths quot call ns lengths product-iter ] until
] unless ; inline
:: product-map ( sequences quot -- sequence ) :: product-map ( sequences quot -- sequence )
0 :> i! 0 :> i!

View File

@ -155,18 +155,18 @@ syn match factorLiteralStackEffect /\<(( .*--.* ))\>/
"adapted from lisp.vim "adapted from lisp.vim
if exists("g:factor_norainbow") if exists("g:factor_norainbow")
syn region factorQuotation matchgroup=factorDelimiter start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL syn region factorQuotation matchgroup=factorDelimiter start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
else else
syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1 syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2 syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3 syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4 syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5 syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6 syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7 syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8 syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9 syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0 syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
endif endif
if exists("g:factor_norainbow") if exists("g:factor_norainbow")