Merge branch 'master' of factorcode.org:/git/factor

core/heaps/heaps.factor

@@ -5,8 +5,6 @@ USING: kernel math sequences arrays assocs sequences.private
 growable accessors math.order ;
 IN: heaps
 
-MIXIN: priority-queue
-
 GENERIC: heap-push* ( value key heap -- entry )
 GENERIC: heap-peek ( heap -- value key )
 GENERIC: heap-pop* ( heap -- )
@@ -36,13 +34,10 @@ TUPLE: max-heap < heap ;
 
 : <max-heap> ( -- max-heap ) max-heap <heap> ;
 
-INSTANCE: min-heap priority-queue
+M: heap heap-empty? ( heap -- ? )
-INSTANCE: max-heap priority-queue
-
-M: priority-queue heap-empty? ( heap -- ? )
     data>> empty? ;
 
-M: priority-queue heap-size ( heap -- n )
+M: heap heap-size ( heap -- n )
     data>> length ;
 
 <PRIVATE
@@ -152,7 +147,7 @@ DEFER: down-heap
 
 PRIVATE>
 
-M: priority-queue heap-push* ( value key heap -- entry )
+M: heap heap-push* ( value key heap -- entry )
     [ <entry> dup ] keep [ data-push ] keep up-heap ;
 
 : heap-push ( value key heap -- ) heap-push* drop ;
@@ -163,7 +158,7 @@ M: priority-queue heap-push* ( value key heap -- entry )
 : >entry< ( entry -- key value )
     [ value>> ] [ key>> ] bi ;
 
-M: priority-queue heap-peek ( heap -- value key )
+M: heap heap-peek ( heap -- value key )
     data-first >entry< ;
 
 : entry>index ( entry heap -- n )
@@ -172,7 +167,7 @@ M: priority-queue heap-peek ( heap -- value key )
     ] unless
     entry-index ;
 
-M: priority-queue heap-delete ( entry heap -- )
+M: heap heap-delete ( entry heap -- )
     [ entry>index ] keep
     2dup heap-size 1- = [
         nip data-pop*
@@ -182,10 +177,10 @@ M: priority-queue heap-delete ( entry heap -- )
         down-heap
     ] if ;
 
-M: priority-queue heap-pop* ( heap -- )
+M: heap heap-pop* ( heap -- )
     dup data-first swap heap-delete ;
 
-M: priority-queue heap-pop ( heap -- value key )
+M: heap heap-pop ( heap -- value key )
     dup data-first [ swap heap-delete ] keep >entry< ;
 
 : heap-pop-all ( heap -- alist )

extra/ctags/ctags-tests.factor

@@ -3,17 +3,17 @@ IN: ctags.tests
 
 [ t ] [
   91
-  { { if  { "resource:extra/unix/unix.factor" 91 } } } ctag-lineno =
+  { if  { "resource:extra/unix/unix.factor" 91 } } ctag-lineno =
 ] unit-test
 
 [ t ] [
   "resource:extra/unix/unix.factor"
-  { { if  { "resource:extra/unix/unix.factor" 91 } } } ctag-path =
+  { if  { "resource:extra/unix/unix.factor" 91 } } ctag-path =
 ] unit-test
 
 [ t ] [
-  if
+  \ if
-  { { if  { "resource:extra/unix/unix.factor" 91 } } } ctag-word =
+  { if  { "resource:extra/unix/unix.factor" 91 } } ctag-word =
 ] unit-test
 
 [ t ] [

extra/delegate/delegate-tests.factor

@@ -79,3 +79,15 @@ CONSULT: beta hey value>> 1- ;
 [ -1 ] [ 1 <hey> four ] unit-test
 [ ] [ "IN: delegate.tests FORGET: alpha" eval ] unit-test
 [ f ] [ hey \ one method ] unit-test
+
+TUPLE: slot-protocol-test-1 a b ;
+TUPLE: slot-protocol-test-2 < slot-protocol-test-1 { c integer } ;
+
+TUPLE: slot-protocol-test-3 d ;
+
+CONSULT: slot-protocol-test-2 slot-protocol-test-3 d>> ;
+
+[ "a" "b" 5 ] [
+    T{ slot-protocol-test-3 f T{ slot-protocol-test-2 f "a" "b" 5 } }
+    [ a>> ] [ b>> ] [ c>> ] tri
+] unit-test

extra/delegate/delegate.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Daniel Ehrenberg
+! Copyright (C) 2007, 2008 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors parser generic kernel classes classes.tuple
 words slots assocs sequences arrays vectors definitions
@@ -14,9 +14,11 @@ IN: delegate
 GENERIC: group-words ( group -- words )
 
 M: tuple-class group-words
-    "slot-names" word-prop [
+    all-slots [
-        [ reader-word ] [ writer-word ] bi
+        name>>
-        2array [ 0 2array ] map
+        [ reader-word 0 2array ]
+        [ writer-word 0 2array ] bi
+        2array
     ] map concat ;
 
 ! Consultation

extra/tuple-arrays/tuple-arrays-docs.factor

@@ -1,9 +1,13 @@
-USING: help.syntax help.markup splitting kernel ;
+USING: help.syntax help.markup splitting kernel sequences ;
 IN: tuple-arrays
 
 HELP: tuple-array
-{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link <tuple-array> } ". All elements are of the same tuple class. Mutations done to an element are not copied back to the packed array unless it is explicitly written back.." } ;
+{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link <tuple-array> } ". All elements are of the same tuple class. Mutations done to an element are not copied back to the packed array unless it is explicitly written back. To convert a sequence to a tuple array, use the word " { $link >tuple-array } "." } ;
 
 HELP: <tuple-array>
-{ $values { "example" tuple } { "length" "a non-negative integer" } { "tuple-array" tuple-array } }
+{ $values { "class" "a tuple class" } { "length" "a non-negative integer" } { "tuple-array" tuple-array } }
-{ $description "Creates an instance of the " { $link <tuple-array> } " class with the given length and containing the given tuple class. The tuple class is specified in the form of an example tuple. If the example tuple has a delegate, the tuple array will store a delegate for each element. Otherwise, the delegate will be assumed to be " { $link f } "." } ;
+{ $description "Creates an instance of the " { $link <tuple-array> } " class with the given length and containing the given tuple class." } ;
+
+HELP: >tuple-array
+{ $values { "seq" sequence } { "tuple-array" tuple-array } }
+{ $description "Converts a sequence into a homogeneous unboxed tuple array of the type indicated by the first element." } ;

extra/tuple-arrays/tuple-arrays-tests.factor

@@ -1,16 +1,20 @@
-USING: tuple-arrays sequences tools.test namespaces kernel math ;
+USING: tuple-arrays sequences tools.test namespaces kernel math accessors ;
 IN: tuple-arrays.tests
 
 SYMBOL: mat
 TUPLE: foo bar ;
 C: <foo> foo
-[ 2 ] [ 2 T{ foo } <tuple-array> dup mat set length ] 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 ] [ { T{ foo f 1 } T{ foo f 2 } } >tuple-array dup mat set tuple-array? ] unit-test
 [ T{ foo f 3 } t ] 
 [ mat get [ foo-bar 2 + <foo> ] map [ first ] keep tuple-array? ] unit-test
 
-[ 2 ] [ 2 T{ foo t } <tuple-array> dup mat set length ] 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
+
+TUPLE: baz { bing integer } bong ;
+[ 0 ] [ 1 baz <tuple-array> first bing>> ] unit-test
+[ f ] [ 1 baz <tuple-array> first bong>> ] unit-test

extra/tuple-arrays/tuple-arrays.factor

@@ -4,27 +4,26 @@ USING: splitting grouping classes.tuple classes math kernel
 sequences arrays accessors ;
 IN: tuple-arrays
 
-TUPLE: tuple-array seq class ;
+TUPLE: tuple-array { seq read-only } { class read-only } ;
 
-: <tuple-array> ( length example -- tuple-array )
+: <tuple-array> ( length class -- tuple-array )
-    [ tuple>array length 1- [ * { } new-sequence ] keep <sliced-groups> ]
+    [
-    [ class ] bi tuple-array boa ;
+        new tuple>array 1 tail
+        [ <repetition> concat ] [ length ] bi <sliced-groups>
+    ] [ ] bi tuple-array boa ;
 
 M: tuple-array nth
     [ seq>> nth ] [ class>> ] bi prefix >tuple ;
 
-: deconstruct ( tuple -- seq )
-    tuple>array 1 tail ;
-
 M: tuple-array set-nth ( elt n seq -- )
-    >r >r deconstruct r> r> seq>> set-nth ;
+    >r >r tuple>array 1 tail r> r> seq>> set-nth ;
 
 M: tuple-array new-sequence
-    class>> new <tuple-array> ;
+    class>> <tuple-array> ;
 
-: >tuple-array ( seq -- tuple-array/seq )
+: >tuple-array ( seq -- tuple-array )
     dup empty? [
-        0 over first <tuple-array> clone-like
+        0 over first class <tuple-array> clone-like
     ] unless ;
 
 M: tuple-array like