sequence= is now O(n) with lists, more matrix works compile

TODO.FACTOR.txt

@@ -5,7 +5,7 @@
 - get all-tests to run with -no-compile
 - fix i/o on generic x86/ppc unix
 - alien primitives need a more general input type
-- 2map, sequence= slow with lists
+- 2map slow with lists
 - nappend: instead of using push, enlarge the sequence with set-length
   then add set the elements with set-nth
 - ensure-capacity: don't be generic
@@ -25,14 +25,14 @@
 - rename prettyprint to pprint
 - reader syntax for arrays, byte arrays, displaced aliens
 - add a socket timeout
-- make-matrix is slow and ugly
-- move 2repeat somewhere else
 - virtual hosts
 - keep alive
 - dipping seq-2nmap, seq-2each
 - array sort
 - tiled window manager
 - PPC #box-float #unbox-float
+- weird bug uncovered during bootstrap stress-test
+- images saved from plugin do not work
 
 + plugin:
 

doc/handbook.tex

@@ -4358,8 +4358,6 @@ BEGIN-UNION: event
 END-UNION
 \end{verbatim}
 
-\subsubsection{Out parameters}
-
 \subsection{\label{alien-internals}Low-level interface}
 
 The alien interface is built on top of a handful of primitives. Sometimes, it is

examples/cube3d.factor

@@ -62,13 +62,13 @@ SYMBOL: theta
 SYMBOL: phi
 SYMBOL: psi
 
+SYMBOL: rotation
+
 : update-matrix
     theta get rotation-matrix-1
     phi get rotation-matrix-2 m.
     psi get rotation-matrix-3 m. rotation set ;
 
-SYMBOL: rotation
-
 : >scene ( { x y z } -- { x y z } )
     rotation get swap m.v ;
 

library/alien/c-types.factor

@@ -34,17 +34,18 @@ SYMBOL: c-types
     c-types get set-hash ; inline
 
 : <c-object> ( type -- byte-array )
-    c-size cell / ceiling <byte-array> ;
+    cell / ceiling <byte-array> ;
 
 : <c-array> ( n type -- byte-array )
-    c-size * cell / ceiling <byte-array> ;
+    * cell / ceiling <byte-array> ;
 
 : define-out ( name -- )
     #! Out parameter constructor for integral types.
     dup "alien" constructor-word
     swap c-type [
         [
-            "width" get , \ <c-object> , 0 , "setter" get %
+            "width" get , \ <c-object> , \ tuck , 0 ,
+            "setter" get %
         ] make-list
     ] bind define-compound ;
 

library/collections/hashtables.factor

@@ -149,15 +149,13 @@ M: hashtable clone ( hash -- hash )
         hash-array swap hash-array dup length copy-array
     ] keep ;
 
-: hash-contained? ( subset of -- ? )
-    hash>alist [ uncons >r swap hash r> = ] all-with? ;
-
 M: hashtable = ( obj hash -- ? )
     2dup eq? [
         2drop t
     ] [
         over hashtable? [
-            2dup hash-contained? >r swap hash-contained? r> and
+            swap hash>alist swap hash>alist 2dup
+            contained? >r swap contained? r> and
         ] [
             2drop f
         ] ifte

library/collections/sequences-epilogue.factor

@@ -32,9 +32,7 @@ M: general-list >list ( list -- list ) ;
 GENERIC: (seq-each) ( quot seq -- ) inline
 
 M: object (seq-each) ( quot seq -- )
-    dup length [
+    dup length [ [ swap nth swap call ] 3keep ] repeat 2drop ;
-        3dup >r >r >r swap nth swap call r> r> r>
-    ] repeat 2drop ;
 
 M: general-list (seq-each) ( quot seq -- )
     swap each ;
@@ -67,7 +65,7 @@ M: sequence (tree-each) [ (tree-each) ] seq-each-with ;
     pick length pick <= [
         3drop
     ] [
-        3dup >r >r >r change-nth r> r> 1 + r> (nmap)
+        [ change-nth ] 3keep >r 1 + r> (nmap)
     ] ifte ; inline
 
 : nmap ( seq quot -- | quot: elt -- elt )
@@ -146,8 +144,7 @@ M: object peek ( sequence -- element )
 
 : exchange ( seq i j -- )
     #! Exchange seq[i] and seq[j].
-    3dup >r >r >r (exchange) r> r> r>
+    [ (exchange) ] 3keep swap (exchange) set-nth set-nth ;
-    swap (exchange) set-nth set-nth ;
 
 : (nreverse) ( seq i -- )
     #! Swap seq[i] with seq[length-i-1].
@@ -176,7 +173,11 @@ M: object reverse ( seq -- seq ) [ nreverse ] immutable ;
 : sequence= ( seq seq -- ? )
     #! Check if two sequences have the same length and elements,
     #! but not necessarily the same class.
-    2dup length= [ 0 (sequence=) ] [ 2drop f ] ifte ;
+    over general-list? over general-list? or [
+        swap >list swap >list =
+    ] [
+        2dup length= [ 0 (sequence=) ] [ 2drop f ] ifte
+    ] ifte ;
 
 M: sequence = ( obj seq -- ? )
     2dup eq? [

library/combinators.factor

@@ -11,6 +11,9 @@ IN: kernel
 : 2keep ( x y quot -- x y | quot: x y -- )
     over >r pick >r call r> r> ; inline
 
+: 3keep ( x y z quot -- x y z | quot: x y z -- )
+    >r 3dup r> swap >r swap >r swap >r call r> r> r> ; inline
+
 : while ( quot generator -- )
     #! Keep applying the quotation to the value produced by
     #! calling the generator until the generator returns f.

library/math/math.factor

@@ -75,3 +75,8 @@ GENERIC: abs ( z -- |z| )
 : times ( n quot -- )
     #! Evaluate a quotation n times.
     swap [ >r dup slip r> ] repeat drop ; inline
+
+: 2repeat ( i j quot -- | quot: i j -- i j )
+    rot [
+        rot [ [ rot dup slip -rot ] repeat ] keep -rot
+    ] repeat 2drop ; inline

library/math/matrices.factor

@@ -49,25 +49,10 @@ M: matrix clone ( matrix -- matrix )
     #! Turn a vector into a matrix of one column.
     [ length 1 ] keep <matrix> ;
 
-: 2repeat ( i j quot -- | quot: i j -- i j )
+: make-matrix ( rows cols quot -- matrix | quot: i j -- elt )
-    rot [
+    -rot [
-        rot [ [ rot dup slip -rot ] repeat ] keep -rot
+        [ [ [ rot call , ] 3keep ] 2repeat ] make-vector nip
-    ] repeat 2drop ; inline
+    ] 2keep rot <matrix> ; inline
-
-SYMBOL: matrix-maker
-
-: make-matrix ( rows cols quot -- matrix )
-    [
-        matrix-maker set
-        2dup <zero-matrix> matrix set
-        [
-            [
-                [ matrix-maker get call ] 2keep
-                matrix get matrix-set
-            ] 2keep
-        ] 2repeat
-        matrix get
-    ] with-scope ;
 
 : <identity-matrix> ( n -- matrix )
     #! Make a nxn identity matrix.
@@ -100,7 +85,7 @@ M: col thaw >vector ;
         "Matrix dimensions do not equal" throw
     ] unless ;
 
-: element-wise ( m m -- v v )
+: element-wise ( m m -- rows cols v v )
     2dup +check >r >matrix< r> matrix-sequence ;
 
 ! Matrix operations

library/test/lists/lists.factor

@@ -55,3 +55,8 @@ USING: kernel lists sequences test ;
 
 [ t ] [ [ 1 2 3 ] [ 1 2 3 4 5 ] contained? ] unit-test
 [ f ] [ [ 1 2 3 6 ] [ 1 2 3 4 5 ] contained? ] unit-test
+
+[ t ] [ [ 1 2 3 ] [ 1 2 3 ] sequence= ] unit-test
+[ t ] [ [ 1 2 3 ] { 1 2 3 } sequence= ] unit-test
+[ t ] [ { 1 2 3 } [ 1 2 3 ] sequence= ] unit-test
+[ f ] [ [ ] [ 1 2 3 ] sequence= ] unit-test