diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor index adf79c84c9..bd1f02c44c 100755 --- a/extra/alarms/alarms.factor +++ b/extra/alarms/alarms.factor @@ -21,7 +21,7 @@ SYMBOL: alarm-thread pick callable? [ "Not a quotation" throw ] unless ; inline : ( quot time frequency -- alarm ) - check-alarm alarm construct-boa ; + check-alarm alarm boa ; : register-alarm ( alarm -- ) dup dup alarm-time alarms get-global heap-push* diff --git a/extra/asn1/asn1.factor b/extra/asn1/asn1.factor index 8954ffd8cc..32e3602f8f 100644 --- a/extra/asn1/asn1.factor +++ b/extra/asn1/asn1.factor @@ -48,7 +48,7 @@ SYMBOL: elements TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ; -: element construct-empty ; +: element new ; : set-id ( -- boolean ) read1 dup elements get set-element-id ; @@ -172,7 +172,7 @@ SYMBOL: tagnum TUPLE: tag value ; -: ( -- ) 4 tag construct-boa ; +: ( -- ) 4 tag boa ; : with-ber ( quot -- ) [ diff --git a/extra/benchmark/dispatch1/dispatch1.factor b/extra/benchmark/dispatch1/dispatch1.factor index f81f70a613..3317348f45 100644 --- a/extra/benchmark/dispatch1/dispatch1.factor +++ b/extra/benchmark/dispatch1/dispatch1.factor @@ -68,7 +68,7 @@ M: x30 g ; "benchmark.dispatch1" words [ tuple-class? ] subset ; : a-bunch-of-objects ( -- seq ) - my-classes [ construct-empty ] map ; + my-classes [ new ] map ; : dispatch-benchmark ( -- ) 1000000 a-bunch-of-objects diff --git a/extra/benchmark/dispatch5/dispatch5.factor b/extra/benchmark/dispatch5/dispatch5.factor index 34df715f89..a2f096695b 100755 --- a/extra/benchmark/dispatch5/dispatch5.factor +++ b/extra/benchmark/dispatch5/dispatch5.factor @@ -68,7 +68,7 @@ INSTANCE: x30 g "benchmark.dispatch5" words [ tuple-class? ] subset ; : a-bunch-of-objects ( -- seq ) - my-classes [ construct-empty ] map ; + my-classes [ new ] map ; : dispatch-benchmark ( -- ) 1000000 a-bunch-of-objects diff --git a/extra/benchmark/typecheck1/typecheck1.factor b/extra/benchmark/typecheck1/typecheck1.factor index 25f543212f..fd7bb6e802 100644 --- a/extra/benchmark/typecheck1/typecheck1.factor +++ b/extra/benchmark/typecheck1/typecheck1.factor @@ -5,6 +5,6 @@ TUPLE: hello n ; : foo 0 100000000 [ over hello-n + ] times ; -: typecheck-main 0 hello construct-boa foo 2drop ; +: typecheck-main 0 hello boa foo 2drop ; MAIN: typecheck-main diff --git a/extra/benchmark/typecheck2/typecheck2.factor b/extra/benchmark/typecheck2/typecheck2.factor index 0fc1debb67..0dfcc17c66 100644 --- a/extra/benchmark/typecheck2/typecheck2.factor +++ b/extra/benchmark/typecheck2/typecheck2.factor @@ -7,6 +7,6 @@ TUPLE: hello n ; : foo 0 100000000 [ over hello-n* + ] times ; -: typecheck-main 0 hello construct-boa foo 2drop ; +: typecheck-main 0 hello boa foo 2drop ; MAIN: typecheck-main diff --git a/extra/benchmark/typecheck3/typecheck3.factor b/extra/benchmark/typecheck3/typecheck3.factor index 9a58e0a795..3ca6a9f9e7 100644 --- a/extra/benchmark/typecheck3/typecheck3.factor +++ b/extra/benchmark/typecheck3/typecheck3.factor @@ -7,6 +7,6 @@ TUPLE: hello n ; : foo 0 100000000 [ over hello-n* + ] times ; -: typecheck-main 0 hello construct-boa foo 2drop ; +: typecheck-main 0 hello boa foo 2drop ; MAIN: typecheck-main diff --git a/extra/benchmark/typecheck4/typecheck4.factor b/extra/benchmark/typecheck4/typecheck4.factor index eb211e97e7..cc3310fef6 100644 --- a/extra/benchmark/typecheck4/typecheck4.factor +++ b/extra/benchmark/typecheck4/typecheck4.factor @@ -7,6 +7,6 @@ TUPLE: hello n ; : foo 0 100000000 [ over hello-n* + ] times ; -: typecheck-main 0 hello construct-boa foo 2drop ; +: typecheck-main 0 hello boa foo 2drop ; MAIN: typecheck-main diff --git a/extra/bitfields/bitfields.factor b/extra/bitfields/bitfields.factor index 114809377b..fca0568adf 100644 --- a/extra/bitfields/bitfields.factor +++ b/extra/bitfields/bitfields.factor @@ -24,7 +24,7 @@ TUPLE: check< number bound ; M: check< summary drop "Number exceeds upper bound" ; : check< ( num cmp -- num ) - 2dup < [ drop ] [ \ check< construct-boa throw ] if ; + 2dup < [ drop ] [ \ check< boa throw ] if ; : ?check ( length -- ) safe-bitfields? get [ 2^ , \ check< , ] [ drop ] if ; diff --git a/extra/bubble-chamber/particle/axion/axion.factor b/extra/bubble-chamber/particle/axion/axion.factor index 9e9bf99272..54865894c6 100644 --- a/extra/bubble-chamber/particle/axion/axion.factor +++ b/extra/bubble-chamber/particle/axion/axion.factor @@ -9,7 +9,7 @@ IN: bubble-chamber.particle.axion TUPLE: axion < particle ; -: ( -- axion ) axion construct-empty initialize-particle ; +: ( -- axion ) axion new initialize-particle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/bubble-chamber/particle/hadron/hadron.factor b/extra/bubble-chamber/particle/hadron/hadron.factor index 2994577838..9eecf2dd93 100644 --- a/extra/bubble-chamber/particle/hadron/hadron.factor +++ b/extra/bubble-chamber/particle/hadron/hadron.factor @@ -11,7 +11,7 @@ IN: bubble-chamber.particle.hadron TUPLE: hadron < particle ; -: ( -- hadron ) hadron construct-empty initialize-particle ; +: ( -- hadron ) hadron new initialize-particle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/bubble-chamber/particle/muon/muon.factor b/extra/bubble-chamber/particle/muon/muon.factor index 44c7d9f134..a61526fdf7 100644 --- a/extra/bubble-chamber/particle/muon/muon.factor +++ b/extra/bubble-chamber/particle/muon/muon.factor @@ -17,7 +17,7 @@ IN: bubble-chamber.particle.muon TUPLE: muon < particle ; -: ( -- muon ) muon construct-empty initialize-particle ; +: ( -- muon ) muon new initialize-particle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/bubble-chamber/particle/quark/quark.factor b/extra/bubble-chamber/particle/quark/quark.factor index 32d95c8f00..595c3b5329 100644 --- a/extra/bubble-chamber/particle/quark/quark.factor +++ b/extra/bubble-chamber/particle/quark/quark.factor @@ -8,7 +8,7 @@ IN: bubble-chamber.particle.quark TUPLE: quark < particle ; -: ( -- quark ) quark construct-empty initialize-particle ; +: ( -- quark ) quark new initialize-particle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 6010a340a7..897a30c417 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -61,7 +61,7 @@ TUPLE: bunny-buffers array element-array nv ni ; : ( model -- geom ) GL_COMPILE [ first3 draw-triangles ] make-dlist - bunny-dlist construct-boa ; + bunny-dlist boa ; : ( model -- geom ) { @@ -76,7 +76,7 @@ TUPLE: bunny-buffers array element-array nv ni ; ] [ first length 3 * ] [ third length 3 * ] - } cleave bunny-buffers construct-boa ; + } cleave bunny-buffers boa ; GENERIC: bunny-geom ( geom -- ) GENERIC: draw-bunny ( geom draw -- ) diff --git a/extra/cairo/png/png.factor b/extra/cairo/png/png.factor index 2fc2a26c6a..1bbad29835 100755 --- a/extra/cairo/png/png.factor +++ b/extra/cairo/png/png.factor @@ -29,7 +29,7 @@ ERROR: cairo-error string ; dup cairo_surface_status cairo-png-error dup [ cairo_image_surface_get_width check-zero ] [ cairo_image_surface_get_height check-zero ] [ ] tri - cairo-surface>array png construct-boa ; + cairo-surface>array png boa ; : write-png ( png path -- ) >r png-surface r> diff --git a/extra/channels/channels.factor b/extra/channels/channels.factor index 8fe36ab454..ea54766ad4 100755 --- a/extra/channels/channels.factor +++ b/extra/channels/channels.factor @@ -9,7 +9,7 @@ IN: channels TUPLE: channel receivers senders ; : ( -- channel ) - V{ } clone V{ } clone channel construct-boa ; + V{ } clone V{ } clone channel boa ; GENERIC: to ( value channel -- ) GENERIC: from ( channel -- value ) diff --git a/extra/circular/circular.factor b/extra/circular/circular.factor index b6e350a9e5..77dfb55766 100755 --- a/extra/circular/circular.factor +++ b/extra/circular/circular.factor @@ -9,7 +9,7 @@ IN: circular TUPLE: circular seq start ; : ( seq -- circular ) - 0 circular construct-boa ; + 0 circular boa ; : circular-wrap ( n circular -- n circular ) [ start>> + ] keep diff --git a/extra/classes/tuple/lib/lib-docs.factor b/extra/classes/tuple/lib/lib-docs.factor index 20431da07b..34dd181d3b 100644 --- a/extra/classes/tuple/lib/lib-docs.factor +++ b/extra/classes/tuple/lib/lib-docs.factor @@ -7,7 +7,7 @@ HELP: >tuple< { $example "USING: kernel prettyprint classes.tuple.lib ;" "TUPLE: foo a b c ;" - "1 2 3 \\ foo construct-boa \\ foo >tuple< .s" + "1 2 3 \\ foo boa \\ foo >tuple< .s" "1\n2\n3" } { $notes "Words using " { $snippet ">tuple<" } " may be compiled." } @@ -19,7 +19,7 @@ HELP: >tuple*< { $example "USING: kernel prettyprint classes.tuple.lib ;" "TUPLE: foo a bb* ccc dddd* ;" - "1 2 3 4 \\ foo construct-boa \\ foo >tuple*< .s" + "1 2 3 4 \\ foo boa \\ foo >tuple*< .s" "2\n4" } { $notes "Words using " { $snippet ">tuple*<" } " may be compiled." } diff --git a/extra/classes/tuple/lib/lib-tests.factor b/extra/classes/tuple/lib/lib-tests.factor index 328f83d714..7f7f24ab56 100644 --- a/extra/classes/tuple/lib/lib-tests.factor +++ b/extra/classes/tuple/lib/lib-tests.factor @@ -3,6 +3,6 @@ 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 construct-boa \ foo >tuple< ] unit-test -[ 2 4 6 ] [ 1 2 3 4 5 6 \ foo construct-boa \ foo >tuple*< ] unit-test +[ 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/cocoa/application/application.factor b/extra/cocoa/application/application.factor index 129b949b1d..2ae17a1604 100755 --- a/extra/cocoa/application/application.factor +++ b/extra/cocoa/application/application.factor @@ -49,7 +49,7 @@ IN: cocoa.application TUPLE: objc-error alien reason ; : objc-error ( alien -- * ) - dup -> reason CF>string \ objc-error construct-boa throw ; + dup -> reason CF>string \ objc-error boa throw ; M: objc-error summary ( error -- ) drop "Objective C exception" ; diff --git a/extra/cocoa/messages/messages.factor b/extra/cocoa/messages/messages.factor index 90dc19a581..5ae02ec66a 100755 --- a/extra/cocoa/messages/messages.factor +++ b/extra/cocoa/messages/messages.factor @@ -43,7 +43,7 @@ super-message-senders global [ H{ } assoc-like ] change-at TUPLE: selector name object ; -MEMO: ( name -- sel ) f \ selector construct-boa ; +MEMO: ( name -- sel ) f \ selector boa ; : selector ( selector -- alien ) dup selector-object expired? [ diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index deb03f72e2..84b41a91ff 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -137,7 +137,7 @@ MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ; MACRO: construct-slots ( assoc tuple-class -- tuple ) - [ construct-empty ] curry swap [ + [ new ] curry swap [ [ dip ] curry swap 1quotation [ keep ] curry compose ] { } assoc>map concat compose ; diff --git a/extra/concurrency/count-downs/count-downs.factor b/extra/concurrency/count-downs/count-downs.factor index b1fa137bc4..6a75f7206c 100755 --- a/extra/concurrency/count-downs/count-downs.factor +++ b/extra/concurrency/count-downs/count-downs.factor @@ -15,7 +15,7 @@ TUPLE: count-down n promise ; : ( n -- count-down ) dup 0 < [ "Invalid count for count down" throw ] when - \ count-down construct-boa + \ count-down boa dup count-down-check ; : count-down ( count-down -- ) diff --git a/extra/concurrency/exchangers/exchangers.factor b/extra/concurrency/exchangers/exchangers.factor index 0a631d1c7b..d9d6809602 100755 --- a/extra/concurrency/exchangers/exchangers.factor +++ b/extra/concurrency/exchangers/exchangers.factor @@ -9,7 +9,7 @@ IN: concurrency.exchangers TUPLE: exchanger thread object ; : ( -- exchanger ) - exchanger construct-boa ; + exchanger boa ; : exchange ( obj exchanger -- newobj ) dup exchanger-thread box-full? [ diff --git a/extra/concurrency/flags/flags.factor b/extra/concurrency/flags/flags.factor index d598bf0b59..b3c76a7a01 100755 --- a/extra/concurrency/flags/flags.factor +++ b/extra/concurrency/flags/flags.factor @@ -5,7 +5,7 @@ IN: concurrency.flags TUPLE: flag value? thread ; -: ( -- flag ) f flag construct-boa ; +: ( -- flag ) f flag boa ; : raise-flag ( flag -- ) dup flag-value? [ diff --git a/extra/concurrency/locks/locks.factor b/extra/concurrency/locks/locks.factor index 43f22c00da..b5ea247420 100755 --- a/extra/concurrency/locks/locks.factor +++ b/extra/concurrency/locks/locks.factor @@ -8,10 +8,10 @@ IN: concurrency.locks TUPLE: lock threads owner reentrant? ; : ( -- lock ) - f f lock construct-boa ; + f f lock boa ; : ( -- lock ) - f t lock construct-boa ; + f t lock boa ; TUPLE: rw-lock readers writers reader# writer ; : ( -- lock ) - 0 f rw-lock construct-boa ; + 0 f rw-lock boa ; >closed threads>> notify-all ; : ( -- mailbox ) - f mailbox construct-boa ; + f mailbox boa ; : mailbox-empty? ( mailbox -- bool ) data>> dlist-empty? ; diff --git a/extra/concurrency/messaging/messaging.factor b/extra/concurrency/messaging/messaging.factor index 2cd83d43f5..66c5e421fa 100755 --- a/extra/concurrency/messaging/messaging.factor +++ b/extra/concurrency/messaging/messaging.factor @@ -40,12 +40,12 @@ M: thread send ( message thread -- ) TUPLE: synchronous data sender tag ; : ( data -- sync ) - self 256 random-bits synchronous construct-boa ; + self 256 random-bits synchronous boa ; TUPLE: reply data tag ; : ( data synchronous -- reply ) - synchronous-tag \ reply construct-boa ; + synchronous-tag \ reply boa ; : synchronous-reply? ( response synchronous -- ? ) over reply? diff --git a/extra/concurrency/promises/promises.factor b/extra/concurrency/promises/promises.factor index b7ccff7fa7..b432d63bfc 100755 --- a/extra/concurrency/promises/promises.factor +++ b/extra/concurrency/promises/promises.factor @@ -6,7 +6,7 @@ IN: concurrency.promises TUPLE: promise mailbox ; : ( -- promise ) - promise construct-boa ; + promise boa ; : promise-fulfilled? ( promise -- ? ) promise-mailbox mailbox-empty? not ; diff --git a/extra/concurrency/semaphores/semaphores.factor b/extra/concurrency/semaphores/semaphores.factor index 031614ea95..8b88c540bc 100755 --- a/extra/concurrency/semaphores/semaphores.factor +++ b/extra/concurrency/semaphores/semaphores.factor @@ -8,7 +8,7 @@ TUPLE: semaphore count threads ; : ( n -- semaphore ) dup 0 < [ "Cannot have semaphore with negative count" throw ] when - semaphore construct-boa ; + semaphore boa ; : wait-to-acquire ( semaphore timeout -- ) >r semaphore-threads r> "semaphore" wait ; diff --git a/extra/core-foundation/fsevents/fsevents.factor b/extra/core-foundation/fsevents/fsevents.factor index 8f687a896f..3c9dbdbef0 100644 --- a/extra/core-foundation/fsevents/fsevents.factor +++ b/extra/core-foundation/fsevents/fsevents.factor @@ -194,7 +194,7 @@ TUPLE: event-stream info handle closed ; >r master-event-source-callback r> r> r> r> dup enable-event-stream - f event-stream construct-boa ; + f event-stream boa ; M: event-stream dispose dup closed>> [ drop ] [ diff --git a/extra/coroutines/coroutines.factor b/extra/coroutines/coroutines.factor index 36c786e41a..3fad3adbaa 100644 --- a/extra/coroutines/coroutines.factor +++ b/extra/coroutines/coroutines.factor @@ -8,7 +8,7 @@ SYMBOL: current-coro TUPLE: coroutine resumecc exitcc ; : cocreate ( quot -- co ) - coroutine construct-empty + coroutine new dup current-coro associate [ swapd , , \ bind , "Coroutine has terminated illegally." , \ throw , diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index d4574119b2..ecc998e99c 100755 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -425,7 +425,7 @@ M: cpu reset ( cpu -- ) [ HEX: 10 swap set-cpu-last-interrupt ] keep 0 swap set-cpu-cycles ; -: ( -- cpu ) cpu construct-empty dup reset ; +: ( -- cpu ) cpu new dup reset ; : (load-rom) ( n ram -- ) read1 [ ! n ram ch diff --git a/extra/db/db.factor b/extra/db/db.factor index 1a1a18c942..baf4e9db5a 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -12,7 +12,7 @@ TUPLE: db delete-statements ; : construct-db ( class -- obj ) - construct-empty + new H{ } clone >>insert-statements H{ } clone >>update-statements H{ } clone >>delete-statements ; @@ -52,7 +52,7 @@ TUPLE: throwable-statement < statement ; TUPLE: result-set sql in-params out-params handle n max ; : construct-statement ( sql in out class -- statement ) - construct-empty + new swap >>out-params swap >>in-params swap >>sql ; @@ -96,7 +96,7 @@ M: nonthrowable-statement execute-statement ( statement -- ) 0 >>n drop ; : construct-result-set ( query handle class -- result-set ) - construct-empty + new swap >>handle >r [ sql>> ] [ in-params>> ] [ out-params>> ] tri r> swap >>out-params diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 7fc059c9b3..311f18daa9 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -40,7 +40,7 @@ HOOK: db ( tuple class -- tuple ) HOOK: insert-tuple* db ( tuple statement -- ) : resulting-tuple ( row out-params -- tuple ) - dup first sql-spec-class construct-empty [ + dup first sql-spec-class new [ [ >r sql-spec-slot-name r> set-slot-named ] curry 2each diff --git a/extra/destructors/destructors-tests.factor b/extra/destructors/destructors-tests.factor index 147e183688..59c325c490 100755 --- a/extra/destructors/destructors-tests.factor +++ b/extra/destructors/destructors-tests.factor @@ -3,7 +3,7 @@ IN: destructors.tests TUPLE: dummy-obj destroyed? ; -: dummy-obj construct-empty ; +: dummy-obj new ; TUPLE: dummy-destructor obj ; diff --git a/extra/destructors/destructors.factor b/extra/destructors/destructors.factor index 1b98d2ee0d..87b5740786 100755 --- a/extra/destructors/destructors.factor +++ b/extra/destructors/destructors.factor @@ -18,7 +18,7 @@ M: destructor dispose ] if ; : ( obj -- newobj ) - f destructor construct-boa ; + f destructor boa ; : add-error-destructor ( obj -- ) error-destructors get push ; diff --git a/extra/digraphs/digraphs.factor b/extra/digraphs/digraphs.factor index 1776c916ad..7d56c96034 100755 --- a/extra/digraphs/digraphs.factor +++ b/extra/digraphs/digraphs.factor @@ -7,10 +7,10 @@ TUPLE: digraph ; TUPLE: vertex value edges ; : ( -- digraph ) - digraph construct-empty H{ } clone over set-delegate ; + digraph new H{ } clone over set-delegate ; : ( value -- vertex ) - V{ } clone vertex construct-boa ; + V{ } clone vertex boa ; : add-vertex ( key value digraph -- ) >r swap r> set-at ; diff --git a/extra/disjoint-set/disjoint-set.factor b/extra/disjoint-set/disjoint-set.factor index d71b9e1837..6f3b1e63e8 100644 --- a/extra/disjoint-set/disjoint-set.factor +++ b/extra/disjoint-set/disjoint-set.factor @@ -51,7 +51,7 @@ PRIVATE> [ >array ] [ 0 ] [ 1 ] tri - disjoint-set construct-boa ; + disjoint-set boa ; : equiv-set-size ( a disjoint-set -- n ) [ representative ] keep count ; diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index 16de8f5eee..a15a12830c 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -21,7 +21,7 @@ SYMBOL: edit-hook [ [ "Load " prepend ] keep ] { } map>assoc ; : no-edit-hook ( -- ) - \ no-edit-hook construct-empty + \ no-edit-hook new editor-restarts throw-restarts require ; diff --git a/extra/gap-buffer/cursortree/cursortree.factor b/extra/gap-buffer/cursortree/cursortree.factor index fb2abf1c3d..a3a5075820 100644 --- a/extra/gap-buffer/cursortree/cursortree.factor +++ b/extra/gap-buffer/cursortree/cursortree.factor @@ -7,7 +7,7 @@ IN: gap-buffer.cursortree TUPLE: cursortree cursors ; : ( seq -- cursortree ) - cursortree construct-empty tuck set-delegate + cursortree new tuck set-delegate over set-cursortree-cursors ; GENERIC: cursortree-gb ( cursortree -- gb ) @@ -38,16 +38,16 @@ M: left-cursor set-cursor-pos ( n cursor -- ) >r 1- r> [ cursor-tree position>in M: right-cursor set-cursor-pos ( n cursor -- ) [ cursor-tree position>index ] keep set-cursor-index ; : ( cursortree -- cursor ) - cursor construct-empty tuck set-cursor-tree ; + cursor new tuck set-cursor-tree ; : make-cursor ( cursortree pos cursor -- cursor ) >r swap r> tuck set-delegate tuck set-cursor-pos ; : ( cursortree pos -- left-cursor ) - left-cursor construct-empty make-cursor ; + left-cursor new make-cursor ; : ( cursortree pos -- right-cursor ) - right-cursor construct-empty make-cursor ; + right-cursor new make-cursor ; : cursors ( cursortree -- seq ) cursortree-cursors values concat ; diff --git a/extra/gap-buffer/gap-buffer.factor b/extra/gap-buffer/gap-buffer.factor index 3d78204d3f..d3b946afe9 100644 --- a/extra/gap-buffer/gap-buffer.factor +++ b/extra/gap-buffer/gap-buffer.factor @@ -27,7 +27,7 @@ M: gb set-gb-seq ( seq gb -- ) set-delegate ; tuck gb-expand-factor * ceiling >fixnum swap gb-min-size max ; : ( seq -- gb ) - gb construct-empty + gb new 5 over set-gb-min-size 1.5 over set-gb-expand-factor [ >r length r> set-gb-gap-start ] 2keep diff --git a/extra/help/topics/topics.factor b/extra/help/topics/topics.factor index c12c392eb3..afdae38c5a 100755 --- a/extra/help/topics/topics.factor +++ b/extra/help/topics/topics.factor @@ -14,7 +14,7 @@ INSTANCE: word topic GENERIC: >link ( obj -- obj ) M: link >link ; M: vocab-spec >link ; -M: object >link link construct-boa ; +M: object >link link boa ; PREDICATE: word-link < link link-name word? ; @@ -40,13 +40,13 @@ GENERIC: set-article-parent ( parent topic -- ) TUPLE: article title content loc ; :
( title content -- article ) - f \ article construct-boa ; + f \ article boa ; M: article article-name article-title ; TUPLE: no-article name ; -: no-article ( name -- * ) \ no-article construct-boa throw ; +: no-article ( name -- * ) \ no-article boa throw ; M: no-article summary drop "Help article does not exist" ; diff --git a/extra/html/html-tests.factor b/extra/html/html-tests.factor index 2994e2d792..cac6526376 100644 --- a/extra/html/html-tests.factor +++ b/extra/html/html-tests.factor @@ -32,7 +32,7 @@ M: funky browser-link-href [ "<" ] [ [ - "<" "austin" funky construct-boa write-object + "<" "austin" funky boa write-object ] make-html-string ] unit-test diff --git a/extra/html/html.factor b/extra/html/html.factor index 0619937332..84597731d1 100755 --- a/extra/html/html.factor +++ b/extra/html/html.factor @@ -32,7 +32,7 @@ TUPLE: html-stream last-div? ; TUPLE: html-sub-stream style stream ; : (html-sub-stream) ( style stream -- stream ) - html-sub-stream construct-boa + html-sub-stream boa 512 over set-delegate ; : ( style stream class -- stream ) diff --git a/extra/http/http.factor b/extra/http/http.factor index a6afe80443..d894059b6f 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -122,7 +122,7 @@ IN: http TUPLE: cookie name value path domain expires http-only ; : ( value name -- cookie ) - cookie construct-empty + cookie new swap >>name swap >>value ; : parse-cookies ( string -- seq ) @@ -176,7 +176,7 @@ post-data-type cookies ; : - request construct-empty + request new "1.1" >>version http-port >>port H{ } clone >>header @@ -346,7 +346,7 @@ cookies body ; : - response construct-empty + response new "1.1" >>version H{ } clone >>header "close" "connection" set-header @@ -434,7 +434,7 @@ message body ; : ( -- response ) - raw-response construct-empty + raw-response new "1.1" >>version ; M: raw-response write-response ( respose -- ) diff --git a/extra/http/server/actions/actions.factor b/extra/http/server/actions/actions.factor index fcafa57ff6..fabddcdeb1 100755 --- a/extra/http/server/actions/actions.factor +++ b/extra/http/server/actions/actions.factor @@ -12,7 +12,7 @@ SYMBOL: params TUPLE: action init display submit get-params post-params ; : - action construct-empty + action new [ ] >>init [ <400> ] >>display [ <400> ] >>submit ; diff --git a/extra/http/server/auth/providers/assoc/assoc.factor b/extra/http/server/auth/providers/assoc/assoc.factor index 18ec8da62a..54f96480bc 100755 --- a/extra/http/server/auth/providers/assoc/assoc.factor +++ b/extra/http/server/auth/providers/assoc/assoc.factor @@ -7,7 +7,7 @@ http.server.auth.providers ; TUPLE: users-in-memory assoc ; : ( -- provider ) - H{ } clone users-in-memory construct-boa ; + H{ } clone users-in-memory boa ; M: users-in-memory get-user ( username provider -- user/f ) assoc>> at ; diff --git a/extra/http/server/auth/providers/providers.factor b/extra/http/server/auth/providers/providers.factor index eda3babf0f..3d8f1760db 100755 --- a/extra/http/server/auth/providers/providers.factor +++ b/extra/http/server/auth/providers/providers.factor @@ -6,7 +6,7 @@ IN: http.server.auth.providers TUPLE: user username realname password email ticket profile ; -: user construct-empty H{ } clone >>profile ; +: user new H{ } clone >>profile ; GENERIC: get-user ( username provider -- user/f ) diff --git a/extra/http/server/callbacks/callbacks.factor b/extra/http/server/callbacks/callbacks.factor index e1b737a9c6..42213d015f 100755 --- a/extra/http/server/callbacks/callbacks.factor +++ b/extra/http/server/callbacks/callbacks.factor @@ -14,7 +14,7 @@ TUPLE: callback-responder responder callbacks ; #! A continuation responder is a special type of session #! manager. However it works entirely differently from #! the URL and cookie session managers. - H{ } clone callback-responder construct-boa ; + H{ } clone callback-responder boa ; TUPLE: callback cont quot expires alarm responder ; @@ -32,7 +32,7 @@ TUPLE: callback cont quot expires alarm responder ; ] when drop ; : ( cont quot expires? -- callback ) - f callback-responder get callback construct-boa + f callback-responder get callback boa dup touch-callback ; : invoke-callback ( callback -- response ) diff --git a/extra/http/server/components/components-tests.factor b/extra/http/server/components/components-tests.factor index d372865b7e..1cd215ee5d 100755 --- a/extra/http/server/components/components-tests.factor +++ b/extra/http/server/components/components-tests.factor @@ -42,7 +42,7 @@ validation-failed? off TUPLE: test-tuple text number more-text ; -: test-tuple construct-empty ; +: test-tuple new ; : ( -- form ) "test"
diff --git a/extra/http/server/components/components.factor b/extra/http/server/components/components.factor index bd95bf4407..255cb5bfb8 100755 --- a/extra/http/server/components/components.factor +++ b/extra/http/server/components/components.factor @@ -50,7 +50,7 @@ SYMBOL: values ] if ; : ( id class -- component ) - \ component construct-empty + \ component new swap construct-delegate swap >>id ; inline diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index e1561bce89..e59ca5c174 100755 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -106,7 +106,7 @@ SYMBOL: form-hook TUPLE: dispatcher default responders ; : ( -- dispatcher ) - 404-responder get H{ } clone dispatcher construct-boa ; + 404-responder get H{ } clone dispatcher boa ; : split-path ( path -- rest first ) [ CHAR: / = ] left-trim "/" split1 swap ; @@ -131,7 +131,7 @@ M: dispatcher call-responder ( path dispatcher -- response ) TUPLE: vhost-dispatcher default responders ; : ( -- dispatcher ) - 404-responder get H{ } clone vhost-dispatcher construct-boa ; + 404-responder get H{ } clone vhost-dispatcher boa ; : find-vhost ( dispatcher -- responder ) request get host>> over responders>> at* diff --git a/extra/http/server/sessions/sessions.factor b/extra/http/server/sessions/sessions.factor index a3d06e8f18..1288b4f7a4 100755 --- a/extra/http/server/sessions/sessions.factor +++ b/extra/http/server/sessions/sessions.factor @@ -18,7 +18,7 @@ M: object init-session* drop ; TUPLE: session-manager responder sessions ; : ( responder class -- responder' ) - >r session-manager construct-boa + >r session-manager boa r> construct-delegate ; inline SYMBOLS: session session-id session-changed? ; diff --git a/extra/http/server/sessions/storage/assoc/assoc.factor b/extra/http/server/sessions/storage/assoc/assoc.factor index 4bdc52b86e..6e4a84d646 100755 --- a/extra/http/server/sessions/storage/assoc/assoc.factor +++ b/extra/http/server/sessions/storage/assoc/assoc.factor @@ -7,7 +7,7 @@ IN: http.server.sessions.storage.assoc TUPLE: sessions-in-memory sessions alarms ; : ( -- storage ) - H{ } clone H{ } clone sessions-in-memory construct-boa ; + H{ } clone H{ } clone sessions-in-memory boa ; : cancel-session-timeout ( id storage -- ) alarms>> at [ cancel-alarm ] when* ; diff --git a/extra/http/server/sessions/storage/db/db.factor b/extra/http/server/sessions/storage/db/db.factor index e573b22ba1..0245db15b0 100755 --- a/extra/http/server/sessions/storage/db/db.factor +++ b/extra/http/server/sessions/storage/db/db.factor @@ -18,7 +18,7 @@ session "SESSIONS" : init-sessions-table session ensure-table ; : ( id -- session ) - session construct-empty + session new swap dup [ string>number ] when >>id ; M: sessions-in-db get-session ( id storage -- namespace/f ) diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor index 8632e0f139..2d4a97c3c0 100755 --- a/extra/http/server/static/static.factor +++ b/extra/http/server/static/static.factor @@ -21,7 +21,7 @@ TUPLE: file-responder root hook special ; 304 "Not modified" ; : ( root hook -- responder ) - H{ } clone file-responder construct-boa ; + H{ } clone file-responder boa ; : ( root -- responder ) [ diff --git a/extra/inverse/inverse-tests.factor b/extra/inverse/inverse-tests.factor index 101637e4e8..0df41cf53f 100644 --- a/extra/inverse/inverse-tests.factor +++ b/extra/inverse/inverse-tests.factor @@ -61,7 +61,7 @@ C: nil [ f ] [ 1 2 [ ] matches? ] unit-test [ "Malformed list" ] [ [ f list-sum ] [ ] recover ] unit-test -: empty-cons ( -- cons ) cons construct-empty ; +: empty-cons ( -- cons ) cons new ; : cons* ( cdr car -- cons ) { set-cons-cdr set-cons-car } cons construct ; [ ] [ T{ cons f f f } [ empty-cons ] undo ] unit-test diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 6852d70e48..7a2856e311 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -6,7 +6,7 @@ mirrors combinators.lib ; IN: inverse TUPLE: fail ; -: fail ( -- * ) \ fail construct-empty throw ; +: fail ( -- * ) \ fail new throw ; M: fail summary drop "Unification failed" ; : assure ( ? -- ) [ fail ] unless ; @@ -26,7 +26,7 @@ M: fail summary drop "Unification failed" ; "pop-inverse" set-word-prop ; TUPLE: no-inverse word ; -: no-inverse ( word -- * ) \ no-inverse construct-empty throw ; +: no-inverse ( word -- * ) \ no-inverse new throw ; M: no-inverse summary drop "The word cannot be used in pattern matching" ; @@ -214,14 +214,14 @@ DEFER: _ : boa-inverse ( class -- quot ) [ deconstruct-pred ] keep slot-readers compose ; -\ construct-boa 1 [ ?wrapped boa-inverse ] define-pop-inverse +\ boa 1 [ ?wrapped boa-inverse ] define-pop-inverse : empty-inverse ( class -- quot ) deconstruct-pred [ tuple>array 1 tail [ ] contains? [ fail ] when ] compose ; -\ construct-empty 1 [ ?wrapped empty-inverse ] define-pop-inverse +\ new 1 [ ?wrapped empty-inverse ] define-pop-inverse : writer>reader ( word -- word' ) [ "writing" word-prop "slots" word-prop ] keep @@ -255,7 +255,7 @@ DEFER: _ MACRO: matches? ( quot -- ? ) [matches?] ; TUPLE: no-match ; -: no-match ( -- * ) \ no-match construct-empty throw ; +: no-match ( -- * ) \ no-match new throw ; M: no-match summary drop "Fall through in switch" ; : recover-chain ( seq -- quot ) diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor index 8b00e59d23..a901475544 100755 --- a/extra/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -9,7 +9,7 @@ accessors ; TUPLE: buffer size ptr fill pos ; : ( n -- buffer ) - dup malloc 0 0 buffer construct-boa ; + dup malloc 0 0 buffer boa ; : buffer-free ( buffer -- ) dup buffer-ptr free f swap set-buffer-ptr ; diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor index 04e8ee8569..dc6e52d67e 100755 --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -70,7 +70,7 @@ M: 8-bit decode-char decode>> decode-8-bit ; : make-8-bit ( word byte>ch ch>byte -- ) - [ 8-bit construct-boa ] 2curry dupd curry define ; + [ 8-bit boa ] 2curry dupd curry define ; : define-8-bit-encoding ( name stream -- ) >r in get create r> parse-file make-8-bit ; diff --git a/extra/io/encodings/strict/strict.factor b/extra/io/encodings/strict/strict.factor index 89c10d89cc..21eb231075 100644 --- a/extra/io/encodings/strict/strict.factor +++ b/extra/io/encodings/strict/strict.factor @@ -7,7 +7,7 @@ TUPLE: strict code ; C: strict strict TUPLE: decode-error ; -: decode-error ( -- * ) \ decode-error construct-empty throw ; +: decode-error ( -- * ) \ decode-error new throw ; M: decode-error summary drop "Error in decoding input stream" ; diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index 00352adc7b..c5cd7b24eb 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -41,7 +41,7 @@ SYMBOL: +highest-priority+ SYMBOL: +realtime-priority+ : ( -- process ) - process construct-empty + process new H{ } clone >>environment +append-environment+ >>environment-mode ; @@ -130,7 +130,7 @@ HOOK: run-process* io-backend ( process -- handle ) TUPLE: process-failed code ; : process-failed ( code -- * ) - \ process-failed construct-boa throw ; + \ process-failed boa throw ; : try-process ( desc -- ) run-process wait-for-process dup zero? diff --git a/extra/io/monitors/monitors.factor b/extra/io/monitors/monitors.factor index 5c88968ee7..a9b3d414ba 100755 --- a/extra/io/monitors/monitors.factor +++ b/extra/io/monitors/monitors.factor @@ -28,7 +28,7 @@ M: monitor timeout timeout>> ; M: monitor set-timeout (>>timeout) ; : construct-monitor ( path mailbox class -- monitor ) - construct-empty + new swap >>queue swap >>path ; inline diff --git a/extra/io/monitors/recursive/recursive-tests.factor b/extra/io/monitors/recursive/recursive-tests.factor index 3182747194..c35401af83 100644 --- a/extra/io/monitors/recursive/recursive-tests.factor +++ b/extra/io/monitors/recursive/recursive-tests.factor @@ -30,8 +30,8 @@ M: mock-io-backend (monitor) M: mock-io-backend link-info global [ link-info ] bind ; -[ ] [ 0 counter construct-boa dummy-monitor-created set ] unit-test -[ ] [ 0 counter construct-boa dummy-monitor-disposed set ] unit-test +[ ] [ 0 counter boa dummy-monitor-created set ] unit-test +[ ] [ 0 counter boa dummy-monitor-disposed set ] unit-test [ ] [ mock-io-backend io-backend [ diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index aa56b507ff..0bf7a6ccec 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -20,7 +20,7 @@ GENERIC: init-handle ( handle -- ) GENERIC: close-handle ( handle -- ) : ( handle class -- port ) - construct-empty + new swap dup init-handle >>handle ; inline : ( handle class -- port ) diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor index dad1087022..171f8122c5 100755 --- a/extra/io/paths/paths.factor +++ b/extra/io/paths/paths.factor @@ -14,7 +14,7 @@ TUPLE: directory-iterator path bfs queue ; ] curry each ; : ( path bfs? -- iterator ) - directory-iterator construct-boa + directory-iterator boa dup path>> over push-directory ; : next-file ( iter -- file/f ) diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 04141c56ef..859dcb4cdc 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -7,7 +7,7 @@ IN: io.sockets TUPLE: local path ; : ( path -- addrspec ) - normalize-path local construct-boa ; + normalize-path local boa ; TUPLE: inet4 host port ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 396b8cf2e8..6bd3747ce3 100644 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -14,7 +14,7 @@ TUPLE: io-task port callbacks ; : io-task-fd port>> handle>> ; : ( port continuation/f class -- task ) - construct-empty + new swap [ 1vector ] [ V{ } clone ] if* >>callbacks swap >>port ; inline @@ -33,7 +33,7 @@ M: input-task io-task-container drop reads>> ; M: output-task io-task-container drop writes>> ; : construct-mx ( class -- obj ) - construct-empty + new H{ } clone >>reads H{ } clone >>writes ; inline diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 5873568a9e..a09ebb46c9 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -94,7 +94,7 @@ M: unix copy-file ( from to -- ) [ stat-st_mode ] [ stat-st_mtim timespec-sec seconds unix-1970 time+ ] } cleave - \ file-info construct-boa ; + \ file-info boa ; M: unix file-info ( path -- info ) normalize-path stat* stat>file-info ; diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index f042366b13..2815a49cd3 100755 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -13,7 +13,7 @@ IN: io.unix.mmap M: unix ( path length -- obj ) swap >r dup PROT_READ PROT_WRITE bitor MAP_FILE MAP_SHARED bitor - r> mmap-open f mapped-file construct-boa ; + r> mmap-open f mapped-file boa ; M: unix close-mapped-file ( mmap -- ) [ mapped-file-address ] keep diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 8bfbff2ba0..8a15a57f83 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -48,7 +48,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp ] ! [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp ] } cleave - \ file-info construct-boa ; + \ file-info boa ; : find-first-file-stat ( path -- WIN32_FIND_DATA ) "WIN32_FIND_DATA" [ @@ -69,7 +69,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ [ BY_HANDLE_FILE_INFORMATION-ftLastWriteTime FILETIME>timestamp ] ! [ BY_HANDLE_FILE_INFORMATION-ftLastAccessTime FILETIME>timestamp ] } cleave - \ file-info construct-boa ; + \ file-info boa ; : get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION ) [ diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 04e149d261..670ea18f5e 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -23,7 +23,7 @@ TUPLE: CreateProcess-args stdout-pipe stdin-pipe ; : default-CreateProcess-args ( -- obj ) - CreateProcess-args construct-empty + CreateProcess-args new "STARTUPINFO" "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo "PROCESS_INFORMATION" >>lpProcessInformation diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor index 8d3690bbb5..0164ed1697 100755 --- a/extra/io/windows/mmap/mmap.factor +++ b/extra/io/windows/mmap/mmap.factor @@ -78,7 +78,7 @@ M: windows ( path length -- mmap ) PAGE_READWRITE SEC_COMMIT bitor FILE_MAP_ALL_ACCESS mmap-open -rot 2array - f \ mapped-file construct-boa + f \ mapped-file boa ] with-destructors ; M: windows close-mapped-file ( mapped-file -- ) diff --git a/extra/io/windows/nt/pipes/pipes.factor b/extra/io/windows/nt/pipes/pipes.factor index f2aca0470d..b164d5872b 100755 --- a/extra/io/windows/nt/pipes/pipes.factor +++ b/extra/io/windows/nt/pipes/pipes.factor @@ -37,7 +37,7 @@ TUPLE: pipe in out ; [ >r over >r create-named-pipe dup close-later r> r> open-other-end dup close-later - pipe construct-boa + pipe boa ] with-destructors ; : close-pipe ( pipe -- ) diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index 1617b9f9a0..79e767177d 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -52,7 +52,7 @@ TUPLE: ConnectEx-args port M: winnt ((client)) ( addrspec -- client-in client-out ) [ - \ ConnectEx-args construct-empty + \ ConnectEx-args new over make-sockaddr/size pick init-connect over tcp-socket over set-ConnectEx-args-s* dup ConnectEx-args-s* add-completion @@ -123,7 +123,7 @@ M: winnt (accept) ( server -- addrspec handle ) [ [ check-server-port - \ AcceptEx-args construct-empty + \ AcceptEx-args new [ init-accept ] keep [ ((accept)) ] keep [ accept-continuation ] keep @@ -193,7 +193,7 @@ TUPLE: WSARecvFrom-args port M: winnt receive ( datagram -- packet addrspec ) [ check-datagram-port - \ WSARecvFrom-args construct-empty + \ WSARecvFrom-args new [ init-WSARecvFrom ] keep [ call-WSARecvFrom ] keep [ WSARecvFrom-continuation ] keep @@ -245,7 +245,7 @@ USE: io.sockets M: winnt send ( packet addrspec datagram -- ) [ check-datagram-send - \ WSASendTo-args construct-empty + \ WSASendTo-args new [ init-WSASendTo ] keep [ call-WSASendTo ] keep [ WSASendTo-continuation ] keep diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index d4e202013b..772ad9124f 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -155,7 +155,7 @@ HOOK: WSASocket-flags io-backend ( -- DWORD ) TUPLE: win32-socket < win32-file ; : ( handle -- win32-socket ) - f win32-file construct-boa ; + f win32-file boa ; : open-socket ( family type -- socket ) 0 f 0 WSASocket-flags WSASocket dup socket-error ; diff --git a/extra/irc/irc.factor b/extra/irc/irc.factor index 27f82b25eb..4dda206c7b 100755 --- a/extra/irc/irc.factor +++ b/extra/irc/irc.factor @@ -39,14 +39,14 @@ TUPLE: irc-client profile nick stream stream-channel controller-channel listeners is-running ; : ( profile -- irc-client ) f V{ } clone V{ } clone - f V{ } clone f irc-client construct-boa ; + f V{ } clone f irc-client boa ; USE: prettyprint TUPLE: irc-listener channel ; ! FIXME: spawn-server-linked con manejo de excepciones, mandar un mensaje final (ya se maneja esto al recibir mensajes del channel? ) ! tener la opción de dejar de correr un client?? : ( quot -- irc-listener ) - irc-listener construct-boa swap + irc-listener boa swap [ [ channel>> '[ , from ] ] [ '[ , curry f spawn drop ] ] diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor index f82ee91d22..3842816f0e 100644 --- a/extra/jamshred/game/game.factor +++ b/extra/jamshred/game/game.factor @@ -8,7 +8,7 @@ TUPLE: jamshred tunnel players running ; : ( -- jamshred ) "Player 1" 2dup swap play-in-tunnel 1array f - jamshred construct-boa ; + jamshred boa ; : jamshred-player ( jamshred -- player ) ! TODO: support more than one player diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor index bcf4597307..11a89b314f 100644 --- a/extra/jamshred/oint/oint.factor +++ b/extra/jamshred/oint/oint.factor @@ -11,7 +11,7 @@ IN: jamshred.oint TUPLE: oint location forward up left ; : ( location forward up left -- oint ) - oint construct-boa ; + oint boa ; ! : x-rotation ( theta -- matrix ) ! #! construct this matrix: diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 6cc433903e..17843ef9c2 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -7,7 +7,7 @@ IN: jamshred.player TUPLE: player name tunnel nearest-segment ; : ( name -- player ) - f f player construct-boa + f f player boa F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } over set-delegate ; : turn-player ( player x-radians y-radians -- ) diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 7be406d37a..d5ee7f3ebc 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -9,7 +9,7 @@ IN: jamshred.tunnel TUPLE: segment number color radius ; : ( number color radius location forward up left -- segment ) - >r segment construct-boa r> over set-delegate ; + >r segment boa r> over set-delegate ; : segment-vertex ( theta segment -- vertex ) tuck 2dup oint-up swap sin v*n diff --git a/extra/lazy-lists/lazy-lists.factor b/extra/lazy-lists/lazy-lists.factor index ebd2fe9f2e..b87a1e5f2e 100644 --- a/extra/lazy-lists/lazy-lists.factor +++ b/extra/lazy-lists/lazy-lists.factor @@ -52,7 +52,7 @@ M: cons nil? ( cons -- bool ) TUPLE: lazy-cons car cdr ; : lazy-cons ( car cdr -- promise ) - [ promise ] bi@ \ lazy-cons construct-boa + [ promise ] bi@ \ lazy-cons boa T{ promise f f t f } clone [ set-promise-value ] keep ; @@ -103,7 +103,7 @@ TUPLE: memoized-cons original car cdr nil? ; : ( cons -- memoized-cons ) not-memoized not-memoized not-memoized - memoized-cons construct-boa ; + memoized-cons boa ; M: memoized-cons car ( memoized-cons -- car ) dup memoized-cons-car not-memoized? [ diff --git a/extra/math/erato/erato.factor b/extra/math/erato/erato.factor index 5b805fa260..40de92e3b1 100644 --- a/extra/math/erato/erato.factor +++ b/extra/math/erato/erato.factor @@ -22,7 +22,7 @@ TUPLE: erato limit bits latest ; [ [ indices ] keep erato-bits [ f -rot set-nth ] curry each ] [ 2drop ] if ; : ( n -- erato ) - dup ind 1+ 1 over set-bits erato construct-boa ; + dup ind 1+ 1 over set-bits erato boa ; : next-prime ( erato -- prime/f ) [ erato-latest 2 + ] keep [ set-erato-latest ] 2keep diff --git a/extra/math/ranges/ranges.factor b/extra/math/ranges/ranges.factor index 9215fc3acd..81b7f63427 100755 --- a/extra/math/ranges/ranges.factor +++ b/extra/math/ranges/ranges.factor @@ -6,7 +6,7 @@ TUPLE: range from length step ; : ( a b step -- range ) >r over - r> [ / 1+ 0 max >integer ] keep - range construct-boa ; + range boa ; M: range length ( seq -- n ) range-length ; diff --git a/extra/models/models-tests.factor b/extra/models/models-tests.factor index bd02c2f708..7964f8929e 100755 --- a/extra/models/models-tests.factor +++ b/extra/models/models-tests.factor @@ -4,7 +4,7 @@ tools.test ; TUPLE: model-tester hit? ; -: model-tester construct-empty ; +: model-tester new ; M: model-tester model-changed nip t swap set-model-tester-hit? ; diff --git a/extra/models/models.factor b/extra/models/models.factor index ffb9b1127a..58335de3d1 100755 --- a/extra/models/models.factor +++ b/extra/models/models.factor @@ -8,7 +8,7 @@ TUPLE: model < identity-tuple value connections dependencies ref locked? ; : ( value -- model ) - V{ } clone V{ } clone 0 f model construct-boa ; + V{ } clone V{ } clone 0 f model boa ; M: model hashcode* drop model hashcode* ; diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index 36d24e1300..ab9ae38ac1 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -159,7 +159,7 @@ MACRO: set-draw-buffers ( buffers -- ) TUPLE: sprite loc dim dim2 dlist texture ; : ( loc dim dim2 -- sprite ) - f f sprite construct-boa ; + f f sprite boa ; : sprite-size2 sprite-dim2 first2 ; diff --git a/extra/optimizer/debugger/debugger.factor b/extra/optimizer/debugger/debugger.factor index a726095eb1..3ae0c94b12 100755 --- a/extra/optimizer/debugger/debugger.factor +++ b/extra/optimizer/debugger/debugger.factor @@ -19,7 +19,7 @@ M: comment pprint* swap comment-node present-text ; : comment, ( ? node text -- ) - rot [ \ comment construct-boa , ] [ 2drop ] if ; + rot [ \ comment boa , ] [ 2drop ] if ; : values% ( prefix values -- ) swap [ diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index d8fccfb8f9..40620295c6 100755 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -113,7 +113,7 @@ M: fail-parser parse ( input parser -- list ) TUPLE: ensure-parser test ; : ensure ( parser -- ensure ) - ensure-parser construct-boa ; + ensure-parser boa ; M: ensure-parser parse ( input parser -- list ) 2dup ensure-parser-test parse nil? @@ -122,7 +122,7 @@ M: ensure-parser parse ( input parser -- list ) TUPLE: ensure-not-parser test ; : ensure-not ( parser -- ensure ) - ensure-not-parser construct-boa ; + ensure-not-parser boa ; M: ensure-not-parser parse ( input parser -- list ) 2dup ensure-not-parser-test parse nil? @@ -135,10 +135,10 @@ TUPLE: and-parser parsers ; >r and-parser-parsers r> suffix ] [ 2array - ] if and-parser construct-boa ; + ] if and-parser boa ; : ( parsers -- parser ) - dup length 1 = [ first ] [ and-parser construct-boa ] if ; + dup length 1 = [ first ] [ and-parser boa ] if ; : and-parser-parse ( list p1 -- list ) swap [ @@ -161,7 +161,7 @@ M: and-parser parse ( input parser -- list ) TUPLE: or-parser parsers ; : ( parsers -- parser ) - dup length 1 = [ first ] [ or-parser construct-boa ] if ; + dup length 1 = [ first ] [ or-parser boa ] if ; : <|> ( parser1 parser2 -- parser ) 2array ; @@ -265,7 +265,7 @@ LAZY: ( parser -- parser ) TUPLE: only-first-parser p1 ; LAZY: only-first ( parser -- parser ) - only-first-parser construct-boa ; + only-first-parser boa ; M: only-first-parser parse ( input parser -- list ) #! Transform a parser into a parser that only yields diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index 3bbb61b846..da7f678f2d 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -20,7 +20,7 @@ M: just-parser (compile) ( parser -- quot ) just-parser-p1 compiled-parser just-pattern curry ; MEMO: just ( parser -- parser ) - just-parser construct-boa init-parser ; + just-parser boa init-parser ; : 1token ( ch -- parser ) 1string token ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 7390c15684..544e5f95c2 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -21,7 +21,7 @@ C: parser SYMBOL: ignore : ( remaining ast -- parse-result ) - parse-result construct-boa ; + parse-result boa ; SYMBOL: packrat SYMBOL: pos @@ -468,16 +468,16 @@ M: box-parser (compile) ( parser -- quot ) PRIVATE> : token ( string -- parser ) - token-parser construct-boa init-parser ; + token-parser boa init-parser ; : satisfy ( quot -- parser ) - satisfy-parser construct-boa init-parser ; + satisfy-parser boa init-parser ; : range ( min max -- parser ) - range-parser construct-boa init-parser ; + range-parser boa init-parser ; : seq ( seq -- parser ) - seq-parser construct-boa init-parser ; + seq-parser boa init-parser ; : 2seq ( parser1 parser2 -- parser ) 2array seq ; @@ -492,7 +492,7 @@ PRIVATE> { } make seq ; inline : choice ( seq -- parser ) - choice-parser construct-boa init-parser ; + choice-parser boa init-parser ; : 2choice ( parser1 parser2 -- parser ) 2array choice ; @@ -507,34 +507,34 @@ PRIVATE> { } make choice ; inline : repeat0 ( parser -- parser ) - repeat0-parser construct-boa init-parser ; + repeat0-parser boa init-parser ; : repeat1 ( parser -- parser ) - repeat1-parser construct-boa init-parser ; + repeat1-parser boa init-parser ; : optional ( parser -- parser ) - optional-parser construct-boa init-parser ; + optional-parser boa init-parser ; : semantic ( parser quot -- parser ) - semantic-parser construct-boa init-parser ; + semantic-parser boa init-parser ; : ensure ( parser -- parser ) - ensure-parser construct-boa init-parser ; + ensure-parser boa init-parser ; : ensure-not ( parser -- parser ) - ensure-not-parser construct-boa init-parser ; + ensure-not-parser boa init-parser ; : action ( parser quot -- parser ) - action-parser construct-boa init-parser ; + action-parser boa init-parser ; : sp ( parser -- parser ) - sp-parser construct-boa init-parser ; + sp-parser boa init-parser ; : hide ( parser -- parser ) [ drop ignore ] action ; : delay ( quot -- parser ) - delay-parser construct-boa init-parser ; + delay-parser boa init-parser ; : box ( quot -- parser ) #! because a box has its quotation run at compile time @@ -548,7 +548,7 @@ PRIVATE> #! parse. The action adds an indirection with a parser type #! that gets memoized and fixes this. Need to rethink how #! to fix boxes so this isn't needed... - box-parser construct-boa next-id f over set-delegate [ ] action ; + box-parser boa next-id f over set-delegate [ ] action ; : PEG: (:) [ diff --git a/extra/processing/gadget/gadget.factor b/extra/processing/gadget/gadget.factor index 8b78c43f00..bac3f8ac6d 100644 --- a/extra/processing/gadget/gadget.factor +++ b/extra/processing/gadget/gadget.factor @@ -18,7 +18,7 @@ TUPLE: processing-gadget button-down button-up key-down key-up ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : ( -- gadget ) - processing-gadget construct-empty + processing-gadget new set-gadget-delegate ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/promises/promises.factor b/extra/promises/promises.factor index 469f6a91ed..2126f0c05d 100755 --- a/extra/promises/promises.factor +++ b/extra/promises/promises.factor @@ -11,7 +11,7 @@ IN: promises TUPLE: promise quot forced? value ; : promise ( quot -- promise ) - f f \ promise construct-boa ; + f f \ promise boa ; : promise-with ( value quot -- promise ) curry promise ; diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor index 5644cf6d08..db8fe540e5 100755 --- a/extra/random/blum-blum-shub/blum-blum-shub.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub.factor @@ -15,7 +15,7 @@ TUPLE: blum-blum-shub x n ; : ( numbits -- blum-blum-shub ) generate-bbs-primes * [ find-relative-prime ] keep - blum-blum-shub construct-boa ; + blum-blum-shub boa ; : next-bbs-bit ( bbs -- bit ) [ [ x>> 2 ] [ n>> ] bi ^mod ] keep diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index 46f2088440..01e79abff2 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -58,7 +58,7 @@ TUPLE: mersenne-twister seq i ; PRIVATE> : ( seed -- obj ) - init-mt-seq 0 mersenne-twister construct-boa + init-mt-seq 0 mersenne-twister boa dup mt-generate ; M: mersenne-twister seed-random ( mt seed -- ) diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index b0cd61bd8f..6b344ad140 100755 --- a/extra/regexp/regexp.factor +++ b/extra/regexp/regexp.factor @@ -269,7 +269,7 @@ TUPLE: regexp source parser ignore-case? ; ignore-case? [ dup 'regexp' just parse-1 ] with-variable - ] keep regexp construct-boa ; + ] keep regexp boa ; : do-ignore-case ( string regexp -- string regexp ) dup regexp-ignore-case? [ >r >upper r> ] when ; diff --git a/extra/roman/roman.factor b/extra/roman/roman.factor index a3e61dd889..07e43cea8e 100644 --- a/extra/roman/roman.factor +++ b/extra/roman/roman.factor @@ -19,7 +19,7 @@ TUPLE: roman-range-error n ; dup 1 3999 between? [ drop ] [ - roman-range-error construct-boa throw + roman-range-error boa throw ] if ; : roman<= ( ch1 ch2 -- ? ) diff --git a/extra/semantic-db/semantic-db.factor b/extra/semantic-db/semantic-db.factor index 27e0159596..2de0e1c67e 100755 --- a/extra/semantic-db/semantic-db.factor +++ b/extra/semantic-db/semantic-db.factor @@ -5,10 +5,10 @@ IN: semantic-db TUPLE: node id content ; : ( content -- node ) - node construct-empty swap >>content ; + node new swap >>content ; : ( id -- node ) - node construct-empty swap >>id ; + node new swap >>id ; node "node" { @@ -34,10 +34,10 @@ node "node" TUPLE: arc id relation subject object ; : ( relation subject object -- arc ) - arc construct-empty swap >>object swap >>subject swap >>relation ; + arc new swap >>object swap >>subject swap >>relation ; : ( id -- arc ) - arc construct-empty swap >>id ; + arc new swap >>id ; : insert-arc ( arc -- ) f dup insert-tuple id>> >>id insert-tuple ; diff --git a/extra/serialize/serialize.factor b/extra/serialize/serialize.factor index 280ce3b43e..9107c0145a 100755 --- a/extra/serialize/serialize.factor +++ b/extra/serialize/serialize.factor @@ -277,7 +277,7 @@ SYMBOL: deserialized : deserialize-tuple ( -- array ) #! Ugly because we have to intern the tuple before reading #! slots - (deserialize) construct-empty + (deserialize) new [ intern-object ] [ [ (deserialize) ] diff --git a/extra/smtp/smtp.factor b/extra/smtp/smtp.factor index 844857d1db..8e84f99fe1 100755 --- a/extra/smtp/smtp.factor +++ b/extra/smtp/smtp.factor @@ -149,7 +149,7 @@ M: email clone message-id "Message-Id" set-header ; : ( -- email ) - email construct-empty + email new H{ } clone >>headers ; : send-email ( email -- ) diff --git a/extra/state-machine/state-machine.factor b/extra/state-machine/state-machine.factor index 489b7aaeb4..3f1d91d84c 100755 --- a/extra/state-machine/state-machine.factor +++ b/extra/state-machine/state-machine.factor @@ -12,7 +12,7 @@ IN: state-machine TUPLE: state place data ; TUPLE: missing-state ; -: missing-state \ missing-state construct-empty throw ; +: missing-state \ missing-state new throw ; M: missing-state error. drop "Missing state" print ; diff --git a/extra/state-parser/state-parser.factor b/extra/state-parser/state-parser.factor index 3f51a52e1b..cb0362609a 100644 --- a/extra/state-parser/state-parser.factor +++ b/extra/state-parser/state-parser.factor @@ -23,7 +23,7 @@ C: spot ! * Errors TUPLE: parsing-error line column ; : ( -- parsing-error ) - get-line get-column parsing-error construct-boa ; + get-line get-column parsing-error boa ; : construct-parsing-error ( ... slots class -- error ) construct over set-delegate ; inline diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 038078969d..9b3d2ae79f 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -9,7 +9,7 @@ IN: tar TUPLE: tar-header name mode uid gid size mtime checksum typeflag linkname magic version uname gname devmajor devminor prefix ; -: ( -- obj ) tar-header construct-empty ; +: ( -- obj ) tar-header new ; : tar-trim ( seq -- newseq ) [ "\0 " member? ] trim ; @@ -68,13 +68,13 @@ SYMBOL: filename : parse-tar-header ( seq -- obj ) [ header-checksum ] keep over zero-checksum = [ 2drop - \ tar-header construct-empty + \ tar-header new 0 over set-tar-header-size 0 over set-tar-header-checksum ] [ [ read-tar-header ] with-string-reader [ tar-header-checksum = [ - \ checksum-error construct-empty throw + \ checksum-error new throw ] unless ] keep ] if ; diff --git a/extra/taxes/taxes.factor b/extra/taxes/taxes.factor index d557feabfa..f1f3868ec8 100644 --- a/extra/taxes/taxes.factor +++ b/extra/taxes/taxes.factor @@ -45,7 +45,7 @@ GENERIC: withholding ( salary w4 collector -- x ) TUPLE: tax-table single married ; : ( single married class -- obj ) - >r tax-table construct-boa r> construct-delegate ; + >r tax-table boa r> construct-delegate ; : tax-bracket-range dup second swap first - ; diff --git a/extra/tetris/board/board.factor b/extra/tetris/board/board.factor index 93bbebf34f..532978e359 100644 --- a/extra/tetris/board/board.factor +++ b/extra/tetris/board/board.factor @@ -9,7 +9,7 @@ TUPLE: board width height rows ; [ drop f ] with map ; : ( width height -- board ) - 2dup make-rows board construct-boa ; + 2dup make-rows board boa ; #! A block is simply an array of form { x y } where { 0 0 } is the top-left of #! the tetris board, and { 9 19 } is the bottom right on a 10x20 board. diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor index 2fa3efcf7b..5c88187c6c 100755 --- a/extra/trees/avl/avl.factor +++ b/extra/trees/avl/avl.factor @@ -14,7 +14,7 @@ INSTANCE: avl tree-mixin TUPLE: avl-node balance ; : ( key value -- node ) - swap 0 avl-node construct-boa tuck set-delegate ; + swap 0 avl-node boa tuck set-delegate ; : change-balance ( node amount -- ) over avl-node-balance + swap set-avl-node-balance ; diff --git a/extra/trees/splay/splay.factor b/extra/trees/splay/splay.factor index 7746db85d3..4b82f86a57 100644 --- a/extra/trees/splay/splay.factor +++ b/extra/trees/splay/splay.factor @@ -107,7 +107,7 @@ DEFER: (splay) 2dup get-splay [ 2nip set-node-value ] [ drop dup inc-count 2dup splay-split rot - >r >r swapd r> node construct-boa r> set-tree-root + >r >r swapd r> node boa r> set-tree-root ] if ; : new-root ( value key tree -- ) diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor index 1648eeec32..07497b2098 100755 --- a/extra/trees/trees.factor +++ b/extra/trees/trees.factor @@ -10,10 +10,10 @@ MIXIN: tree-mixin TUPLE: tree root count ; : ( -- tree ) - f 0 tree construct-boa ; + f 0 tree boa ; : construct-tree ( class -- tree ) - construct-empty over set-delegate ; inline + new over set-delegate ; inline INSTANCE: tree tree-mixin @@ -21,7 +21,7 @@ INSTANCE: tree-mixin assoc TUPLE: node key value left right ; : ( key value -- node ) - f f node construct-boa ; + f f node boa ; SYMBOL: current-side diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor index 2419b8febb..219df5197c 100755 --- a/extra/tuple-syntax/tuple-syntax.factor +++ b/extra/tuple-syntax/tuple-syntax.factor @@ -15,4 +15,4 @@ IN: tuple-syntax [ scan-object pick rot set-slot parse-slots ] when* ; : TUPLE{ - scan-word construct-empty parse-slots parsed ; parsing + scan-word new parse-slots parsed ; parsing diff --git a/extra/turtle/turtle.factor b/extra/turtle/turtle.factor index b9a932306a..24f93b56fc 100644 --- a/extra/turtle/turtle.factor +++ b/extra/turtle/turtle.factor @@ -8,7 +8,7 @@ IN: turtle TUPLE: turtle ; : ( -- turtle ) -turtle construct-empty +turtle new { 0 0 0 } clone 3 identity-matrix rot diff --git a/extra/ui/clipboards/clipboards.factor b/extra/ui/clipboards/clipboards.factor index fa6cc75ba6..ab6cc35d8c 100644 --- a/extra/ui/clipboards/clipboards.factor +++ b/extra/ui/clipboards/clipboards.factor @@ -5,7 +5,7 @@ IN: ui.clipboards ! Two text transfer buffers TUPLE: clipboard contents ; -: "" clipboard construct-boa ; +: "" clipboard boa ; GENERIC: paste-clipboard ( gadget clipboard -- ) diff --git a/extra/ui/gadgets/borders/borders.factor b/extra/ui/gadgets/borders/borders.factor index 6b548aaf68..91d20e9c99 100644 --- a/extra/ui/gadgets/borders/borders.factor +++ b/extra/ui/gadgets/borders/borders.factor @@ -7,7 +7,7 @@ IN: ui.gadgets.borders TUPLE: border size fill ; : ( child gap -- border ) - dup 2array { 0 0 } border construct-boa + dup 2array { 0 0 } border boa over set-delegate tuck add-gadget ; diff --git a/extra/ui/gadgets/buttons/buttons.factor b/extra/ui/gadgets/buttons/buttons.factor index 978e5d48e2..9910082ebf 100755 --- a/extra/ui/gadgets/buttons/buttons.factor +++ b/extra/ui/gadgets/buttons/buttons.factor @@ -40,7 +40,7 @@ button H{ } set-gestures :