diff --git a/basis/compiler/tree/finalization/finalization.factor b/basis/compiler/tree/finalization/finalization.factor index 759f92c9be..5aaeed360a 100644 --- a/basis/compiler/tree/finalization/finalization.factor +++ b/basis/compiler/tree/finalization/finalization.factor @@ -67,7 +67,7 @@ MEMO: builtin-predicate-expansion ( word -- nodes ) MEMO: (tuple-boa-expansion) ( n -- quot ) [ - [ 2 + ] map + [ 2 + ] map [ '[ [ , set-slot ] keep ] % ] each ] [ ] make ; diff --git a/basis/io/servers/connection/connection-tests.factor b/basis/io/servers/connection/connection-tests.factor index 84e0d684ac..aa8df0b16c 100755 --- a/basis/io/servers/connection/connection-tests.factor +++ b/basis/io/servers/connection/connection-tests.factor @@ -13,7 +13,7 @@ concurrency.promises io.encodings.ascii io threads calendar ; ] unit-test [ t ] [ - T{ inet4 "1.2.3.4" 1234 } T{ inet4 "1.2.3.5" 1235 } + T{ inet4 f "1.2.3.4" 1234 } T{ inet4 f "1.2.3.5" 1235 } [ log-connection ] 2keep [ remote-address get = ] [ local-address get = ] bi* and diff --git a/basis/mirrors/mirrors-tests.factor b/basis/mirrors/mirrors-tests.factor index 9c8065e062..aad033600a 100755 --- a/basis/mirrors/mirrors-tests.factor +++ b/basis/mirrors/mirrors-tests.factor @@ -6,9 +6,9 @@ TUPLE: foo bar baz ; C: foo -[ 3 ] [ 1 2 assoc-size ] unit-test +[ 2 ] [ 1 2 assoc-size ] unit-test -[ { "delegate" "bar" "baz" } ] [ 1 2 keys ] unit-test +[ { "bar" "baz" } ] [ 1 2 keys ] unit-test [ 1 t ] [ "bar" 1 2 at* ] unit-test diff --git a/basis/tuple-arrays/tuple-arrays-tests.factor b/basis/tuple-arrays/tuple-arrays-tests.factor index b4b7a76497..7aa49b880f 100755 --- a/basis/tuple-arrays/tuple-arrays-tests.factor +++ b/basis/tuple-arrays/tuple-arrays-tests.factor @@ -7,14 +7,14 @@ TUPLE: foo bar ; C: foo [ 2 ] [ 2 foo dup mat set length ] unit-test [ T{ foo } ] [ mat get first ] unit-test -[ T{ foo 2 1 } ] [ T{ foo 2 1 } 0 mat get [ set-nth ] keep first ] unit-test +[ T{ foo f 2 } ] [ T{ foo f 2 } 0 mat get [ set-nth ] keep first ] unit-test [ t ] [ { T{ foo f 1 } T{ foo f 2 } } >tuple-array dup mat set tuple-array? ] unit-test [ T{ foo f 3 } t ] [ mat get [ bar>> 2 + ] map [ first ] keep tuple-array? ] unit-test [ 2 ] [ 2 foo dup mat set length ] unit-test [ T{ foo } ] [ mat get first ] unit-test -[ T{ foo 2 1 } ] [ T{ foo 2 1 } 0 mat get [ set-nth ] keep first ] unit-test +[ T{ foo f 1 } ] [ T{ foo f 1 } 0 mat get [ set-nth ] keep first ] unit-test TUPLE: baz { bing integer } bong ; [ 0 ] [ 1 baz first bing>> ] unit-test diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor index 56c9382d1a..92558561d2 100755 --- a/core/bootstrap/stage1.factor +++ b/core/bootstrap/stage1.factor @@ -21,7 +21,7 @@ load-help? off ! using the host image's hashing algorithms. We don't ! use each-object here since the catch stack isn't yet ! set up. - begin-scan USE: accessors USE: kernel.private + begin-scan [ hashtable? ] pusher [ (each-object) ] dip end-scan [ rehash ] each diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 3f8e3078b6..5c91bdf8dd 100755 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -46,13 +46,13 @@ C: point [ ] [ "p" get 300 ">>z" "accessors" lookup execute drop ] unit-test -[ 4 ] [ "p" get tuple-size ] unit-test +[ 3 ] [ "p" get tuple-size ] unit-test [ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test [ ] [ "IN: classes.tuple.tests TUPLE: point z y ;" eval ] unit-test -[ 3 ] [ "p" get tuple-size ] unit-test +[ 2 ] [ "p" get tuple-size ] unit-test [ "p" get x>> ] must-fail [ 200 ] [ "p" get y>> ] unit-test @@ -425,7 +425,7 @@ C: constructor-update-2 { 5 1 } [ ] must-infer-as -[ { f 1 2 3 4 5 } ] [ 1 2 3 4 5 tuple-slots ] unit-test +[ { 1 2 3 4 5 } ] [ 1 2 3 4 5 tuple-slots ] unit-test ! Redefinition problem TUPLE: redefinition-problem ; @@ -478,7 +478,7 @@ USE: vocabs ] unit-test [ "USE: words T{ word }" eval ] -[ error>> T{ no-method f word slots>tuple } = ] +[ error>> T{ no-method f word new } = ] must-fail-with ! Accessors not being forgotten... @@ -592,10 +592,10 @@ GENERIC: break-me ( obj -- ) TUPLE: declared-types { n fixnum } { m string } ; [ T{ declared-types f 0 "hi" } ] -[ { declared-types f 0 "hi" } >tuple ] +[ { declared-types 0 "hi" } >tuple ] unit-test -[ { declared-types f "hi" 0 } >tuple ] +[ { declared-types "hi" 0 } >tuple ] [ T{ bad-slot-value f "hi" fixnum } = ] must-fail-with @@ -708,4 +708,4 @@ TUPLE: bogus-hashcode-2 x ; M: bogus-hashcode-1 hashcode* 2drop 0 >bignum ; -[ ] [ T{ bogus-hashcode-2 T{ bogus-hashcode-1 } } hashcode drop ] unit-test +[ ] [ T{ bogus-hashcode-2 f T{ bogus-hashcode-1 } } hashcode drop ] unit-test diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index b48f04fa5d..89e4e80460 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -132,7 +132,7 @@ ERROR: bad-superclass class ; : tuple-prototype ( class -- prototype ) [ initial-values ] keep - over [ ] all? [ 2drop f ] [ slots>tuple ] if ; + over [ ] contains? [ slots>tuple ] [ 2drop f ] if ; : define-tuple-prototype ( class -- ) dup tuple-prototype "prototype" set-word-prop ; diff --git a/extra/cfdg/cfdg.factor b/extra/cfdg/cfdg.factor index 114ebf5445..434ecd59f5 100644 --- a/extra/cfdg/cfdg.factor +++ b/extra/cfdg/cfdg.factor @@ -5,8 +5,9 @@ USING: kernel alien.c-types combinators namespaces arrays opengl.gl opengl.glu opengl ui ui.gadgets.slate vars colors self self.slots random-weighted colors.hsv cfdg.gl accessors - ui.gadgets.handler ui.gestures assocs ui.gadgets macros ; - + ui.gadgets.handler ui.gestures assocs ui.gadgets macros + qualified ; +QUALIFIED: syntax IN: cfdg ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -158,7 +159,7 @@ MACRO: rule ( seq -- quot ) [rule] ; VAR: background -: set-initial-background ( -- ) T{ hsva f 0 0 1 1 } clone >self ; +: set-initial-background ( -- ) T{ hsva syntax:f 0 0 1 1 } clone >self ; : set-background ( -- ) set-initial-background @@ -173,7 +174,7 @@ VAR: viewport ! { left width bottom height } VAR: start-shape -: set-initial-color ( -- ) T{ hsva f 0 0 0 1 } clone >self ; +: set-initial-color ( -- ) T{ hsva syntax:f 0 0 0 1 } clone >self ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -244,8 +245,8 @@ SYMBOL: the-slate C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft H{ } clone - T{ key-down f f "ENTER" } C[ drop rebuild ] swap pick set-at - T{ button-down } C[ drop rebuild ] swap pick set-at + T{ key-down syntax:f syntax:f "ENTER" } C[ drop rebuild ] swap pick set-at + T{ button-down } C[ drop rebuild ] swap pick set-at >>table ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor index 46aba06c9c..fadd398882 100644 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -199,7 +199,7 @@ STRING: button-tag-markup attrs>> swap update ; CHLOE: button - button-tag-markup string>xml delegate + button-tag-markup string>xml body>> { [ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ] [ [ attrs>> non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ] diff --git a/extra/tuple-syntax/tuple-syntax-tests.factor b/extra/tuple-syntax/tuple-syntax-tests.factor index 2eb9d8bb12..452672ea2a 100755 --- a/extra/tuple-syntax/tuple-syntax-tests.factor +++ b/extra/tuple-syntax/tuple-syntax-tests.factor @@ -4,5 +4,5 @@ IN: tuple-syntax.tests TUPLE: foo bar baz ; [ T{ foo } ] [ TUPLE{ foo } ] unit-test -[ T{ foo 1 { 2 3 } { 4 { 5 } } } ] -[ TUPLE{ foo bar: { 2 3 } delegate: 1 baz: { 4 { 5 } } } ] unit-test +[ T{ foo f { 2 3 } { 4 { 5 } } } ] +[ TUPLE{ foo bar: { 2 3 } baz: { 4 { 5 } } } ] unit-test