From 8738b3d2197b2a84639914a07c16220c1f3a3f2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Fri, 4 Sep 2009 16:40:47 +0200 Subject: [PATCH 1/4] sequences.product: product-each and product-map misc/vim.syntax.fgen: small fix for quotation highlighting --- extra/sequences/product/product-tests.factor | 3 +++ extra/sequences/product/product.factor | 8 ++++--- misc/factor.vim.fgen | 22 ++++++++++---------- 3 files changed, 19 insertions(+), 14 deletions(-) diff --git a/extra/sequences/product/product-tests.factor b/extra/sequences/product/product-tests.factor index 5e0997dc2e..9f931293ea 100644 --- a/extra/sequences/product/product-tests.factor +++ b/extra/sequences/product/product-tests.factor @@ -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 diff --git a/extra/sequences/product/product.factor b/extra/sequences/product/product.factor index 9291fad3c0..c94e13a673 100644 --- a/extra/sequences/product/product.factor +++ b/extra/sequences/product/product.factor @@ -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! diff --git a/misc/factor.vim.fgen b/misc/factor.vim.fgen index d094919c74..4da54e055c 100644 --- a/misc/factor.vim.fgen +++ b/misc/factor.vim.fgen @@ -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") From 1798000335170a3559d368cd8e80509422c1f6ad Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 5 Sep 2009 02:26:06 -0500 Subject: [PATCH 2/4] Fix unit tests for specialized-arrays.direct change --- basis/classes/struct/struct-tests.factor | 5 +++-- basis/specialized-arrays/specialized-arrays-tests.factor | 3 ++- extra/images/normalization/normalization.factor | 3 +-- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index f359b5f6f7..195664b8b6 100755 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -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 << diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 21fc41781e..ad73153033 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -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 new-sequence + dup [ drop 0 ] change-each ] unit-test \ No newline at end of file diff --git a/extra/images/normalization/normalization.factor b/extra/images/normalization/normalization.factor index e318044b81..90341fed92 100755 --- a/extra/images/normalization/normalization.factor +++ b/extra/images/normalization/normalization.factor @@ -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 From 9881332ddb9c0657bbc5fbae3173d1b7e5f6d36c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 5 Sep 2009 10:59:40 -0500 Subject: [PATCH 3/4] windows.com.prettyprint: add unportable tag --- basis/windows/com/prettyprint/tags.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 basis/windows/com/prettyprint/tags.txt diff --git a/basis/windows/com/prettyprint/tags.txt b/basis/windows/com/prettyprint/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/windows/com/prettyprint/tags.txt @@ -0,0 +1 @@ +unportable From 75f7e27c6c3ec90efb8eaeafe329cf6316d124df Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 5 Sep 2009 16:20:58 -0500 Subject: [PATCH 4/4] Use new-style structs for overlapped struct on Windows --- basis/io/backend/windows/nt/nt.factor | 11 ++++++----- basis/windows/kernel32/kernel32.factor | 12 ++++++------ 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor index 46d4d28cfc..217ce7b31e 100755 --- a/basis/io/backend/windows/nt/nt.factor +++ b/basis/io/backend/windows/nt/nt.factor @@ -14,11 +14,11 @@ TUPLE: io-callback port thread ; C: 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 [ ! 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 [ diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index f4d6038954..2cba1173d5 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -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 }