From fc4532ee7c8d7aaf8ccd11c51c6fe184afb17879 Mon Sep 17 00:00:00 2001 From: "matthew.willis" Date: Sat, 22 Jul 2006 20:48:42 +0000 Subject: [PATCH] Made the force-promise pattern into a word, removed delay, corrected misc errors. --- .../parser-combinators/lazy-examples.factor | 8 +-- contrib/parser-combinators/lazy.factor | 53 ++++++++++--------- 2 files changed, 31 insertions(+), 30 deletions(-) diff --git a/contrib/parser-combinators/lazy-examples.factor b/contrib/parser-combinators/lazy-examples.factor index ef03f95ab9..a1ae572d35 100644 --- a/contrib/parser-combinators/lazy-examples.factor +++ b/contrib/parser-combinators/lazy-examples.factor @@ -23,7 +23,7 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: lazy-examples -USING: lazy math kernel sequences namespaces ; +USING: lazy math kernel sequences ; : naturals 0 lfrom ; : positves 1 lfrom ; @@ -31,8 +31,8 @@ USING: lazy math kernel sequences namespaces ; : odds 1 lfrom [ 2 mod 1 = ] lsubset ; : powers-of-2 1 [ 2 * ] lfrom-by ; : ones 1 [ ] lfrom-by ; -: squares lnaturals [ dup * ] lmap ; -: first-five-squares 5 lsquares ltake ; +: squares naturals [ dup * ] lmap ; +: first-five-squares 5 squares ltake ; : divisible-by? ( a b -- bool ) #! Return true if a is divisible by b @@ -44,4 +44,4 @@ USING: lazy math kernel sequences namespaces ; : primes 2 lfrom [ filter-multiples ] lapply ; -: first-ten-primes 10 lprimes ltake list>array ; +: first-ten-primes 10 primes ltake list>array ; diff --git a/contrib/parser-combinators/lazy.factor b/contrib/parser-combinators/lazy.factor index a0522b46ee..8f79e95a4c 100644 --- a/contrib/parser-combinators/lazy.factor +++ b/contrib/parser-combinators/lazy.factor @@ -23,18 +23,13 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: lazy -USING: kernel sequences namespaces math vectors arrays ; +USING: kernel sequences math vectors arrays namespaces ; TUPLE: promise quot forced? value ; -: delay ( quot -- ) - #! Given a quotation, create a promise which may later be forced. - #! When forced the quotation will execute returning the value. Future - #! forces of the promise will return that value and not re-execute - #! the quotation. - f f ; +C: promise ( quot -- promise ) [ set-promise-quot ] keep ; -: force ( -- value ) +: 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. @@ -52,7 +47,7 @@ TUPLE: cons car cdr ; : nil? ( list -- bool ) #! Is the given lazy cons the nil value - force dup array? [ empty? ] [ drop f ] if ; + force { } = ; : car ( list -- car ) #! Return the value of the head of the lazy list. @@ -65,7 +60,7 @@ TUPLE: cons car cdr ; : cons ( car cdr -- list ) #! Given a car and cdr, both lazy values, return a lazy cons. - [ swap , , \ , ] [ ] make delay ; + [ swap , , \ , ] [ ] make ; : lunit ( obj -- list ) #! Given a value produce a lazy list containing that value. @@ -78,6 +73,12 @@ TUPLE: cons car cdr ; : uncons ( cons -- car cdr ) #! Return the car and cdr of the lazy list force dup cons-car swap cons-cdr ; + +: force-promise ( list-quot -- list ) + #! Promises to force list-quot, which should be + #! a quot that produces a list. + #! This allows caching of the resultant list value. + [ call \ force , ] [ ] make ; inline DEFER: lmap : (lmap) ( list quot -- list ) @@ -90,9 +91,9 @@ DEFER: lmap ] if ; : lmap ( list quot -- list ) - #! Return a lazy list containing the collected result of calling - #! quot on the original lazy list. - [ swap , , \ (lmap) , \ force , ] [ ] make delay ; + #! Return a lazy list containing the collected result of calling + #! quot on the original lazy list. + [ swap , , \ (lmap) , ] force-promise ; DEFER: ltake : (ltake) ( n list -- list ) @@ -106,9 +107,9 @@ DEFER: ltake ] if ; : ltake ( n list -- list ) - #! Return a lazy list containing the first n items from - #! the original lazy list. - [ swap , , \ (ltake) , \ force , ] [ ] make delay ; + #! Return a lazy list containing the first n items from + #! the original lazy list. + [ swap , , \ (ltake) , ] force-promise ; DEFER: lsubset : (lsubset) ( list pred -- list ) @@ -122,7 +123,7 @@ DEFER: lsubset : lsubset ( list pred -- list ) #! Return a lazy list containing the elements in llist #! satisfying pred - [ swap , , \ (lsubset) , \ force , ] [ ] make delay ; + [ swap , , \ (lsubset) , ] force-promise ; : (list>backwards-vector) ( list -- vector ) dup nil? [ drop V{ } clone ] @@ -142,7 +143,7 @@ DEFER: backwards-vector>list [ dup pop swap backwards-vector>list cons ] if ; : backwards-vector>list ( vector -- list ) - [ , \ (backwards-vector>list) , \ force , ] [ ] make delay ; + [ , \ (backwards-vector>list) , ] force-promise ; : array>list ( array -- list ) #! Convert a list to a lazy list. @@ -160,7 +161,7 @@ DEFER: lappend* #! 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 , ] [ ] make delay ; + [ , \ (lappend*) , ] force-promise ; : lappend ( list1 list2 -- llist ) #! Concatenate two lazy lists such that they appear to be one big @@ -187,12 +188,7 @@ DEFER: lapply #! (cons (car list) #! (lapply (quot (car list) (cdr list)) quot)) #! This allows for complicated list functions - [ swap , , \ (lapply) , \ force , ] [ ] make delay ; - -: lfrom ( n -- list ) - #! Return a lazy list of increasing numbers starting - #! from the initial value 'n'. - [ dup 1 + lfrom cons force ] curry delay ; + [ swap , , \ (lapply) , ] force-promise ; DEFER: lfrom-by : (lfrom-by) ( n quot -- list ) @@ -202,4 +198,9 @@ DEFER: lfrom-by #! 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 , ] [ ] make delay ; \ No newline at end of file + [ swap , , \ (lfrom-by) , ] force-promise ; + +: 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