From 8b1ef9eb887e7ffaa85f60e251343904e57bccf3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 5 May 2005 19:31:57 +0000 Subject: [PATCH] sequence= is now O(n) with lists, more matrix works compile --- TODO.FACTOR.txt | 6 ++--- doc/handbook.tex | 2 -- examples/cube3d.factor | 4 +-- library/alien/c-types.factor | 7 +++--- library/collections/hashtables.factor | 6 ++--- library/collections/sequences-epilogue.factor | 15 +++++------ library/combinators.factor | 3 +++ library/math/math.factor | 5 ++++ library/math/matrices.factor | 25 ++++--------------- library/test/lists/lists.factor | 5 ++++ 10 files changed, 37 insertions(+), 41 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 12cdb71728..2152f7886d 100644 --- a/TODO.FACTOR.txt +++ b/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: diff --git a/doc/handbook.tex b/doc/handbook.tex index 10c851b0d7..a9ccf83189 100644 --- a/doc/handbook.tex +++ b/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 diff --git a/examples/cube3d.factor b/examples/cube3d.factor index 19aaf6309f..89fc24d111 100644 --- a/examples/cube3d.factor +++ b/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 ; diff --git a/library/alien/c-types.factor b/library/alien/c-types.factor index 423e191e0b..fb20ddef09 100644 --- a/library/alien/c-types.factor +++ b/library/alien/c-types.factor @@ -34,17 +34,18 @@ SYMBOL: c-types c-types get set-hash ; inline : ( type -- byte-array ) - c-size cell / ceiling ; + cell / ceiling ; : ( n type -- byte-array ) - c-size * cell / ceiling ; + * cell / ceiling ; : define-out ( name -- ) #! Out parameter constructor for integral types. dup "alien" constructor-word swap c-type [ [ - "width" get , \ , 0 , "setter" get % + "width" get , \ , \ tuck , 0 , + "setter" get % ] make-list ] bind define-compound ; diff --git a/library/collections/hashtables.factor b/library/collections/hashtables.factor index cc67d05abd..2ca2157561 100644 --- a/library/collections/hashtables.factor +++ b/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 diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index 037cc3455b..795f12f23c 100644 --- a/library/collections/sequences-epilogue.factor +++ b/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 [ - 3dup >r >r >r swap nth swap call r> r> r> - ] repeat 2drop ; + dup length [ [ swap nth swap call ] 3keep ] 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> - swap (exchange) set-nth set-nth ; + [ (exchange) ] 3keep 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? [ diff --git a/library/combinators.factor b/library/combinators.factor index 89a5471154..5456f51575 100644 --- a/library/combinators.factor +++ b/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. diff --git a/library/math/math.factor b/library/math/math.factor index 67bf9bcfee..299ee71223 100644 --- a/library/math/math.factor +++ b/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 diff --git a/library/math/matrices.factor b/library/math/matrices.factor index f7a6c88282..fdbc655dbd 100644 --- a/library/math/matrices.factor +++ b/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 ; -: 2repeat ( i j quot -- | quot: i j -- i j ) - rot [ - rot [ [ rot dup slip -rot ] repeat ] keep -rot - ] repeat 2drop ; inline - -SYMBOL: matrix-maker - -: make-matrix ( rows cols quot -- matrix ) - [ - matrix-maker set - 2dup matrix set - [ - [ - [ matrix-maker get call ] 2keep - matrix get matrix-set - ] 2keep - ] 2repeat - matrix get - ] with-scope ; +: make-matrix ( rows cols quot -- matrix | quot: i j -- elt ) + -rot [ + [ [ [ rot call , ] 3keep ] 2repeat ] make-vector nip + ] 2keep rot ; inline : ( 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 diff --git a/library/test/lists/lists.factor b/library/test/lists/lists.factor index 8fbc30e633..000c7637af 100644 --- a/library/test/lists/lists.factor +++ b/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