lazy-lists: complete remaining lazy list operations
chris.double
parent
9252f8deb9
commit
668a9cf878
|
|
@ -2,37 +2,11 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! Updated by Matthew Willis, July 2006
|
||||
! Updated by Chris Double, September 2006
|
||||
|
||||
USING: kernel sequences math vectors arrays namespaces generic ;
|
||||
IN: lazy-lists
|
||||
|
||||
TUPLE: cons car cdr ;
|
||||
GENERIC: car ( cons -- car )
|
||||
GENERIC: cdr ( cons -- cdr )
|
||||
GENERIC: nil? ( cons -- bool )
|
||||
|
||||
C: cons ( car cdr -- list )
|
||||
[ set-cons-cdr ] keep
|
||||
[ set-cons-car ] keep ;
|
||||
|
||||
M: cons car ( cons -- car )
|
||||
cons-car ;
|
||||
|
||||
: nil ( -- cons )
|
||||
T{ cons f f f } ;
|
||||
|
||||
M: cons nil? ( cons -- bool )
|
||||
nil eq? ;
|
||||
|
||||
: cons ( car cdr -- list )
|
||||
<cons> ;
|
||||
|
||||
: 1list ( obj -- cons )
|
||||
nil <cons> ;
|
||||
|
||||
: 2list ( obj obj -- cons )
|
||||
nil <cons> <cons> ;
|
||||
|
||||
TUPLE: promise quot forced? value ;
|
||||
|
||||
C: promise ( quot -- promise ) [ set-promise-quot ] keep ;
|
||||
|
|
@ -47,6 +21,36 @@ C: promise ( quot -- promise ) [ set-promise-quot ] keep ;
|
|||
] unless
|
||||
promise-value ;
|
||||
|
||||
TUPLE: cons car cdr ;
|
||||
GENERIC: car ( cons -- car )
|
||||
GENERIC: cdr ( cons -- cdr )
|
||||
GENERIC: nil? ( cons -- bool )
|
||||
|
||||
C: cons ( car cdr -- list )
|
||||
[ set-cons-cdr ] keep
|
||||
[ set-cons-car ] keep ;
|
||||
|
||||
M: cons car ( cons -- car )
|
||||
cons-car ;
|
||||
|
||||
M: cons cdr ( cons -- cdr )
|
||||
cons-cdr ;
|
||||
|
||||
: nil ( -- cons )
|
||||
T{ cons f f f } ;
|
||||
|
||||
M: cons nil? ( cons -- bool )
|
||||
nil eq? ;
|
||||
|
||||
: cons ( car cdr -- list )
|
||||
<cons> ;
|
||||
|
||||
: 1list ( obj -- cons )
|
||||
nil <cons> ;
|
||||
|
||||
: 2list ( a b -- cons )
|
||||
nil <cons> <cons> ;
|
||||
|
||||
! Both 'car' and 'cdr' are promises
|
||||
: lazy-cons ( car cdr -- promise )
|
||||
>r <promise> r> <promise> <cons>
|
||||
|
|
@ -80,15 +84,20 @@ TUPLE: list ;
|
|||
: uncons ( cons -- car cdr )
|
||||
#! Return the car and cdr of the lazy list
|
||||
dup car swap cdr ;
|
||||
|
||||
|
||||
: leach ( list quot -- )
|
||||
swap dup nil? [
|
||||
2drop
|
||||
] [
|
||||
uncons swap pick call swap leach
|
||||
] if ;
|
||||
|
||||
: 2curry ( a b quot -- quot )
|
||||
curry curry ;
|
||||
|
||||
TUPLE: lazy-map cons quot ;
|
||||
|
||||
: lmap ( list quot -- list )
|
||||
#! Return a lazy list containing the collected result of calling
|
||||
#! quot on the original lazy list.
|
||||
: lmap ( list quot -- result )
|
||||
over nil? [ 2drop nil ] [ <lazy-map> ] if ;
|
||||
|
||||
M: lazy-map car ( lazy-map -- car )
|
||||
|
|
@ -99,11 +108,12 @@ M: lazy-map cdr ( lazy-map -- cdr )
|
|||
[ lazy-map-cons cdr ] keep
|
||||
lazy-map-quot lmap ;
|
||||
|
||||
M: lazy-map nil? ( lazy-map -- bool )
|
||||
lazy-map-cons nil? ;
|
||||
|
||||
TUPLE: lazy-take n cons ;
|
||||
|
||||
: ltake ( n list -- list )
|
||||
#! Return a lazy list containing the first n items from
|
||||
#! the original lazy list.
|
||||
: ltake ( n list -- result )
|
||||
over zero? [ 2drop nil ] [ <lazy-take> ] if ;
|
||||
|
||||
M: lazy-take car ( lazy-take -- car )
|
||||
|
|
@ -113,6 +123,9 @@ M: lazy-take cdr ( lazy-take -- cdr )
|
|||
[ lazy-take-n 1- ] keep
|
||||
lazy-take-cons cdr ltake ;
|
||||
|
||||
M: lazy-take nil? ( lazy-take -- bool )
|
||||
lazy-take-n zero? ;
|
||||
|
||||
TUPLE: lazy-subset cons quot ;
|
||||
|
||||
: lsubset ( list quot -- list )
|
||||
|
|
@ -152,90 +165,50 @@ M: lazy-subset nil? ( lazy-subset -- bool )
|
|||
] if
|
||||
] if ;
|
||||
|
||||
: t1
|
||||
[ 1 ] [ [ 2 ] [ [ 3 ] [ nil ] cons ] cons ] cons ;
|
||||
|
||||
: t2
|
||||
[ 2 ] [ [ 3 ] [ [ 4 ] [ nil ] cons ] cons ] cons ;
|
||||
|
||||
: (list>backwards-vector) ( list -- vector )
|
||||
dup nil? [ drop V{ } clone ]
|
||||
[ uncons (list>backwards-vector) swap over push ] if ;
|
||||
|
||||
: list>vector ( list -- vector )
|
||||
#! Convert a lazy list to a vector. This will cause
|
||||
#! an infinite loop if the lazy list is an infinite list.
|
||||
(list>backwards-vector) reverse ;
|
||||
[ [ , ] leach ] V{ } make ;
|
||||
|
||||
: list>array ( list -- array )
|
||||
list>vector >array ;
|
||||
[ [ , ] leach ] { } make ;
|
||||
|
||||
DEFER: backwards-vector>list
|
||||
: (backwards-vector>list) ( vector -- list )
|
||||
dup empty? [ drop nil ]
|
||||
[ dup pop swap backwards-vector>list cons ] if ;
|
||||
TUPLE: lazy-append list1 list2 ;
|
||||
|
||||
DEFER: force-promise
|
||||
: lappend ( list1 list2 -- result )
|
||||
{
|
||||
{ [ over nil? over nil? and ] [ 2drop nil ] }
|
||||
{ [ over nil? ] [ nip ] }
|
||||
{ [ dup nil? ] [ drop ] }
|
||||
{ [ t ] [ <lazy-append> ] }
|
||||
} cond ;
|
||||
|
||||
: backwards-vector>list ( vector -- list )
|
||||
[ , \ (backwards-vector>list) , ] force-promise ;
|
||||
|
||||
: array>list ( array -- list )
|
||||
#! Convert a list to a lazy list.
|
||||
reverse >vector backwards-vector>list ;
|
||||
M: lazy-append car ( lazy-append -- car )
|
||||
lazy-append-list1 car ;
|
||||
|
||||
DEFER: lappend*
|
||||
: (lappend*) ( lists -- list )
|
||||
dup nil? [
|
||||
uncons >r dup nil? [ drop r> (lappend*) ]
|
||||
[ uncons r> cons lappend* cons ] if
|
||||
] unless ;
|
||||
M: lazy-append cdr ( lazy-append -- cdr )
|
||||
[ lazy-append-list1 cdr ] keep
|
||||
lazy-append-list2 lappend ;
|
||||
|
||||
: lappend* ( llists -- list )
|
||||
#! Given a lazy list of lazy lists, concatenate them
|
||||
#! together in a lazy fashion. The actual appending is
|
||||
#! done lazily on iteration rather than immediately
|
||||
#! so it works very fast no matter how large the lists.
|
||||
[ , \ (lappend*) , ] force-promise ;
|
||||
M: lazy-append nil? ( lazy-append -- bool )
|
||||
dup lazy-append-list1 nil? [
|
||||
drop t
|
||||
] [
|
||||
lazy-append-list2 nil?
|
||||
] if ;
|
||||
|
||||
: lappend ( list1 list2 -- llist )
|
||||
#! Concatenate two lazy lists such that they appear to be one big
|
||||
#! lazy list.
|
||||
lunit cons lappend* ;
|
||||
TUPLE: lazy-from-by n quot ;
|
||||
|
||||
: leach ( list quot -- )
|
||||
#! Call the quotation on each item in the lazy list.
|
||||
#! Warning: If the list is infinite then this will
|
||||
#! never return.
|
||||
swap dup nil? [ 2drop ] [
|
||||
uncons swap pick call swap leach
|
||||
] if ;
|
||||
|
||||
DEFER: lapply
|
||||
: (lapply) ( list quot -- list )
|
||||
over nil? [ drop ] [
|
||||
swap dup car >r uncons pick call swap lapply
|
||||
r> swap cons
|
||||
] if ;
|
||||
|
||||
: lapply ( list quot -- list )
|
||||
#! Returns a lazy list which is
|
||||
#! (cons (car list)
|
||||
#! (lapply (quot (car list) (cdr list)) quot))
|
||||
#! This allows for complicated list functions
|
||||
[ swap , , \ (lapply) , ] force-promise ;
|
||||
|
||||
DEFER: lfrom-by
|
||||
: (lfrom-by) ( n quot -- list )
|
||||
2dup call swap lfrom-by cons ;
|
||||
|
||||
: lfrom-by ( n quot -- list )
|
||||
#! Return a lazy list of values starting from n, with
|
||||
#! each successive value being the result of applying quot to
|
||||
#! n.
|
||||
[ swap , , \ (lfrom-by) , ] force-promise ;
|
||||
<lazy-from-by> ;
|
||||
|
||||
: lfrom ( n -- list )
|
||||
#! Return a lazy list of increasing numbers starting
|
||||
#! from the initial value 'n'.
|
||||
[ 1 + ] lfrom-by ;
|
||||
[ 1 + ] lfrom-by ;
|
||||
|
||||
M: lazy-from-by car ( lazy-from-by -- car )
|
||||
lazy-from-by-n ;
|
||||
|
||||
M: lazy-from-by cdr ( lazy-from-by -- cdr )
|
||||
[ lazy-from-by-n ] keep
|
||||
lazy-from-by-quot dup >r call r> lfrom-by ;
|
||||
|
||||
M: lazy-from-by nil? ( lazy-from-by -- bool )
|
||||
drop f ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: help lazy-lists ;
|
||||
USING: help lazy-lists sequences ;
|
||||
|
||||
HELP: <promise>
|
||||
{ $values { "quot" "a quotation with stack effect ( -- X )" } { "promise" "a promise object" } }
|
||||
|
|
@ -14,46 +14,116 @@ HELP: force
|
|||
{ $see-also <promise> } ;
|
||||
|
||||
HELP: <cons>
|
||||
{ $values { "car" "A promise for the head of the lazy list" } { "cdr" "A promise for the tail of the lazy list" } { "cons" "a cons object" } }
|
||||
{ $description "Constructs a lazy cons cell. The car and cdr are promises that, when forced, provide the non-lazy values." }
|
||||
{ $see-also car cdr nil } ;
|
||||
{ $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? } ;
|
||||
|
||||
HELP: car
|
||||
{ $values { "cons" "a cons object" } { "car" "the first item in the list" } }
|
||||
{ $description "Returns the first item in the list. This causes the item to be evaluated." }
|
||||
{ $see-also <cons> car cdr } ;
|
||||
{ $description "Returns the first item in the list." }
|
||||
{ $see-also cons cdr nil nil? } ;
|
||||
|
||||
HELP: cdr
|
||||
{ $values { "cons" "a cons object" } { "cdr" "a cons object" } }
|
||||
{ $description "Returns the tail of the list." }
|
||||
{ $see-also <cons> car cdr } ;
|
||||
|
||||
HELP: cons
|
||||
{ $values { "car" "a quotation with stack effect ( -- X )" } { "cdr" "a quotation with stack effect ( -- cons )" } { "cons" "the resulting cons object" } }
|
||||
{ $description "Constructs a cons object for a lazy list from two quotations. The 'car' quotation should return the head of the list, and the 'cons' quotation the tail when called." }
|
||||
{ $see-also <cons> car cdr } ;
|
||||
{ $see-also cons car nil nil? } ;
|
||||
|
||||
HELP: nil
|
||||
{ $values { "array" "An empty array" } }
|
||||
{ $description "Returns a representation of an empty lazy list" }
|
||||
{ $see-also <cons> car cdr nil? } ;
|
||||
{ $values { "cons" "An empty cons" } }
|
||||
{ $description "Returns a representation of an empty list" }
|
||||
{ $see-also cons car cdr nil? } ;
|
||||
|
||||
HELP: nil?
|
||||
{ $values { "cons" "a cons object" } }
|
||||
{ $description "Return true if the cons object is the nil list." }
|
||||
{ $see-also nil } ;
|
||||
{ $description "Return true if the cons object is the nil cons." }
|
||||
{ $see-also cons car cdr nil } ;
|
||||
|
||||
HELP: <list>
|
||||
{ $values { "car" "the car of the list" } { "cdr" "a <cons> object for the cdr of the list" } { "list" "a lazy list" } }
|
||||
{ $description "Constructs a lazy list where the car is already forced and the cdr is an already forced list." }
|
||||
{ $see-also car cdr } ;
|
||||
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 car cdr nil nil? } ;
|
||||
|
||||
HELP: 1list
|
||||
{ $values { "obj" "an object" } { "list" "a list" } }
|
||||
{ $values { "obj" "an object" } { "cons" "a cons object" } }
|
||||
{ $description "Create a list with 1 element." }
|
||||
{ $see-also <list> 2list } ;
|
||||
{ $see-also 2list } ;
|
||||
|
||||
HELP: 2list
|
||||
{ $values { "a" "an object" } { "b" "an object" } { "list" "a list" } }
|
||||
{ $values { "a" "an object" } { "b" "an object" } { "cons" "a cons object" } }
|
||||
{ $description "Create a list with 2 elements." }
|
||||
{ $see-also <list> 1list } ;
|
||||
{ $see-also 1list } ;
|
||||
|
||||
HELP: lazy-cons
|
||||
{ $values { "car" "a quotation with stack effect ( -- X )" } { "cdr" "a quotation with stack effect ( -- cons )" } { "cons" "the resulting cons object" } }
|
||||
{ $description "Constructs a cons object for a lazy list from two quotations. The 'car' quotation should return the head of the list, and the 'cons' quotation the tail when called. When " { $link cons } " or " { $link cdr } " are called on the lazy-cons object then the appropriate quotation is called." }
|
||||
{ $see-also cons car cdr nil nil? } ;
|
||||
|
||||
HELP: 1lazy-list
|
||||
{ $values { "a" "a quotation with stack effect ( -- X )" } { "lazy-cons" "a lazy-cons object" } }
|
||||
{ $description "Create a lazy list with 1 element. The element is the result of calling the quotation. The quotation is only called when the list element is requested." }
|
||||
{ $see-also 2lazy-list 3lazy-list } ;
|
||||
|
||||
HELP: 2lazy-list
|
||||
{ $values { "a" "a quotation with stack effect ( -- X )" } { "b" "a quotation with stack effect ( -- X )" } { "lazy-cons" "a lazy-cons object" } }
|
||||
{ $description "Create a lazy list with 2 elements. The elements are the result of calling the quotations. The quotations are only called when the list elements are requested." }
|
||||
{ $see-also 1lazy-list 3lazy-list } ;
|
||||
|
||||
HELP: 3lazy-list
|
||||
{ $values { "a" "a quotation with stack effect ( -- X )" } { "b" "a quotation with stack effect ( -- X )" } { "c" "a quotation with stack effect ( -- X )" } { "lazy-cons" "a lazy-cons object" } }
|
||||
{ $description "Create a lazy list with 3 elements. The elements are the result of calling the quotations. The quotations are only called when the list elements are requested." }
|
||||
{ $see-also 1lazy-list 2lazy-list } ;
|
||||
|
||||
HELP: lnth
|
||||
{ $values { "n" "an integer index" } { "list" "a cons object" } { "elt" "the element at the nth index" } }
|
||||
{ $description "Outputs the nth element of the list." }
|
||||
{ $see-also cons car cdr } ;
|
||||
|
||||
HELP: uncons
|
||||
{ $values { "cons" "a cons object" } { "car" "the head of the list" } { "cdr" "the tail of the list" } }
|
||||
{ $description "Put the head and tail of the list on the stack." }
|
||||
{ $see-also cons car cdr } ;
|
||||
|
||||
HELP: leach
|
||||
{ $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( -- )" } }
|
||||
{ $description "Call the quotation for each item in the list." }
|
||||
{ $see-also lmap ltake lsubset lappend lfrom lfrom-by } ;
|
||||
|
||||
HELP: lmap
|
||||
{ $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( -- X )" } { "result" "resulting cons object" } }
|
||||
{ $description "Perform a similar functionality to that of the " { $link map } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-map> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." }
|
||||
{ $see-also leach ltake lsubset lappend lfrom lfrom-by } ;
|
||||
|
||||
HELP: ltake
|
||||
{ $values { "n" "a non negative integer" } { "list" "a cons object" } { "result" "resulting cons object" } }
|
||||
{ $description "Outputs a lazy list containing the first n items in the list. This is done a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-take> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." }
|
||||
{ $see-also leach lmap lsubset lappend lfrom lfrom-by } ;
|
||||
|
||||
HELP: lsubset
|
||||
{ $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( -- X )" } { "result" "resulting cons object" } }
|
||||
{ $description "Perform a similar functionality to that of the " { $link subset } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-subset> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." }
|
||||
{ $see-also leach lmap ltake lappend lfrom lfrom-by } ;
|
||||
|
||||
HELP: list>vector
|
||||
{ $values { "list" "a cons object" } { "vector" "the list converted to a vector" } }
|
||||
{ $description "Convert a list to a vector. If the list is a lazy infinite list then this will enter an infinite loop." }
|
||||
{ $see-also list>array } ;
|
||||
|
||||
HELP: list>array
|
||||
{ $values { "list" "a cons object" } { "array" "the list converted to an array" } }
|
||||
{ $description "Convert a list to an array. If the list is a lazy infinite list then this will enter an infinite loop." }
|
||||
{ $see-also list>vector } ;
|
||||
|
||||
HELP: lappend
|
||||
{ $values { "list1" "a cons object" } { "list2" "a cons object" } { "result" "a lazy list of list2 appended to list1" } }
|
||||
{ $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-append> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." }
|
||||
{ $see-also leach lmap ltake lsubset lfrom lfrom-by } ;
|
||||
|
||||
HELP: lfrom-by
|
||||
{ $values { "n" "an integer" } { "quot" "a quotation with stack effect ( -- int )" } { "result" "a lazy list of integers" } }
|
||||
{ $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to n." }
|
||||
{ $see-also leach lmap ltake lsubset lfrom } ;
|
||||
|
||||
HELP: lfrom
|
||||
{ $values { "n" "an integer" } { "result" "a lazy list of integers" } }
|
||||
{ $description "Return an infinite lazy list of incrementing integers starting from n." }
|
||||
{ $see-also leach lmap ltake lsubset lfrom-by } ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue