From f90d3ed1009f18f4e6963e76b08e3b9168b9c551 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 12 Apr 2005 03:05:05 +0000 Subject: [PATCH] Factor plugin 0.74 --- TODO.FACTOR.txt | 11 +++-- library/arrays.factor | 19 +++----- library/generic/tuple.factor | 4 +- library/sequences-epilogue.factor | 81 ++++++++++++++++++++++--------- library/test/vectors.factor | 3 ++ 5 files changed, 75 insertions(+), 43 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index a021ae5d6d..cf08bbb9a0 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -56,11 +56,17 @@ + sequences +- dipping nmap - generic each some? all? member? memq? all=? top index? subseq? +- index and index* are very slow with lists +- map, subset, project, append: not tail recursive + kernel: +- unions containing tuples do not work properly +- tuples should probably not be sequences +- need G: combinations - method doc strings - make-image: use a list not a vector - code walker & exceptions @@ -75,11 +81,6 @@ - doc comments of generics - proper ordering for classes -+ slow data structures: - -- vector-map, string-map, seq-each, vector-project: consing -- map, subset, project, append: not tail recursive - + nice to have libraries: - regexps diff --git a/library/arrays.factor b/library/arrays.factor index e21b5c030f..94379db317 100644 --- a/library/arrays.factor +++ b/library/arrays.factor @@ -13,20 +13,13 @@ USING: generic kernel lists math-internals sequences vectors ; ! low-level... but be aware that vectors are usually a better ! choice. -BUILTIN: array 8 [ 1 length f ] ; +BUILTIN: array 8 ; -: array-nth ( n array -- obj ) - #! Unsafe. - swap 2 fixnum+ slot ; inline - -: set-array-nth ( obj n array -- ) - #! Unsafe. - swap 2 fixnum+ set-slot ; inline +: array-capacity ( a -- n ) 1 slot ; inline +: array-nth ( n a -- obj ) swap 2 fixnum+ slot ; inline +: set-array-nth ( obj n a -- ) swap 2 fixnum+ set-slot ; inline +: dispatch ( n vtable -- ) 2 slot array-nth call ; +M: array length array-capacity ; M: array nth array-nth ; M: array set-nth set-array-nth ; - -: dispatch ( n vtable -- ) - #! This word is unsafe since n is not bounds-checked. Do not - #! call it directly. - 2 slot array-nth call ; diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index a14ef3c438..243d13ba4a 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -37,7 +37,7 @@ M: object set-delegate 2drop ; M: tuple set-delegate 3 set-slot ; : check-array ( n array -- ) - length 0 swap between? [ + array-capacity 0 swap between? [ "Array index out of bounds" throw ] unless ; @@ -169,7 +169,7 @@ UNION: arrayed array tuple ; : clone-tuple ( tuple -- tuple ) #! Make a shallow copy of a tuple, without cloning its #! delegate. - dup length dup [ -rot copy-array ] keep ; + dup array-capacity dup [ -rot copy-array ] keep ; M: tuple clone ( tuple -- tuple ) #! Clone a tuple and its delegate. diff --git a/library/sequences-epilogue.factor b/library/sequences-epilogue.factor index 4061ba63ca..bbc929491a 100644 --- a/library/sequences-epilogue.factor +++ b/library/sequences-epilogue.factor @@ -17,29 +17,56 @@ UNION: sequence array general-list string sbuf tuple vector ; M: object >list ( seq -- list ) dup length 0 rot (>list) ; M: general-list >list ( list -- list ) ; -: seq-each ( seq quot -- ) - >r >list r> each ; inline +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 ; + +M: general-list (seq-each) ( quot seq -- ) + swap each ; + +: seq-each ( seq quot -- ) swap (seq-each) ; inline : seq-each-with ( obj seq quot -- ) swap [ with ] seq-each 2drop ; inline -: length= ( seq seq -- ? ) length swap length number= ; +GENERIC: (tree-each) ( quot obj -- ) inline +M: object (tree-each) swap call ; +M: cons (tree-each) [ car (tree-each) ] 2keep cdr (tree-each) ; +M: f (tree-each) swap call ; +M: sequence (tree-each) [ swap call ] seq-each-with ; +: tree-each swap (tree-each) ; inline +: tree-each-with ( obj vector quot -- ) + swap [ with ] tree-each 2drop ; inline -M: sequence = ( obj seq -- ? ) - 2dup eq? [ - 2drop t +: 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ; + +: (seq-2nmap) ( seq1 seq2 i quot -- elt3 ) + pick pick >r >r >r 2nth r> call r> r> swap set-nth ; inline + +: seq-2nmap ( seq1 seq2 quot -- | quot: elt1 elt2 -- elt3 ) + #! Destructive on seq2. + over length [ + [ >r 3dup r> swap (seq-2nmap) ] keep + ] repeat 3drop ; inline + +: seq-2map ( seq1 seq2 quot -- seq | quot: elt1 elt2 -- elt3 ) + >r clone r> over >r seq-2nmap r> ; inline + +: index* ( obj i seq -- n ) + #! The index of the object in the sequence, starting from i. + 2dup length >= [ + 3drop -1 ] [ - over type over type eq? [ - 2dup length= [ - swap >list swap >list = - ] [ - 2drop f - ] ifte - ] [ - 2drop f - ] ifte + 3dup nth = [ drop nip ] [ >r 1 + r> index* ] ifte ] ifte ; +: index ( obj seq -- n ) + #! The index of the object in the sequence. + 0 swap index* ; + : push ( element sequence -- ) #! Push a value on the end of a sequence. dup length swap set-nth ; @@ -58,14 +85,22 @@ M: sequence = ( obj seq -- ? ) : >pop> ( stack -- stack ) dup pop drop ; -GENERIC: (tree-each) ( quot obj -- ) inline -M: object (tree-each) swap call ; -M: cons (tree-each) [ car (tree-each) ] 2keep cdr (tree-each) ; -M: f (tree-each) swap call ; -M: sequence (tree-each) [ swap call ] seq-each-with ; -: tree-each swap (tree-each) ; inline -: tree-each-with ( obj vector quot -- ) - swap [ with ] tree-each 2drop ; inline +: length= ( seq seq -- ? ) length swap length number= ; + +M: sequence = ( obj seq -- ? ) + 2dup eq? [ + 2drop t + ] [ + over type over type eq? [ + 2dup length= [ + swap >list swap >list = + ] [ + 2drop f + ] ifte + ] [ + 2drop f + ] ifte + ] ifte ; IN: kernel diff --git a/library/test/vectors.factor b/library/test/vectors.factor index a04dfcef91..078e03a5bf 100644 --- a/library/test/vectors.factor +++ b/library/test/vectors.factor @@ -88,3 +88,6 @@ unit-test "x" get clone length ] with-scope ] unit-test + +[ -1 ] [ 5 { } index ] unit-test +[ 4 ] [ 5 { 1 2 3 4 5 } index ] unit-test