lazy-lists: make seq>list more efficient
chris.double
parent
48a3fad1a1
commit
b7dc804433
|
|
@ -4,7 +4,7 @@
|
|||
! Updated by Matthew Willis, July 2006
|
||||
! Updated by Chris Double, September 2006
|
||||
!
|
||||
USING: kernel sequences math vectors arrays namespaces generic ;
|
||||
USING: kernel sequences math vectors arrays namespaces generic errors ;
|
||||
IN: lazy-lists
|
||||
|
||||
TUPLE: promise quot forced? value ;
|
||||
|
|
@ -22,9 +22,13 @@ C: promise ( quot -- promise ) [ set-promise-quot ] keep ;
|
|||
promise-value ;
|
||||
|
||||
TUPLE: cons car cdr ;
|
||||
GENERIC: car ( cons -- car )
|
||||
GENERIC: cdr ( cons -- cdr )
|
||||
GENERIC: nil? ( cons -- bool )
|
||||
GENERIC: car ( cons -- car )
|
||||
GENERIC: cdr ( cons -- cdr )
|
||||
GENERIC: nil? ( cons -- bool )
|
||||
GENERIC: list? ( object -- bool )
|
||||
|
||||
M: object list? ( object -- bool )
|
||||
drop f ;
|
||||
|
||||
C: cons ( car cdr -- list )
|
||||
[ set-cons-cdr ] keep
|
||||
|
|
@ -42,6 +46,9 @@ M: cons cdr ( cons -- cdr )
|
|||
M: cons nil? ( cons -- bool )
|
||||
nil eq? ;
|
||||
|
||||
M: cons list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
: cons ( car cdr -- list )
|
||||
<cons> ;
|
||||
|
||||
|
|
@ -68,6 +75,9 @@ M: promise cdr ( promise -- cdr )
|
|||
M: promise nil? ( cons -- bool )
|
||||
force nil? ;
|
||||
|
||||
M: promise list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
DEFER: lunit
|
||||
DEFER: lnth
|
||||
TUPLE: list ;
|
||||
|
|
@ -133,6 +143,9 @@ M: memoized-cons nil? ( memoized-cons -- bool )
|
|||
memoized-cons-nil?
|
||||
] if ;
|
||||
|
||||
M: memoized-cons list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
TUPLE: lazy-map cons quot ;
|
||||
|
||||
: lmap ( list quot -- result )
|
||||
|
|
@ -149,6 +162,9 @@ M: lazy-map cdr ( lazy-map -- cdr )
|
|||
M: lazy-map nil? ( lazy-map -- bool )
|
||||
lazy-map-cons nil? ;
|
||||
|
||||
M: lazy-map list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
TUPLE: lazy-map-with value cons quot ;
|
||||
|
||||
: lmap-with ( value list quot -- result )
|
||||
|
|
@ -167,6 +183,9 @@ M: lazy-map-with cdr ( lazy-map-with -- cdr )
|
|||
M: lazy-map-with nil? ( lazy-map-with -- bool )
|
||||
lazy-map-with-cons nil? ;
|
||||
|
||||
M: lazy-map-with list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
TUPLE: lazy-take n cons ;
|
||||
|
||||
: ltake ( n list -- result )
|
||||
|
|
@ -182,6 +201,9 @@ M: lazy-take cdr ( lazy-take -- cdr )
|
|||
M: lazy-take nil? ( lazy-take -- bool )
|
||||
lazy-take-n zero? ;
|
||||
|
||||
M: lazy-take list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
TUPLE: lazy-subset cons quot ;
|
||||
|
||||
: lsubset ( list quot -- list )
|
||||
|
|
@ -221,6 +243,9 @@ M: lazy-subset nil? ( lazy-subset -- bool )
|
|||
] if
|
||||
] if ;
|
||||
|
||||
M: lazy-subset list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
: list>vector ( list -- vector )
|
||||
[ [ , ] leach ] V{ } make ;
|
||||
|
||||
|
|
@ -251,6 +276,9 @@ M: lazy-append nil? ( lazy-append -- bool )
|
|||
lazy-append-list2 nil?
|
||||
] if ;
|
||||
|
||||
M: lazy-append list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
TUPLE: lazy-from-by n quot ;
|
||||
|
||||
: lfrom-by ( n quot -- list )
|
||||
|
|
@ -269,6 +297,9 @@ M: lazy-from-by cdr ( lazy-from-by -- cdr )
|
|||
M: lazy-from-by nil? ( lazy-from-by -- bool )
|
||||
drop f ;
|
||||
|
||||
M: lazy-from-by list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
TUPLE: lazy-zip list1 list2 ;
|
||||
|
||||
: lzip ( list1 list2 -- lazy-zip )
|
||||
|
|
@ -283,9 +314,39 @@ M: lazy-zip cdr ( lazy-zip -- cdr )
|
|||
|
||||
M: lazy-zip nil? ( lazy-zip -- bool )
|
||||
drop f ;
|
||||
|
||||
: seq>list ( seq -- list )
|
||||
reverse nil [ swap cons ] reduce ;
|
||||
|
||||
M: lazy-zip list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
TUPLE: sequence-cons index seq ;
|
||||
|
||||
: seq>list ( index seq -- list )
|
||||
2dup length >= [
|
||||
2drop nil
|
||||
] [
|
||||
<sequence-cons>
|
||||
] if ;
|
||||
|
||||
M: sequence-cons car ( sequence-cons -- car )
|
||||
[ sequence-cons-index ] keep
|
||||
sequence-cons-seq nth ;
|
||||
|
||||
M: sequence-cons cdr ( sequence-cons -- cdr )
|
||||
[ sequence-cons-index 1+ ] keep
|
||||
sequence-cons-seq seq>list ;
|
||||
|
||||
M: sequence-cons nil? ( sequence-cons -- bool )
|
||||
drop f ;
|
||||
|
||||
M: sequence-cons list? ( object -- bool )
|
||||
drop t ;
|
||||
|
||||
: >list ( object -- list )
|
||||
{
|
||||
{ [ dup sequence? ] [ 0 swap seq>list ] }
|
||||
{ [ dup list? ] [ ] }
|
||||
{ [ t ] [ "Could not convert object to a list" throw ] }
|
||||
} cond ;
|
||||
|
||||
: lconcat ( list -- result )
|
||||
list>array nil [ lappend ] reduce ;
|
||||
|
|
|
|||
|
|
@ -16,27 +16,32 @@ HELP: force
|
|||
HELP: <cons>
|
||||
{ $values { "car" "the head of the lazy list" } { "cdr" "the tail of the lazy list" } { "cons" "a cons object" } }
|
||||
{ $description "Constructs a cons cell." }
|
||||
{ $see-also cons car cdr nil nil? } ;
|
||||
{ $see-also cons car cdr nil nil? list? } ;
|
||||
|
||||
HELP: car
|
||||
{ $values { "cons" "a cons object" } { "car" "the first item in the list" } }
|
||||
{ $description "Returns the first item in the list." }
|
||||
{ $see-also cons cdr nil nil? } ;
|
||||
{ $see-also cons cdr nil nil? list? } ;
|
||||
|
||||
HELP: cdr
|
||||
{ $values { "cons" "a cons object" } { "cdr" "a cons object" } }
|
||||
{ $description "Returns the tail of the list." }
|
||||
{ $see-also cons car nil nil? } ;
|
||||
{ $see-also cons car nil nil? list? } ;
|
||||
|
||||
HELP: nil
|
||||
{ $values { "cons" "An empty cons" } }
|
||||
{ $description "Returns a representation of an empty list" }
|
||||
{ $see-also cons car cdr nil? } ;
|
||||
{ $see-also cons car cdr nil? list? } ;
|
||||
|
||||
HELP: nil?
|
||||
{ $values { "cons" "a cons object" } }
|
||||
{ $description "Return true if the cons object is the nil cons." }
|
||||
{ $see-also cons car cdr nil } ;
|
||||
{ $see-also cons car cdr nil list? } ;
|
||||
|
||||
HELP: list?
|
||||
{ $values { "object" "an object" } }
|
||||
{ $description "Returns true if the object conforms to the list protocol." }
|
||||
{ $see-also cons car cdr nil } ;
|
||||
|
||||
HELP: cons
|
||||
{ $values { "car" "the head of the lazy list" } { "cdr" "the tail of the lazy list" } { "cons" "a cons object" } }
|
||||
|
|
@ -46,12 +51,17 @@ HELP: cons
|
|||
HELP: 1list
|
||||
{ $values { "obj" "an object" } { "cons" "a cons object" } }
|
||||
{ $description "Create a list with 1 element." }
|
||||
{ $see-also 2list } ;
|
||||
{ $see-also 2list 3list } ;
|
||||
|
||||
HELP: 2list
|
||||
{ $values { "a" "an object" } { "b" "an object" } { "cons" "a cons object" } }
|
||||
{ $description "Create a list with 2 elements." }
|
||||
{ $see-also 1list } ;
|
||||
{ $see-also 1list 3list } ;
|
||||
|
||||
HELP: 3list
|
||||
{ $values { "a" "an object" } { "b" "an object" } { "c" "an object" } { "cons" "a cons object" } }
|
||||
{ $description "Create a list with 3 elements." }
|
||||
{ $see-also 1list 2list } ;
|
||||
|
||||
HELP: lazy-cons
|
||||
{ $values { "car" "a quotation with stack effect ( -- X )" } { "cdr" "a quotation with stack effect ( -- cons )" } { "cons" "the resulting cons object" } }
|
||||
|
|
@ -139,9 +149,14 @@ HELP: lfrom
|
|||
{ $see-also leach lmap lmap-with ltake lsubset lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* } ;
|
||||
|
||||
HELP: seq>list
|
||||
{ $values { "seq" "a sequence" } { "list" "a list" } }
|
||||
{ $description "Convert the sequence into a list." }
|
||||
{ $see-also cons } ;
|
||||
{ $values { "index" "an integer 0 or greater" } { "seq" "a sequence" } { "list" "a list" } }
|
||||
{ $description "Convert the sequence into a list, starting from the 'index' offset into the sequence." }
|
||||
{ $see-also >list } ;
|
||||
|
||||
HELP: >list
|
||||
{ $values { "object" "an object" } { "list" "a list" } }
|
||||
{ $description "Convert the object into a list. Existing lists are passed through intact, sequences are converted using " { $link seq>list } " and other objects cause an error to be thrown." }
|
||||
{ $see-also seq>list } ;
|
||||
|
||||
HELP: lconcat
|
||||
{ $values { "list" "a list of lists" } { "result" "a list" } }
|
||||
|
|
|
|||
|
|
@ -9,5 +9,4 @@ PROVIDE: contrib/lazy-lists {
|
|||
"examples.factor"
|
||||
} {
|
||||
"test/lists.factor"
|
||||
"test/examples.factor"
|
||||
} ;
|
||||
|
|
@ -1,60 +1,25 @@
|
|||
! Copyright (C) 2006 Matthew Willis.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
USING: lazy-lists test kernel math io ;
|
||||
! Copyright (C) 2006 Matthew Willis and Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: lazy-lists test kernel math io sequences ;
|
||||
IN: temporary
|
||||
|
||||
[ t ] [ nil nil? ] unit-test
|
||||
[ 5 ] [ 5 lunit car ] unit-test
|
||||
[ f ] [ nil nil cons nil? ] unit-test
|
||||
[ 5 t ] [ 5 lunit uncons nil? ] unit-test
|
||||
[ 6 ] [
|
||||
5 6 lunit cons
|
||||
1 swap lnth
|
||||
] unit-test
|
||||
[ 12 13 t ] [
|
||||
5 6 lunit cons
|
||||
[ 7 + ] lmap uncons uncons nil?
|
||||
] unit-test
|
||||
[ 5 6 t ] [
|
||||
5 6 7 lunit cons cons 2 swap ltake
|
||||
uncons uncons nil?
|
||||
] unit-test
|
||||
[ 6 7 t ] [ 5 6 7 lunit cons cons [ 5 > ] lsubset
|
||||
uncons uncons nil? ] unit-test
|
||||
[ 7 t ] [ 5 6 7 lunit cons cons [ 6 > ] lsubset
|
||||
uncons nil? ] unit-test
|
||||
[ 1 3 5 t ] [ { 1 3 5 } array>list
|
||||
uncons uncons uncons nil? ] unit-test
|
||||
[ { 1 3 5 } ] [ { 1 3 5 } array>list list>array ] unit-test
|
||||
[ { 1 2 3 4 5 6 7 8 9 } ] [
|
||||
{ 1 2 3 } array>list
|
||||
{ 4 5 6 } array>list
|
||||
{ 7 8 9 } array>list
|
||||
lunit cons cons lappend* list>array ] unit-test
|
||||
[ { 1 2 3 4 5 6 } ]
|
||||
[ { 1 2 3 } array>list { 4 5 6 } array>list
|
||||
lappend list>array ] unit-test
|
||||
[ ] [ { 1 2 3 } array>list [ 3 + number>string print ] leach ] unit-test
|
||||
[ { 1 2 3 4 } ]
|
||||
[ 0 lfrom [ 5 < ] lsubset [ 0 > ] lsubset 4 swap ltake list>array ] unit-test
|
||||
[ { 1 2 3 4 } ] [
|
||||
{ 1 2 3 4 } >list list>array
|
||||
] unit-test
|
||||
|
||||
[ { { 1 4 } { 1 5 } { 2 4 } { 2 5 } { 3 4 } { 3 5 } } ] [
|
||||
{ 1 2 3 } >list { 4 5 } >list 2list lcartesian-product* list>array
|
||||
] unit-test
|
||||
|
||||
[ { { 1 4 } { 1 5 } { 2 4 } { 2 5 } { 3 4 } { 3 5 } } ] [
|
||||
{ 1 2 3 } >list { 4 5 } >list lcartesian-product list>array
|
||||
] unit-test
|
||||
|
||||
[ { 5 6 6 7 7 8 } ] [
|
||||
{ 1 2 3 } >list { 4 5 } >list 2list [ first2 + ] lcomp list>array
|
||||
] unit-test
|
||||
|
||||
[ { 5 6 7 8 } ] [
|
||||
{ 1 2 3 } >list { 4 5 } >list 2list { [ first odd? ] } [ first2 + ] lcomp* list>array
|
||||
] unit-test
|
||||
|
|
|
|||
Loading…
Reference in New Issue