! 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: promise quot forced? value ;
+
+C: promise ( quot -- promise ) [ set-promise-quot ] keep ;
+
+: force ( promise -- value )
+ #! Force the given promise leaving the value of calling the
+ #! promises quotation on the stack. Re-forcing the promise
+ #! will return the same value and not recall the quotation.
+ dup promise-forced? [
+ dup promise-quot call over set-promise-value
+ t over set-promise-forced?
+ ] unless
+ promise-value ;
+
TUPLE: cons car cdr ;
GENERIC: car ( cons -- car )
GENERIC: cdr ( cons -- cdr )
M: cons car ( cons -- car )
cons-car ;
+M: cons cdr ( cons -- cdr )
+ cons-cdr ;
+
: nil ( -- cons )
T{ cons f f f } ;
: 1list ( obj -- cons )
nil <cons> ;
-: 2list ( obj obj -- cons )
+: 2list ( a b -- cons )
nil <cons> <cons> ;
-TUPLE: promise quot forced? value ;
-
-C: promise ( quot -- promise ) [ set-promise-quot ] keep ;
-
-: force ( promise -- value )
- #! Force the given promise leaving the value of calling the
- #! promises quotation on the stack. Re-forcing the promise
- #! will return the same value and not recall the quotation.
- dup promise-forced? [
- dup promise-quot call over set-promise-value
- t over set-promise-forced?
- ] unless
- promise-value ;
-
! Both 'car' and 'cdr' are promises
: lazy-cons ( car cdr -- promise )
>r <promise> r> <promise> <cons>
: 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 )
[ 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 )
[ 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 )
] 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 ;
-
-DEFER: lappend*
-: (lappend*) ( lists -- list )
- dup nil? [
- uncons >r dup nil? [ drop r> (lappend*) ]
- [ uncons r> cons lappend* cons ] if
- ] unless ;
-
-: 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 ;
-
-: lappend ( list1 list2 -- llist )
- #! Concatenate two lazy lists such that they appear to be one big
- #! lazy list.
- lunit cons lappend* ;
+M: lazy-append car ( lazy-append -- car )
+ lazy-append-list1 car ;
+
+M: lazy-append cdr ( lazy-append -- cdr )
+ [ lazy-append-list1 cdr ] keep
+ lazy-append-list2 lappend ;
+
+M: lazy-append nil? ( lazy-append -- bool )
+ dup lazy-append-list1 nil? [
+ drop t
+ ] [
+ lazy-append-list2 nil?
+ ] if ;
+
+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 ;
\ No newline at end of file
+ [ 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 ;
! 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" } }
{ $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 } ;
projects / factor.git / commitdiff