]> gitweb.factorcode.org Git - factor.git/commitdiff
Minor fixes here and there for delegation slot removal
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 3 Sep 2008 11:05:50 +0000 (06:05 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 3 Sep 2008 11:05:50 +0000 (06:05 -0500)
basis/compiler/tree/finalization/finalization.factor
basis/io/servers/connection/connection-tests.factor
basis/mirrors/mirrors-tests.factor
basis/tuple-arrays/tuple-arrays-tests.factor
core/bootstrap/stage1.factor
core/classes/tuple/tuple-tests.factor
core/classes/tuple/tuple.factor
extra/cfdg/cfdg.factor
extra/furnace/furnace.factor
extra/tuple-syntax/tuple-syntax-tests.factor

index 759f92c9bedb6a7ec79bbd958c197c1a5379b7de..5aaeed360a397d70c2aa149a317bbd17dbeab7b7 100644 (file)
@@ -67,7 +67,7 @@ MEMO: builtin-predicate-expansion ( word -- nodes )
 
 MEMO: (tuple-boa-expansion) ( n -- quot )
     [
-       [ 2 + ] map <reversed>
+        [ 2 + ] map <reversed>
         [ '[ [ , set-slot ] keep ] % ] each
     ] [ ] make ;
 
index 84e0d684ac4be8aeefce80d406451cdcfd6c89f8..aa8df0b16c1ee21ff8c3202f0fcd6d5e2b243ca1 100755 (executable)
@@ -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
index 9c8065e0629efd179087ef085b884696a1df4121..aad033600abaf4c17f8b9e9c58da1d9c9c117962 100755 (executable)
@@ -6,9 +6,9 @@ TUPLE: foo bar baz ;
 
 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
 
index b4b7a76497805a798e5612013972e4ec6aed25f9..7aa49b880fe4239059b0f515b502c2fe4e4a6135 100755 (executable)
@@ -7,14 +7,14 @@ TUPLE: foo bar ;
 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
index 56c9382d1a7204bc207a840ee57f924be4907653..92558561d219c2af2022723168a93dd78ea24304 100755 (executable)
@@ -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
index 3f8e3078b633be1e33ec33165f0c274e09a083a1..5c91bdf8dd8d1301b66654934fe50fed7440cf1f 100755 (executable)
@@ -46,13 +46,13 @@ C: <point> 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> constructor-update-2
 
 { 5 1 } [ <constructor-update-2> ] must-infer-as
 
-[ { 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 ;
@@ -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 0 "hi" } >tuple ]
+[ { declared-types 0 "hi" } >tuple ]
 unit-test
 
-[ { declared-types "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 T{ bogus-hashcode-1 } } hashcode drop ] unit-test
index b48f04fa5d07d6986ffc698b4996fe0824645617..89e4e80460126720a2ad3ad20f49a3e12a88e889 100755 (executable)
@@ -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 ;
index 114ebf5445fc2d8806341ae07e2aa3e97085ca03..434ecd59f52d1159a89bcac8360d7723622be31e 100644 (file)
@@ -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
   <handler>
     H{ } clone
-      T{ key-down 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 ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
index 46aba06c9ce3f18d0e37f6735ed513306517270a..fadd3988821beadeaa0fe29a6a9a36f09a264785 100644 (file)
@@ -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 ]
index 2eb9d8bb12fdc35f1ac44a763c63ad5bb985b619..452672ea2ac6764904e5bc2c60da378f8f50d55a 100755 (executable)
@@ -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