MEMO: (tuple-boa-expansion) ( n -- quot )
[
- [ 2 + ] map <reversed>
+ [ 2 + ] map <reversed>
[ '[ [ , set-slot ] keep ] % ] each
] [ ] make ;
] 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
C: <foo> foo
-[ 3 ] [ 1 2 <foo> <mirror> assoc-size ] unit-test
+[ 2 ] [ 1 2 <foo> <mirror> assoc-size ] unit-test
-[ { "delegate" "bar" "baz" } ] [ 1 2 <foo> <mirror> keys ] unit-test
+[ { "bar" "baz" } ] [ 1 2 <foo> <mirror> keys ] unit-test
[ 1 t ] [ "bar" 1 2 <foo> <mirror> at* ] unit-test
C: <foo> foo
[ 2 ] [ 2 foo <tuple-array> 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 + <foo> ] map [ first ] keep tuple-array? ] unit-test
[ 2 ] [ 2 foo <tuple-array> 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 <tuple-array> first bing>> ] unit-test
! 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
[ ] [ "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
{ 5 1 } [ <constructor-update-2> ] must-infer-as
-[ { f 1 2 3 4 5 } ] [ 1 2 3 4 5 <constructor-update-2> tuple-slots ] unit-test
+[ { 1 2 3 4 5 } ] [ 1 2 3 4 5 <constructor-update-2> tuple-slots ] unit-test
! Redefinition problem
TUPLE: redefinition-problem ;
] 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...
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
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
: 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 ;
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
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft
<handler>
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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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 ]
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