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
io.encodings.utf8 io.pathnames io.streams.string kernel libc
literals math mirrors multiline namespaces prettyprint
prettyprint.config see sequences specialized-arrays.char int
specialized-arrays.ushort struct-arrays system tools.test ;
prettyprint.config see sequences specialized-arrays.char
specialized-arrays.int specialized-arrays.ushort
struct-arrays system tools.test ;
IN: classes.struct.tests
<<

View File

@ -14,11 +14,11 @@ TUPLE: io-callback port thread ;
C: <io-callback> io-callback
: (make-overlapped) ( -- overlapped-ext )
"OVERLAPPED" malloc-object &free ;
OVERLAPPED malloc-struct &free ;
: make-overlapped ( port -- overlapped-ext )
[ (make-overlapped) ] dip
handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
handle>> ptr>> [ >>offset ] when* ;
M: winnt FileArgs-overlapped ( port -- overlapped )
make-overlapped ;
@ -40,7 +40,7 @@ M: winnt add-completion ( win32-handle -- )
: twiddle-thumbs ( overlapped port -- bytes-transferred )
[
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 array? ] [
@ -57,11 +57,12 @@ M: winnt add-completion ( win32-handle -- )
f <void*> [ ! overlapped
us [ 1000 /i ] [ INFINITE ] if* ! timeout
GetQueuedCompletionStatus zero?
] keep *void*
] keep
*void* dup [ OVERLAPPED memory>struct ] when
] keep *int spin ;
: 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 -- ? )
wait-for-overlapped [

View File

@ -1,5 +1,5 @@
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.ushort alien.c-types accessors kernel
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 } ] [
3 ALIEN: 123 100 <direct-ushort-array> new-sequence
dup [ drop 0 ] change-each
] unit-test

View File

@ -0,0 +1 @@
unportable

View File

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

View File

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

View File

@ -24,3 +24,6 @@ IN: sequences.product.tests
[ [ % ] each ] product-each
] "" make
] 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 -- )
[ 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 ;
: end-product-iter? ( ns lengths -- ? )
@ -50,8 +50,10 @@ M: product-sequence nth
:: product-each ( sequences quot -- )
sequences start-product-iter :> lengths :> ns
[ ns lengths end-product-iter? ]
[ ns sequences nths quot call ns lengths product-iter ] until ; inline
lengths [ 0 = ] any? [
[ ns lengths end-product-iter? ]
[ ns sequences nths quot call ns lengths product-iter ] until
] unless ; inline
:: product-map ( sequences quot -- sequence )
0 :> i!

View File

@ -155,18 +155,18 @@ syn match factorLiteralStackEffect /\<(( .*--.* ))\>/
"adapted from lisp.vim
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
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 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 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 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 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 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 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 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 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 factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
endif
if exists("g:factor_norainbow")