From 824f11af009fdb7154010ee936b302f09306b120 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 2 Nov 2007 04:53:23 -0400 Subject: [PATCH 01/20] bootstrap.ui fix --- core/bootstrap/ui/tools/tools.factor | 2 ++ core/bootstrap/ui/ui.factor | 2 -- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/core/bootstrap/ui/tools/tools.factor b/core/bootstrap/ui/tools/tools.factor index c469aedcff..52e4367b42 100644 --- a/core/bootstrap/ui/tools/tools.factor +++ b/core/bootstrap/ui/tools/tools.factor @@ -8,3 +8,5 @@ USING: kernel vocabs vocabs.loader sequences ; "ui.cocoa.tools" require ] when ] when + +macosx? [ "ui.tools.deploy" require ] when diff --git a/core/bootstrap/ui/ui.factor b/core/bootstrap/ui/ui.factor index af3aa63e36..86538e0000 100644 --- a/core/bootstrap/ui/ui.factor +++ b/core/bootstrap/ui/ui.factor @@ -12,5 +12,3 @@ vocabs vocabs.loader ; "ui.freetype" require ] when - -macosx? [ "ui.tools.deploy" require ] when From e7a36ef9120b5c22398b2c76289a779ce0295683 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 2 Nov 2007 13:05:38 -0500 Subject: [PATCH 02/20] Fix error message for dlopen on windows --- vm/os-windows.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/vm/os-windows.c b/vm/os-windows.c index 6e39422134..421d90b223 100755 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -51,8 +51,7 @@ void ffi_dlopen (F_DLL *dll, bool error) { dll->dll = NULL; if(error) - general_error(ERROR_FFI,F,F, - (void*)tag_object(get_error_message())); + general_error(ERROR_FFI,F,tag_object(get_error_message()),NULL); else return; } From b31440a574b1bf26117f68745c549f600e1c94ee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 2 Nov 2007 14:26:04 -0400 Subject: [PATCH 03/20] Fix deployment, remove image compression since its useless and broken --- core/memory/memory.factor | 26 ------------------------- extra/tools/deploy/config/config.factor | 2 +- extra/tools/deploy/shaker/shaker.factor | 4 +--- 3 files changed, 2 insertions(+), 30 deletions(-) diff --git a/core/memory/memory.factor b/core/memory/memory.factor index 871838c3f3..0d684c3261 100644 --- a/core/memory/memory.factor +++ b/core/memory/memory.factor @@ -16,29 +16,3 @@ math strings combinators ; pusher >r each-object r> >array ; inline : save ( -- ) image save-image ; - - - -: compress-image ( -- ) - prepare-compress-image "bad-strings" [ - [ - { - { [ dup quotation? ] [ t ] } - { [ dup wrapper? ] [ t ] } - { [ dup fixnum? ] [ f ] } - { [ dup number? ] [ t ] } - { [ dup string? ] [ dup "bad-strings" get memq? not ] } - { [ t ] [ f ] } - } cond nip - ] intern-objects - ] with-variable ; diff --git a/extra/tools/deploy/config/config.factor b/extra/tools/deploy/config/config.factor index cebf39cbd0..da3daa91f1 100644 --- a/extra/tools/deploy/config/config.factor +++ b/extra/tools/deploy/config/config.factor @@ -17,7 +17,7 @@ SYMBOL: deploy-io { 3 "Level 3 - Non-blocking streams and networking" } } ; -: strip-io? deploy-io get zero? ; +: strip-io? deploy-io get 1 = ; : native-io? deploy-io get 3 = ; diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index 73c00cbd50..4531a88011 100644 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -70,8 +70,8 @@ IN: tools.deploy.shaker strip-word-defs ; : strip-environment ( retain-globals -- ) - "Stripping environment" show strip-globals? [ + "Stripping environment" show global strip-assoc 21 setenv ] [ drop ] if ; @@ -160,8 +160,6 @@ SYMBOL: deploy-vocab deploy-vocab get require r> [ call ] when* strip - "Compressing image" show - compress-image finish-deploy ] [ print-error flush 1 exit From c3efd8a60d5d2a66e9f5ccee1e62ac6bcc12bcf8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 2 Nov 2007 14:41:19 -0500 Subject: [PATCH 04/20] Move heaps to core/ --- core/heaps/heaps-tests.factor | 32 ++++++++++ core/heaps/heaps.factor | 112 ++++++++++++++++++++++++++++++++++ 2 files changed, 144 insertions(+) create mode 100644 core/heaps/heaps-tests.factor create mode 100644 core/heaps/heaps.factor diff --git a/core/heaps/heaps-tests.factor b/core/heaps/heaps-tests.factor new file mode 100644 index 0000000000..a8087916e7 --- /dev/null +++ b/core/heaps/heaps-tests.factor @@ -0,0 +1,32 @@ +! Copyright 2007 Ryan Murphy +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel math tools.test heaps heaps.private ; +IN: temporary + +[ pop-heap ] unit-test-fails +[ pop-heap ] unit-test-fails + +[ t ] [ heap-empty? ] unit-test +[ f ] [ 1 over push-heap heap-empty? ] unit-test +[ t ] [ heap-empty? ] unit-test +[ f ] [ 1 over push-heap heap-empty? ] unit-test + +! Binary Min Heap +{ 1 2 3 4 5 6 } [ 0 left 0 right 1 left 1 right 2 left 2 right ] unit-test +{ t } [ 5 3 T{ min-heap } heap-compare ] unit-test +{ f } [ 5 3 T{ max-heap } heap-compare ] unit-test + +[ T{ min-heap T{ heap f V{ -6 -4 2 1 5 3 2 4 3 7 6 8 3 4 4 6 5 5 } } } ] +[ { 3 5 4 6 7 8 2 4 3 5 6 1 3 2 4 5 -6 -4 } over push-heap* ] unit-test + +[ T{ min-heap T{ heap f V{ 5 6 6 7 8 } } } ] [ + { 3 5 4 6 5 7 6 8 } over push-heap* + 3 [ dup pop-heap* ] times +] unit-test + +[ 2 ] [ 300 over push-heap 200 over push-heap 400 over push-heap 3 over push-heap 2 over push-heap pop-heap ] unit-test + +[ 1 ] [ 300 over push-heap 200 over push-heap 400 over push-heap 3 over push-heap 2 over push-heap 1 over push-heap pop-heap ] unit-test + +[ 400 ] [ 300 over push-heap 200 over push-heap 400 over push-heap 3 over push-heap 2 over push-heap 1 over push-heap pop-heap ] unit-test diff --git a/core/heaps/heaps.factor b/core/heaps/heaps.factor new file mode 100644 index 0000000000..2ff9096483 --- /dev/null +++ b/core/heaps/heaps.factor @@ -0,0 +1,112 @@ +! Copyright (C) 2007 Ryan Murphy, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math sequences ; +IN: heaps + + ( -- obj ) + V{ } clone heap construct-boa ; +PRIVATE> + +TUPLE: min-heap ; + +: ( -- obj ) + min-heap construct-delegate ; + +TUPLE: max-heap ; + +: ( -- obj ) + max-heap construct-delegate ; + +r left r> nth ; +: right-value ( n heap -- obj ) >r right r> nth ; +: up-value ( n vec -- obj ) >r up r> nth ; +: swap-up ( n vec -- ) >r dup up r> exchange ; +: last-index ( vec -- n ) length 1- ; + +GENERIC: heap-compare ( obj1 obj2 heap -- ? ) + +M: min-heap heap-compare drop <=> 0 > ; +M: max-heap heap-compare drop <=> 0 < ; + +: left-bounds-check? ( m heap -- ? ) + >r left r> heap-data length >= ; + +: right-bounds-check? ( m heap -- ? ) + >r right r> heap-data length >= ; + +: (up-heap) ( vec heap -- ) + [ + >r [ last-index ] keep [ up-value ] keep peek r> heap-compare + ] 2keep rot [ + >r dup last-index + [ over swap-up ] keep + up 1+ head-slice + r> (up-heap) + ] [ + 2drop + ] if ; + +: up-heap ( heap -- ) + [ heap-data ] keep (up-heap) ; + +: child ( m heap -- n ) + 2dup right-bounds-check? [ + drop left + ] [ + dupd + [ heap-data left-value ] 2keep + [ heap-data right-value ] keep heap-compare [ + right + ] [ + left + ] if + ] if ; + +: swap-down ( m heap -- ) + [ child ] 2keep heap-data exchange ; + +DEFER: down-heap + +: (down-heap) ( m heap -- ) + 2dup [ heap-data nth ] 2keep child pick + dupd [ heap-data nth swapd ] keep + heap-compare [ + -rot [ swap-down ] keep down-heap + ] [ + 3drop + ] if ; + +: down-heap ( m heap -- ) + 2dup left-bounds-check? [ 2drop ] [ (down-heap) ] if ; + +PRIVATE> + +: push-heap ( obj heap -- ) + tuck heap-data push up-heap ; + +: push-heap* ( seq heap -- ) + swap [ swap push-heap ] curry* each ; + +: peek-heap ( heap -- obj ) + heap-data first ; + +: pop-heap* ( heap -- ) + dup heap-data length 1 > [ + [ heap-data pop 0 ] keep + [ heap-data set-nth ] keep + >r 0 r> down-heap + ] [ + heap-data pop* + ] if ; + +: pop-heap ( heap -- fist ) [ heap-data first ] keep pop-heap* ; + +: heap-empty? ( heap -- ? ) + heap-data empty? ; From fe9563ece239cfba38d9b14c8f9765d7e1ccdcab Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 3 Nov 2007 15:38:45 -0400 Subject: [PATCH 05/20] Move io.buffers to extra --- core/optimizer/known-words/known-words.factor | 4 +--- {core => extra}/io/buffers/authors.txt | 0 {core => extra}/io/buffers/buffers-docs.factor | 0 {core => extra}/io/buffers/buffers-tests.factor | 0 {core => extra}/io/buffers/buffers.factor | 4 +++- {core => extra}/io/buffers/summary.txt | 0 6 files changed, 4 insertions(+), 4 deletions(-) rename {core => extra}/io/buffers/authors.txt (100%) rename {core => extra}/io/buffers/buffers-docs.factor (100%) rename {core => extra}/io/buffers/buffers-tests.factor (100%) rename {core => extra}/io/buffers/buffers.factor (96%) rename {core => extra}/io/buffers/summary.txt (100%) diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor index dffe18e630..40752c58a5 100755 --- a/core/optimizer/known-words/known-words.factor +++ b/core/optimizer/known-words/known-words.factor @@ -5,7 +5,7 @@ USING: alien arrays generic hashtables inference.dataflow inference.class kernel assocs math math.private kernel.private sequences words parser vectors strings sbufs io namespaces assocs quotations sequences.private io.binary io.crc32 -io.buffers io.streams.string layouts splitting math.intervals +io.streams.string layouts splitting math.intervals math.floats.private tuples tuples.private classes optimizer.def-use optimizer.backend optimizer.pattern-match float-arrays combinators.private ; @@ -148,5 +148,3 @@ float-arrays combinators.private ; \ >le { { fixnum bignum } fixnum } "specializer" set-word-prop \ >be { { fixnum bignum } fixnum } "specializer" set-word-prop - -\ search-buffer-until { fixnum fixnum simple-alien string } "specializer" set-word-prop diff --git a/core/io/buffers/authors.txt b/extra/io/buffers/authors.txt similarity index 100% rename from core/io/buffers/authors.txt rename to extra/io/buffers/authors.txt diff --git a/core/io/buffers/buffers-docs.factor b/extra/io/buffers/buffers-docs.factor similarity index 100% rename from core/io/buffers/buffers-docs.factor rename to extra/io/buffers/buffers-docs.factor diff --git a/core/io/buffers/buffers-tests.factor b/extra/io/buffers/buffers-tests.factor similarity index 100% rename from core/io/buffers/buffers-tests.factor rename to extra/io/buffers/buffers-tests.factor diff --git a/core/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor similarity index 96% rename from core/io/buffers/buffers.factor rename to extra/io/buffers/buffers.factor index cb897c26d8..e58cf3ead0 100644 --- a/core/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -3,7 +3,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: io.buffers USING: alien alien.syntax kernel kernel.private libc math -sequences strings ; +sequences strings hints ; TUPLE: buffer size ptr fill pos ; @@ -54,6 +54,8 @@ TUPLE: buffer size ptr fill pos ; : search-buffer-until ( start end alien separators -- n ) [ >r swap alien-unsigned-1 r> memq? ] 2curry find* drop ; +HINTS: search-buffer-until { fixnum fixnum simple-alien string } ; + : finish-buffer-until ( buffer n -- string separator ) [ over buffer-pos - diff --git a/core/io/buffers/summary.txt b/extra/io/buffers/summary.txt similarity index 100% rename from core/io/buffers/summary.txt rename to extra/io/buffers/summary.txt From 83190f4680e03514b846d5fa4654a90e8de885c0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 3 Nov 2007 15:41:39 -0400 Subject: [PATCH 06/20] Fix using in bootstra.ui.tools --- core/bootstrap/ui/tools/tools.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/bootstrap/ui/tools/tools.factor b/core/bootstrap/ui/tools/tools.factor index 52e4367b42..9dde428e72 100644 --- a/core/bootstrap/ui/tools/tools.factor +++ b/core/bootstrap/ui/tools/tools.factor @@ -1,4 +1,4 @@ -USING: kernel vocabs vocabs.loader sequences ; +USING: kernel vocabs vocabs.loader sequences system ; { "ui" "help" "tools" } [ "bootstrap." swap append vocab ] all? [ From 8584e7e95d7f4e7042a42c01cd791e46380752ae Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 3 Nov 2007 15:42:30 -0400 Subject: [PATCH 07/20] Deploy tool can now strip out libc debugging --- extra/tools/deploy/deploy.factor | 4 ++-- extra/tools/deploy/shaker/shaker.factor | 15 +++++++++++++-- extra/tools/deploy/shaker/strip-libc.factor | 8 ++++++++ 3 files changed, 23 insertions(+), 4 deletions(-) create mode 100644 extra/tools/deploy/shaker/strip-libc.factor diff --git a/extra/tools/deploy/deploy.factor b/extra/tools/deploy/deploy.factor index 2832551a34..c11b41e09c 100644 --- a/extra/tools/deploy/deploy.factor +++ b/extra/tools/deploy/deploy.factor @@ -37,8 +37,8 @@ IN: tools.deploy "" deploy-math? get " math" ?append deploy-compiler? get " compiler" ?append - native-io? " io" ?append deploy-ui? get " ui" ?append + native-io? " io" ?append ] bind ; : deploy-command-line ( vm image vocab config -- vm flags ) @@ -49,7 +49,7 @@ IN: tools.deploy "\"-output-image=" swap "\"" 3append , - "-no-stack-traces" , + ! "-no-stack-traces" , "-no-user-init" , ] { } make ; diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index 4531a88011..4b20c3f0ee 100644 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -5,7 +5,7 @@ assocs kernel vocabs words sequences memory io system arrays continuations math definitions mirrors splitting parser classes inspector layouts vocabs.loader prettyprint.config prettyprint debugger io.streams.c io.streams.duplex io.files io.backend -quotations words.private tools.deploy.config ; +quotations words.private tools.deploy.config compiler ; IN: tools.deploy.shaker : show ( msg -- ) @@ -23,6 +23,15 @@ IN: tools.deploy.shaker "Stripping debugger" show "resource:extra/tools/deploy/shaker/strip-debugger.factor" run-file + recompile + ] when ; + +: strip-libc ( -- ) + "libc" vocab [ + "Stripping manual memory management debug code" show + "resource:extra/tools/deploy/shaker/strip-libc.factor" + run-file + recompile ] when ; : strip-cocoa ( -- ) @@ -30,6 +39,7 @@ IN: tools.deploy.shaker "Stripping unused Cocoa methods" show "resource:extra/tools/deploy/shaker/strip-cocoa.factor" run-file + recompile ] when ; : strip-assoc ( retained-keys assoc -- newassoc ) @@ -126,7 +136,7 @@ SYMBOL: deploy-vocab } % ] unless - deploy-c-types? get deploy-ui? get or [ + deploy-c-types? get [ "c-types" "alien.c-types" lookup , ] when @@ -141,6 +151,7 @@ SYMBOL: deploy-vocab ] { } make dup . ; : strip ( -- ) + strip-libc strip-cocoa strip-debugger strip-init-hooks diff --git a/extra/tools/deploy/shaker/strip-libc.factor b/extra/tools/deploy/shaker/strip-libc.factor new file mode 100644 index 0000000000..f62b4b5935 --- /dev/null +++ b/extra/tools/deploy/shaker/strip-libc.factor @@ -0,0 +1,8 @@ +USING: libc.private ; +IN: libc + +: malloc (malloc) ; + +: free (free) ; + +: realloc (realloc) ; From 1cac7d54a62942562efa1e3e398dbf31c35f4475 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 3 Nov 2007 15:42:51 -0400 Subject: [PATCH 08/20] Move checkbox and radio button renders to ui.gadgets.buttons --- extra/ui/gadgets/buttons/buttons.factor | 24 +++++++++++++++++++++++ extra/ui/render/render.factor | 26 ------------------------- 2 files changed, 24 insertions(+), 26 deletions(-) diff --git a/extra/ui/gadgets/buttons/buttons.factor b/extra/ui/gadgets/buttons/buttons.factor index bd5591fa32..a9142449e5 100644 --- a/extra/ui/gadgets/buttons/buttons.factor +++ b/extra/ui/gadgets/buttons/buttons.factor @@ -95,6 +95,18 @@ repeat-button H{ repeat-button construct-empty [ >r r> set-gadget-delegate ] keep ; +TUPLE: checkmark-paint color ; + +C: checkmark-paint + +M: checkmark-paint draw-interior + checkmark-paint-color gl-color + origin get [ + rect-dim + { 0 0 } over gl-line + dup { 0 1 } v* swap { 1 0 } v* gl-line + ] with-translation ; + : checkmark-theme ( gadget -- ) f f @@ -125,6 +137,18 @@ repeat-button H{ [ set-button-selected? ] dup checkbox-theme ; +TUPLE: radio-paint color ; + +C: radio-paint + +M: radio-paint draw-interior + radio-paint-color gl-color + origin get { 4 4 } v+ swap rect-dim { 8 8 } v- 12 gl-fill-circle ; + +M: radio-paint draw-boundary + radio-paint-color gl-color + origin get { 1 1 } v+ swap rect-dim { 2 2 } v- 12 gl-circle ; + : radio-knob-theme ( gadget -- ) f f diff --git a/extra/ui/render/render.factor b/extra/ui/render/render.factor index 2c2f84c067..54615b08a2 100644 --- a/extra/ui/render/render.factor +++ b/extra/ui/render/render.factor @@ -140,32 +140,6 @@ M: polygon draw-interior >r r> over set-rect-dim [ set-gadget-interior ] keep ; -! Checkbox and radio button pens -TUPLE: checkmark-paint color ; - -C: checkmark-paint - -M: checkmark-paint draw-interior - checkmark-paint-color gl-color - origin get [ - rect-dim - { 0 0 } over gl-line - dup { 0 1 } v* swap { 1 0 } v* gl-line - ] with-translation ; - - -TUPLE: radio-paint color ; - -C: radio-paint - -M: radio-paint draw-interior - radio-paint-color gl-color - origin get { 4 4 } v+ swap rect-dim { 8 8 } v- 12 gl-fill-circle ; - -M: radio-paint draw-boundary - radio-paint-color gl-color - origin get { 1 1 } v+ swap rect-dim { 2 2 } v- 12 gl-circle ; - ! Font rendering SYMBOL: font-renderer From e0104549cb747318a582d3d74aefb0e0a9a0bac2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 3 Nov 2007 16:22:40 -0400 Subject: [PATCH 09/20] Move channels to unmaintained for the time being, so that load-everything can work --- {extra => unmaintained}/channels/authors.txt | 0 {extra => unmaintained}/channels/channels-docs.factor | 0 {extra => unmaintained}/channels/channels-tests.factor | 0 {extra => unmaintained}/channels/channels.factor | 0 {extra => unmaintained}/channels/examples/authors.txt | 0 {extra => unmaintained}/channels/examples/examples.factor | 0 {extra => unmaintained}/channels/examples/summary.txt | 0 {extra => unmaintained}/channels/examples/tags.txt | 0 {extra => unmaintained}/channels/remote/authors.txt | 0 {extra => unmaintained}/channels/remote/remote-docs.factor | 0 {extra => unmaintained}/channels/remote/remote-tests.factor | 0 {extra => unmaintained}/channels/remote/remote.factor | 0 {extra => unmaintained}/channels/remote/summary.txt | 0 {extra => unmaintained}/channels/remote/tags.txt | 0 {extra => unmaintained}/channels/sniffer/bsd/bsd.factor | 0 {extra => unmaintained}/channels/sniffer/sniffer.factor | 0 {extra => unmaintained}/channels/summary.txt | 0 {extra => unmaintained}/channels/tags.txt | 0 18 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/channels/authors.txt (100%) rename {extra => unmaintained}/channels/channels-docs.factor (100%) rename {extra => unmaintained}/channels/channels-tests.factor (100%) rename {extra => unmaintained}/channels/channels.factor (100%) rename {extra => unmaintained}/channels/examples/authors.txt (100%) rename {extra => unmaintained}/channels/examples/examples.factor (100%) rename {extra => unmaintained}/channels/examples/summary.txt (100%) rename {extra => unmaintained}/channels/examples/tags.txt (100%) rename {extra => unmaintained}/channels/remote/authors.txt (100%) rename {extra => unmaintained}/channels/remote/remote-docs.factor (100%) rename {extra => unmaintained}/channels/remote/remote-tests.factor (100%) rename {extra => unmaintained}/channels/remote/remote.factor (100%) rename {extra => unmaintained}/channels/remote/summary.txt (100%) rename {extra => unmaintained}/channels/remote/tags.txt (100%) rename {extra => unmaintained}/channels/sniffer/bsd/bsd.factor (100%) rename {extra => unmaintained}/channels/sniffer/sniffer.factor (100%) rename {extra => unmaintained}/channels/summary.txt (100%) rename {extra => unmaintained}/channels/tags.txt (100%) diff --git a/extra/channels/authors.txt b/unmaintained/channels/authors.txt similarity index 100% rename from extra/channels/authors.txt rename to unmaintained/channels/authors.txt diff --git a/extra/channels/channels-docs.factor b/unmaintained/channels/channels-docs.factor similarity index 100% rename from extra/channels/channels-docs.factor rename to unmaintained/channels/channels-docs.factor diff --git a/extra/channels/channels-tests.factor b/unmaintained/channels/channels-tests.factor similarity index 100% rename from extra/channels/channels-tests.factor rename to unmaintained/channels/channels-tests.factor diff --git a/extra/channels/channels.factor b/unmaintained/channels/channels.factor similarity index 100% rename from extra/channels/channels.factor rename to unmaintained/channels/channels.factor diff --git a/extra/channels/examples/authors.txt b/unmaintained/channels/examples/authors.txt similarity index 100% rename from extra/channels/examples/authors.txt rename to unmaintained/channels/examples/authors.txt diff --git a/extra/channels/examples/examples.factor b/unmaintained/channels/examples/examples.factor similarity index 100% rename from extra/channels/examples/examples.factor rename to unmaintained/channels/examples/examples.factor diff --git a/extra/channels/examples/summary.txt b/unmaintained/channels/examples/summary.txt similarity index 100% rename from extra/channels/examples/summary.txt rename to unmaintained/channels/examples/summary.txt diff --git a/extra/channels/examples/tags.txt b/unmaintained/channels/examples/tags.txt similarity index 100% rename from extra/channels/examples/tags.txt rename to unmaintained/channels/examples/tags.txt diff --git a/extra/channels/remote/authors.txt b/unmaintained/channels/remote/authors.txt similarity index 100% rename from extra/channels/remote/authors.txt rename to unmaintained/channels/remote/authors.txt diff --git a/extra/channels/remote/remote-docs.factor b/unmaintained/channels/remote/remote-docs.factor similarity index 100% rename from extra/channels/remote/remote-docs.factor rename to unmaintained/channels/remote/remote-docs.factor diff --git a/extra/channels/remote/remote-tests.factor b/unmaintained/channels/remote/remote-tests.factor similarity index 100% rename from extra/channels/remote/remote-tests.factor rename to unmaintained/channels/remote/remote-tests.factor diff --git a/extra/channels/remote/remote.factor b/unmaintained/channels/remote/remote.factor similarity index 100% rename from extra/channels/remote/remote.factor rename to unmaintained/channels/remote/remote.factor diff --git a/extra/channels/remote/summary.txt b/unmaintained/channels/remote/summary.txt similarity index 100% rename from extra/channels/remote/summary.txt rename to unmaintained/channels/remote/summary.txt diff --git a/extra/channels/remote/tags.txt b/unmaintained/channels/remote/tags.txt similarity index 100% rename from extra/channels/remote/tags.txt rename to unmaintained/channels/remote/tags.txt diff --git a/extra/channels/sniffer/bsd/bsd.factor b/unmaintained/channels/sniffer/bsd/bsd.factor similarity index 100% rename from extra/channels/sniffer/bsd/bsd.factor rename to unmaintained/channels/sniffer/bsd/bsd.factor diff --git a/extra/channels/sniffer/sniffer.factor b/unmaintained/channels/sniffer/sniffer.factor similarity index 100% rename from extra/channels/sniffer/sniffer.factor rename to unmaintained/channels/sniffer/sniffer.factor diff --git a/extra/channels/summary.txt b/unmaintained/channels/summary.txt similarity index 100% rename from extra/channels/summary.txt rename to unmaintained/channels/summary.txt diff --git a/extra/channels/tags.txt b/unmaintained/channels/tags.txt similarity index 100% rename from extra/channels/tags.txt rename to unmaintained/channels/tags.txt From d366ced0a823b67d2e197355027488801d03de9d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 3 Nov 2007 16:24:17 -0400 Subject: [PATCH 10/20] Fix load problem --- extra/ui/gadgets/buttons/buttons.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/ui/gadgets/buttons/buttons.factor b/extra/ui/gadgets/buttons/buttons.factor index a9142449e5..a4fc5a7c21 100644 --- a/extra/ui/gadgets/buttons/buttons.factor +++ b/extra/ui/gadgets/buttons/buttons.factor @@ -4,7 +4,8 @@ USING: arrays ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.controls ui.gadgets.labels ui.gadgets.theme ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.render kernel math models namespaces sequences strings -quotations assocs combinators classes colors tuples ; +quotations assocs combinators classes colors tuples opengl +math.vectors ; IN: ui.gadgets.buttons TUPLE: button pressed? selected? quot ; From 1364674546202e2e4fe5139eb0463968b19d2f91 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 4 Nov 2007 13:42:18 -0600 Subject: [PATCH 11/20] Added execv, and some constants used with waitpid to unix vocab --- extra/unix/unix.factor | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index ca4b569587..0854754dcb 100644 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -107,6 +107,7 @@ FUNCTION: void close ( int fd ) ; FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ; FUNCTION: int dup2 ( int oldd, int newd ) ; ! FUNCTION: int dup ( int oldd ) ; +FUNCTION: int execv ( char* path, char** argv ) ; FUNCTION: int execvp ( char* path, char** argv ) ; FUNCTION: int execve ( char* path, char** argv, char** envp ) ; FUNCTION: int fchdir ( int fd ) ; @@ -164,6 +165,18 @@ FUNCTION: int system ( char* command ) ; FUNCTION: time_t time ( time_t* t ) ; FUNCTION: int unlink ( char* path ) ; FUNCTION: int utimes ( char* path, timeval[2] times ) ; + +! Flags for waitpid + +: WNOHANG 1 ; +: WUNTRACED 2 ; + +: WSTOPPED 2 ; +: WEXITED 4 ; +: WCONTINUED 8 ; +: WNOWAIT HEX: 1000000 ; + FUNCTION: pid_t wait ( int* status ) ; FUNCTION: pid_t waitpid ( pid_t wpid, int* status, int options ) ; + FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; From 7b3fee0b640b47df26b84ce79a7440dcbbd1766b Mon Sep 17 00:00:00 2001 From: "Zed A. Shaw" Date: Sun, 4 Nov 2007 17:23:33 -0500 Subject: [PATCH 12/20] Bug fix for range to restrict results to within assigned range. Tests for all range behavior. --- extra/models/models-tests.factor | 39 ++++++++++++++++++++++++++++++-- extra/models/models.factor | 2 +- 2 files changed, 38 insertions(+), 3 deletions(-) diff --git a/extra/models/models-tests.factor b/extra/models/models-tests.factor index 97751c1858..e47e1a66c3 100644 --- a/extra/models/models-tests.factor +++ b/extra/models/models-tests.factor @@ -1,6 +1,6 @@ IN: temporary -USING: arrays generic kernel math models namespaces sequences -tools.test assocs ; +USING: arrays generic kernel math models namespaces sequences assocs +tools.test ; TUPLE: model-tester hit? ; @@ -137,3 +137,38 @@ f "history" set ] unit-test [ ] [ "m" get deactivate-model ] unit-test + +! Test +: setup-range 0 0 0 255 ; + +! clamp-value should not go past range ends +[ 0 ] [ -10 setup-range clamp-value ] unit-test +[ 255 ] [ 2000 setup-range clamp-value ] unit-test +[ 14 ] [ 14 setup-range clamp-value ] unit-test + +! range min/max/page values should be correct +[ 0 ] [ setup-range range-page-value ] unit-test +[ 0 ] [ setup-range range-min-value ] unit-test +[ 255 ] [ setup-range range-max-value ] unit-test + +! should be able to set the value within the range and get back +[ 15 ] [ setup-range 15 over set-range-value range-value ] unit-test +[ 0 ] [ setup-range -15 over set-range-value range-value ] unit-test +[ 255 ] [ setup-range 4000 over set-range-value range-value ] unit-test + +! should be able to change the range min/max/page value +[ 1 ] [ setup-range 1 over set-range-page-value range-page-value ] unit-test +[ 50 ] [ setup-range 50 over set-range-min-value range-min-value ] unit-test +[ 4000 ] [ setup-range 4000 over set-range-max-value range-max-value ] unit-test + +! should be able to move by positive and negative values +[ 30 ] [ setup-range 30 over move-by range-value ] unit-test +[ 0 ] [ setup-range 30 over move-by -30 over move-by range-value ] unit-test + +! should be able to move by a page of 10 +[ 10 ] [ + setup-range 10 over set-range-page-value + 1 over move-by-page range-value +] unit-test + + diff --git a/extra/models/models.factor b/extra/models/models.factor index 59f888b0e0..724d6e45f4 100644 --- a/extra/models/models.factor +++ b/extra/models/models.factor @@ -207,7 +207,7 @@ M: range range-max-value range-max model-value ; M: range range-max-value* dup range-max-value swap range-page-value [-] ; -M: range set-range-value range-model set-model ; +M: range set-range-value [ clamp-value ] keep range-model set-model ; M: range set-range-page-value range-page set-model ; From dfeb154bb1ed28a9932d99ac161ccc303395786f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 4 Nov 2007 17:32:01 -0500 Subject: [PATCH 13/20] Change unfold word --- core/bootstrap/image/image.factor | 2 +- core/classes/classes.factor | 2 +- core/io/io.factor | 2 +- core/sequences/sequences.factor | 10 ++++------ core/tuples/tuples.factor | 2 +- extra/concurrency/concurrency.factor | 2 +- extra/io/sockets/impl/impl.factor | 21 +++++++++++---------- extra/ui/gadgets/borders/borders.factor | 3 ++- extra/ui/gadgets/gadgets.factor | 4 ++-- 9 files changed, 24 insertions(+), 24 deletions(-) diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index ba0e4800fb..f6f3e5c0da 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -157,7 +157,7 @@ GENERIC: ' ( obj -- ptr ) #! n is positive or zero. [ dup 0 > ] [ dup bignum-bits neg shift swap bignum-radix bitand ] - { } unfold ; + [ ] unfold nip ; : emit-bignum ( n -- ) dup 0 < [ 1 swap neg ] [ 0 swap ] if bignum>seq diff --git a/core/classes/classes.factor b/core/classes/classes.factor index a17866aa3b..d9f2c71f74 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -133,7 +133,7 @@ PRIVATE> >vector [ dup empty? not ] [ dup largest-class >r over delete-nth r> ] - { } unfold ; + [ ] unfold nip ; : class-or ( class1 class2 -- class ) { diff --git a/core/io/io.factor b/core/io/io.factor index d00a208e4e..cc0d2cc8e5 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -86,7 +86,7 @@ SYMBOL: stdio presented associate format ; : lines ( stream -- seq ) - [ [ readln dup ] [ ] { } unfold ] with-stream ; + [ [ readln dup ] [ ] [ drop ] unfold ] with-stream ; : contents ( stream -- str ) 2048 [ stream-copy ] keep >string ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index dedbbfc59d..2f6bb7ad57 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -414,12 +414,10 @@ PRIVATE> : interleave ( seq between quot -- ) [ (interleave) ] 2curry iterate-seq 2each ; inline -: unfold ( obj pred quot exemplar -- seq ) - [ - 10 swap new-resizable [ - [ push ] curry compose [ drop ] while - ] keep - ] keep like ; inline +: unfold ( pred quot tail -- seq ) + V{ } clone [ + swap >r [ push ] curry compose r> while + ] keep { } like ; inline : index ( obj seq -- n ) [ = ] curry* find drop ; diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index edd37abb65..4369a56d23 100644 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -107,7 +107,7 @@ M: tuple equal? [ dup , delegate (delegates) ] when* ; : delegates ( obj -- seq ) - [ dup ] [ [ delegate ] keep ] { } unfold ; + [ dup ] [ [ delegate ] keep ] [ ] unfold nip ; : is? ( obj quot -- ? ) >r delegates r> contains? ; inline diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor index b59f758ad8..e885877a37 100644 --- a/extra/concurrency/concurrency.factor +++ b/extra/concurrency/concurrency.factor @@ -60,7 +60,7 @@ PRIVATE> (mailbox-block-if-empty) [ dup mailbox-empty? ] [ dup mailbox-data dlist-pop-front ] - { } unfold ; + [ ] unfold nip ; : mailbox-get-all ( mailbox -- array ) f mailbox-get-all* ; diff --git a/extra/io/sockets/impl/impl.factor b/extra/io/sockets/impl/impl.factor index b03ec94a6b..426eda9c76 100644 --- a/extra/io/sockets/impl/impl.factor +++ b/extra/io/sockets/impl/impl.factor @@ -12,7 +12,10 @@ GENERIC: protocol-family ( addrspec -- af ) GENERIC: sockaddr-type ( addrspec -- type ) -GENERIC: make-sockaddr ( addrspec -- sockaddr type ) +GENERIC: make-sockaddr ( addrspec -- sockaddr ) + +: make-sockaddr/size ( addrspec -- sockaddr size ) + dup make-sockaddr swap sockaddr-type heap-size ; GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec ) @@ -36,16 +39,15 @@ M: inet4 address-size drop 4 ; M: inet4 protocol-family drop PF_INET ; -M: inet4 sockaddr-type drop "sockaddr-in" ; +M: inet4 sockaddr-type drop "sockaddr-in" c-type ; -M: inet4 make-sockaddr ( inet -- sockaddr type ) +M: inet4 make-sockaddr ( inet -- sockaddr ) "sockaddr-in" AF_INET over set-sockaddr-in-family over inet4-port htons over set-sockaddr-in-port over inet4-host "0.0.0.0" or - rot inet-pton *uint over set-sockaddr-in-addr - "sockaddr-in" ; + rot inet-pton *uint over set-sockaddr-in-addr ; M: inet4 parse-sockaddr >r dup sockaddr-in-addr r> inet-ntop @@ -65,15 +67,14 @@ M: inet6 address-size drop 16 ; M: inet6 protocol-family drop PF_INET6 ; -M: inet6 sockaddr-type drop "sockaddr-in6" ; +M: inet6 sockaddr-type drop "sockaddr-in6" c-type ; -M: inet6 make-sockaddr ( inet -- sockaddr type ) +M: inet6 make-sockaddr ( inet -- sockaddr ) "sockaddr-in6" AF_INET6 over set-sockaddr-in6-family over inet6-port htons over set-sockaddr-in6-port over inet6-host "::" or - rot inet-pton over set-sockaddr-in6-addr - "sockaddr-in6" ; + rot inet-pton over set-sockaddr-in6-addr ; M: inet6 parse-sockaddr >r dup sockaddr-in6-addr r> inet-ntop @@ -97,7 +98,7 @@ M: f parse-sockaddr nip ; : parse-addrinfo-list ( addrinfo -- seq ) [ dup ] [ dup addrinfo-next swap addrinfo>addrspec ] - { } unfold [ ] subset ; + [ ] unfold nip [ ] subset ; M: object resolve-host ( host serv passive? -- seq ) >r dup integer? [ number>string ] when diff --git a/extra/ui/gadgets/borders/borders.factor b/extra/ui/gadgets/borders/borders.factor index f0099e2f91..e58ba343c7 100644 --- a/extra/ui/gadgets/borders/borders.factor +++ b/extra/ui/gadgets/borders/borders.factor @@ -20,7 +20,8 @@ M: border pref-dim* : border-minor-rect ( major border -- rect ) gadget-child pref-dim - [ >r rect-bounds r> v- 2 v/n v+ ] keep ; + [ >r rect-bounds r> v- [ 2 / >fixnum ] map v+ ] keep + ; : scale-rect ( rect vec -- loc dim ) [ v* ] curry >r rect-bounds r> 2apply ; diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index 214c5b4921..dddab1aa8a 100644 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -286,7 +286,7 @@ M: gadget ungraft* drop ; swap [ over (add-gadget) ] each relayout ; : parents ( gadget -- seq ) - [ dup ] [ [ gadget-parent ] keep ] { } unfold ; + [ dup ] [ [ gadget-parent ] keep ] [ ] unfold nip ; : each-parent ( gadget quot -- ? ) >r parents r> all? ; inline @@ -333,7 +333,7 @@ M: f request-focus-on 2drop ; dup focusable-child swap request-focus-on ; : focus-path ( world -- seq ) - [ dup ] [ [ gadget-focus ] keep ] { } unfold ; + [ dup ] [ [ gadget-focus ] keep ] [ ] unfold nip ; : make-gadget ( quot gadget -- gadget ) [ \ make-gadget rot with-variable ] keep ; inline From de582084a40f66eedb3450a263e26d38968296bd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 4 Nov 2007 17:32:18 -0500 Subject: [PATCH 14/20] Refactor I/O a bit so that C types are resolved at compile time -- better for deployment --- extra/io/unix/sockets/sockets.factor | 13 ++++++------- extra/io/windows/ce/ce.factor | 4 ++-- extra/io/windows/nt/sockets/sockets.factor | 9 ++++----- extra/io/windows/windows.factor | 2 +- 4 files changed, 13 insertions(+), 15 deletions(-) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 43c8224c2c..0787a1afde 100644 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -45,9 +45,9 @@ M: connect-task task-container drop write-tasks get-global ; [ swap add-io-task stop ] callcc0 drop ; M: unix-io (client) ( addrspec -- stream ) - dup make-sockaddr >r >r + dup make-sockaddr/size >r >r protocol-family SOCK_STREAM socket-fd - dup r> r> heap-size connect + dup r> r> connect zero? err_no EINPROGRESS = or [ dup init-client-socket dup handle>duplex-stream @@ -92,7 +92,7 @@ USE: io.sockets : server-fd ( addrspec type -- fd ) >r dup protocol-family r> socket-fd dup init-server-socket - dup rot make-sockaddr heap-size bind + dup rot make-sockaddr/size bind zero? [ dup close (io-error) ] unless ; M: unix-io ( addrspec -- stream ) @@ -190,20 +190,19 @@ M: send-task task-container drop write-tasks get ; M: unix-io send ( packet addrspec datagram -- ) 3dup check-datagram-send - [ >r make-sockaddr heap-size r> wait-send ] keep + [ >r make-sockaddr/size r> wait-send ] keep pending-error ; M: local protocol-family drop PF_UNIX ; -M: local sockaddr-type drop "sockaddr-un" ; +M: local sockaddr-type drop "sockaddr-un" c-type ; M: local make-sockaddr local-path dup length 1 + max-un-path > [ "Path too long" throw ] when "sockaddr-un" AF_UNIX over set-sockaddr-un-family - dup sockaddr-un-path rot string>char-alien dup length memcpy - "sockaddr-un" ; + dup sockaddr-un-path rot string>char-alien dup length memcpy ; M: local parse-sockaddr drop diff --git a/extra/io/windows/ce/ce.factor b/extra/io/windows/ce/ce.factor index 7023d88989..b45f2df4d7 100644 --- a/extra/io/windows/ce/ce.factor +++ b/extra/io/windows/ce/ce.factor @@ -153,7 +153,7 @@ M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ; : do-connect ( addrspec -- socket ) [ tcp-socket dup ] keep - make-sockaddr heap-size + make-sockaddr/size f f f f windows.winsock:WSAConnect zero? [ winsock-error-string throw ] unless ; @@ -227,7 +227,7 @@ M: windows-ce-io send ( packet addrspec datagram -- ) [ windows.winsock:set-WSABUF-len ] keep [ windows.winsock:set-WSABUF-buf ] keep - rot make-sockaddr heap-size + rot make-sockaddr/size >r >r 1 0 0 r> r> f f windows.winsock:WSASendTo zero? [ winsock-error-string throw diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index 0767c08002..1b6288eb1d 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -29,8 +29,7 @@ TUPLE: ConnectEx-args port s* name* namelen* lpSendBuffer* dwSendDataLength* lpdwBytesSent* lpOverlapped* ptr* ; -: init-connect ( sockaddr sockaddr-name ConnectEx -- ) - >r heap-size r> +: init-connect ( sockaddr size ConnectEx -- ) [ set-ConnectEx-args-namelen* ] keep [ set-ConnectEx-args-name* ] keep f over set-ConnectEx-args-lpSendBuffer* @@ -55,7 +54,7 @@ TUPLE: ConnectEx-args port M: windows-nt-io (client) ( addrspec -- duplex-stream ) [ \ ConnectEx-args construct-empty - over make-sockaddr pick init-connect + over make-sockaddr/size pick init-connect over tcp-socket over set-ConnectEx-args-s* dup ConnectEx-args-s* add-completion dup ConnectEx-args-s* get-ConnectEx-ptr over set-ConnectEx-args-ptr* @@ -229,9 +228,9 @@ TUPLE: WSASendTo-args port >r delegate port-handle delegate win32-file-handle r> set-WSASendTo-args-s* ] keep [ - >r make-sockaddr >r + >r make-sockaddr/size >r malloc-byte-array dup free-always - r> heap-size r> + r> r> [ set-WSASendTo-args-iToLen* ] keep set-WSASendTo-args-lpTo* ] keep [ diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index f46af26568..8d6d7cb6f2 100644 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -175,7 +175,7 @@ USE: windows.winsock : server-fd ( addrspec type -- fd ) >r dup protocol-family r> open-socket dup close-socket-later - dup rot make-sockaddr heap-size bind socket-error ; + dup rot make-sockaddr/size bind socket-error ; USE: namespaces From 781bd15625ff394c921451d0b355d3c4b60e4134 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 4 Nov 2007 17:33:18 -0500 Subject: [PATCH 15/20] Fix long line --- extra/models/models.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/models/models.factor b/extra/models/models.factor index 724d6e45f4..d76269eaf0 100644 --- a/extra/models/models.factor +++ b/extra/models/models.factor @@ -207,7 +207,8 @@ M: range range-max-value range-max model-value ; M: range range-max-value* dup range-max-value swap range-page-value [-] ; -M: range set-range-value [ clamp-value ] keep range-model set-model ; +M: range set-range-value + [ clamp-value ] keep range-model set-model ; M: range set-range-page-value range-page set-model ; From 613cdb94290c05ac41e70a50699f743ee6170583 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 4 Nov 2007 18:05:49 -0500 Subject: [PATCH 16/20] Documentation updates --- core/kernel/kernel-docs.factor | 14 ++++++++++++++ core/sequences/sequences-docs.factor | 14 +++++++++++++- 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 5251f2b231..84ee4fe5cf 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -60,6 +60,8 @@ $nl "A pair of utility words built from " { $link 2apply } ":" { $subsection both? } { $subsection either? } +"A looping combinator:" +{ $subsection while } "Quotations can be composed using efficient quotation-specific operations:" { $subsection curry } { $subsection 2curry } @@ -538,3 +540,15 @@ HELP: 3compose } "However, " { $link 3compose } " runs in constant time, and the compiler is able to compile code which calls composed quotations." } ; + +HELP: while +{ $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "quot" "a quotation" } { "tail" "a quotation" } } +{ $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "quot" } " is called. After iteration stops, " { $snippet "tail" } " is called." } +{ $notes "In most cases, tail recursion should be used, because it is simpler both in terms of implementation and conceptually. However in some cases this combinator expresses intent better and should be used." +$nl +"Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:" +{ $code + "[ P ] [ Q ] [ T ] while" + "[ P ] [ Q ] [ ] while T" +} +"However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference." } ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index c8c5577eb1..072fc0da08 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -127,8 +127,9 @@ ARTICLE: "sequences-combinators" "Sequence combinators" { $subsection 2reduce } "Mapping:" { $subsection map } -{ $subsection accumulate } { $subsection 2map } +{ $subsection accumulate } +{ $subsection unfold } "Filtering:" { $subsection push-if } { $subsection subset } ; @@ -230,6 +231,7 @@ $nl { $subsection "sequences-tests" } { $subsection "sequences-search" } { $subsection "sequences-comparing" } +{ $subsection "sequences-split" } { $subsection "sequences-destructive" } { $subsection "sequences-stacks" } "For inner loops:" @@ -961,3 +963,13 @@ HELP: supremum { $values { "seq" "a sequence of real numbers" } { "n" "a number" } } { $description "Outputs the greatest element of " { $snippet "seq" } "." } { $errors "Throws an error if the sequence is empty." } ; + +HELP: unfold +{ $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "quot" "a quotation with stack effect " { $snippet "( -- obj )" } } { "tail" "a quotation" } { "seq" "a sequence" } } +{ $description "Calls " { $snippet "pred" } " repeatedly. If the predicate yields " { $link f } ", stops, otherwise, calls " { $snippet "quot" } " to yield a value. Values are accumulated and returned in a sequence at the end." } +{ $examples + "The following example divides a number by two until we reach zero, and accumulates intermediate results:" + { $example "1337 [ dup 0 > ] [ 2/ dup ] [ ] unfold nip ." "{ 668 334 167 83 41 20 10 5 2 1 0 }" } + "The " { $snippet "tail" } " quotation is used when the predicate produces more than one output value. In this case, we have to drop this value even if the predicate fails in order for stack inference to calculate a stack effect for the " { $link unfold } " call:" + { $unchecked-example "[ 10 random dup 1 > ] [ ] [ drop ] unfold ." "{ 8 2 2 9 }" } +} ; From 4cc86d74ffb9f746c95676da30f3eea02960fccc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 4 Nov 2007 18:06:34 -0500 Subject: [PATCH 17/20] Update more libraries for unfold change --- extra/help/crossref/crossref.factor | 2 +- extra/serialize/serialize.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/help/crossref/crossref.factor b/extra/help/crossref/crossref.factor index 9597a51471..d7f4ec8b1b 100644 --- a/extra/help/crossref/crossref.factor +++ b/extra/help/crossref/crossref.factor @@ -14,7 +14,7 @@ M: link uses collect-elements [ \ f or ] map ; : help-path ( topic -- seq ) - [ dup ] [ [ article-parent ] keep ] { } unfold 1 tail ; + [ dup ] [ [ article-parent ] keep ] [ ] unfold nip 1 tail ; : set-article-parents ( parent article -- ) article-children [ set-article-parent ] curry* each ; diff --git a/extra/serialize/serialize.factor b/extra/serialize/serialize.factor index 632ed763fb..fd04c86e03 100644 --- a/extra/serialize/serialize.factor +++ b/extra/serialize/serialize.factor @@ -261,7 +261,7 @@ DEFER: (deserialize) ( -- obj ) V{ } clone serialized rot with-variable ; inline : deserialize-sequence ( -- seq ) - [ [ deserialize* ] [ ] { } unfold ] with-serialized ; + [ [ deserialize* ] [ ] [ drop ] unfold ] with-serialized ; : deserialize ( -- obj ) [ (deserialize) ] with-serialized ; From 092d18d1b945c6b3fcbc507419561bcae907700a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 4 Nov 2007 18:06:47 -0500 Subject: [PATCH 18/20] OpenGL errors are now thrown instaed of just being printed --- extra/opengl/opengl.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index d796c2611d..fbd935da4c 100644 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! Portions copyright (C) 2007 Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types io kernel math namespaces -sequences math.vectors math.constants math.functions opengl.gl opengl.glu combinators arrays ; +USING: alien alien.c-types kernel math namespaces sequences +math.vectors math.constants math.functions opengl.gl opengl.glu +combinators arrays ; IN: opengl : coordinates [ first2 ] 2apply ; @@ -19,7 +20,7 @@ IN: opengl : gl-error ( -- ) glGetError dup zero? [ - "GL error: " write dup gluErrorString print flush + "GL error: " dup gluErrorString append throw ] unless drop ; : do-state ( what quot -- ) From 72c1276837ed5ff786d955284cf14011ba175b7e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 4 Nov 2007 18:07:03 -0500 Subject: [PATCH 19/20] Update editors docs --- extra/editors/editors-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/editors/editors-docs.factor b/extra/editors/editors-docs.factor index 9fa505351a..2b9e4cc021 100644 --- a/extra/editors/editors-docs.factor +++ b/extra/editors/editors-docs.factor @@ -4,8 +4,8 @@ IN: editors ARTICLE: "editor" "Editor integration" "Factor development is best done with one of the supported editors; this allows you to quickly jump to definitions from the Factor environment." { $subsection edit } -"Depending on the editor you are using, you must load one of the child vocabularies of the " { $vocab-link "editors" } " vocabulary, for example " { $vocab-link "editors.emacs" } "." -$nl +"Depending on the editor you are using, you must load one of the child vocabularies of the " { $vocab-link "editors" } " vocabulary, for example " { $vocab-link "editors.emacs" } ", for example:" +{ $code "USE: editors.emacs" } "Editor integration vocabularies store a quotation in a global variable when loaded:" { $subsection edit-hook } "If a syntax error was thrown while loading a source file, you can jump to the location of the error in your editor:" From cf39de0a334b5c78bd0bc77d7f28e06a904647bf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 4 Nov 2007 18:07:11 -0500 Subject: [PATCH 20/20] Remove breakpoints from extra/mad --- extra/mad/api/api.factor | 1 - extra/mad/player/player.factor | 1 - 2 files changed, 2 deletions(-) diff --git a/extra/mad/api/api.factor b/extra/mad/api/api.factor index 4905424300..e3178b95f9 100644 --- a/extra/mad/api/api.factor +++ b/extra/mad/api/api.factor @@ -52,7 +52,6 @@ VARS: buffer-start buffer-length output-callback-var ; : output ( data header pcm -- mad_flow ) "output" . flush - break -rot 2drop output-callback-var> call [ MAD_FLOW_CONTINUE ] [ MAD_FLOW_STOP ] if ; diff --git a/extra/mad/player/player.factor b/extra/mad/player/player.factor index 417fc5145b..3d0b1c16c2 100644 --- a/extra/mad/player/player.factor +++ b/extra/mad/player/player.factor @@ -47,7 +47,6 @@ VARS: openal-buffer ; malloc [ fill-data ] keep ; : output-openal ( pcm -- ? ) - break openal-buffer> swap ! buffer pcm [ get-format ] keep ! buffer format pcm [ get-data ] keep ! buffer format size alien pcm