From 7450d500272207ca7fd766523feb5f3225fa308e Mon Sep 17 00:00:00 2001 From: "matthew.willis" Date: Sat, 22 Jul 2006 10:52:22 +0000 Subject: [PATCH] Fix indentation, change naming scheme, take out curry's, move from quots to arrays (by way of vectors) and general proofreading and testing. --- .../parser-combinators/lazy-examples.factor | 26 +- contrib/parser-combinators/lazy-tests.factor | 54 ++-- contrib/parser-combinators/lazy.factor | 251 +++++++++--------- 3 files changed, 170 insertions(+), 161 deletions(-) diff --git a/contrib/parser-combinators/lazy-examples.factor b/contrib/parser-combinators/lazy-examples.factor index 14bd048625..ef03f95ab9 100644 --- a/contrib/parser-combinators/lazy-examples.factor +++ b/contrib/parser-combinators/lazy-examples.factor @@ -25,23 +25,23 @@ IN: lazy-examples USING: lazy math kernel sequences namespaces ; -: lnaturals 0 lfrom ; -: lpositves 1 lfrom ; -: levens 0 [ 2 + ] lfrom-by ; -: lodds 1 lfrom [ 2 mod 1 = ] lsubset ; -: lpowers-of-2 1 [ 2 * ] lfrom-by ; -: lones 1 [ ] lfrom-by ; -: lsquares lnaturals [ dup * ] lmap ; +: naturals 0 lfrom ; +: positves 1 lfrom ; +: evens 0 [ 2 + ] lfrom-by ; +: 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 ; : divisible-by? ( a b -- bool ) - #! Return true if a is divisible by b - mod 0 = ; + #! Return true if a is divisible by b + mod 0 = ; -: filter-multiples ( n llist - llist ) - #! Given a lazy list of numbers, filter multiples of n +: filter-multiples ( n list - list ) + #! Given a lazy list of numbers, filter multiples of n swap [ divisible-by? not ] curry lsubset ; -: lprimes 2 lfrom [ filter-multiples ] lapply ; +: primes 2 lfrom [ filter-multiples ] lapply ; -: first-ten-primes 10 lprimes ltake llist>list ; +: first-ten-primes 10 lprimes ltake list>array ; diff --git a/contrib/parser-combinators/lazy-tests.factor b/contrib/parser-combinators/lazy-tests.factor index 5c431fa059..8fde0ef017 100644 --- a/contrib/parser-combinators/lazy-tests.factor +++ b/contrib/parser-combinators/lazy-tests.factor @@ -25,37 +25,37 @@ USING: test kernel math io ; IN: lazy -[ t ] [ lnil lnil? ] unit-test -[ 5 ] [ 5 lunit lcar ] unit-test -[ f ] [ lnil lnil lcons lnil? ] unit-test -[ 5 t ] [ 5 lunit luncons lnil? ] unit-test +[ 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 lcons + 5 6 lunit cons 1 swap lnth ] unit-test [ 12 13 t ] [ - 5 6 lunit lcons - [ 7 + ] lmap luncons luncons lnil? + 5 6 lunit cons + [ 7 + ] lmap uncons uncons nil? ] unit-test [ 5 6 t ] [ - 5 6 7 lunit lcons lcons 2 swap ltake - luncons luncons lnil? + 5 6 7 lunit cons cons 2 swap ltake + uncons uncons nil? ] unit-test -[ 6 7 t ] [ 5 6 7 lunit lcons lcons [ 5 > ] lsubset - luncons luncons lnil? ] unit-test -[ 7 t ] [ 5 6 7 lunit lcons lcons [ 6 > ] lsubset - luncons lnil? ] unit-test -[ 1 3 5 t ] [ [ 1 3 5 ] list>llist - luncons luncons luncons lnil? ] unit-test -[ [ 1 3 5 ] ] [ [ 1 3 5 ] list>llist llist>list ] unit-test -[ [ 1 2 3 4 5 6 7 8 9 ] ] [ - [ 1 2 3 ] list>llist - [ 4 5 6 ] list>llist - [ 7 8 9 ] list>llist - lunit lcons lcons lappend* llist>list ] unit-test -[ [ 1 2 3 4 5 6 ] ] -[ [ 1 2 3 ] list>llist [ 4 5 6 ] list>llist - lappend llist>list ] unit-test -[ ] [ [ 1 2 3 ] list>llist [ 3 + number>string print ] leach ] unit-test -[ [ 1 2 3 4 ] ] - [ 0 lfrom [ 5 < ] lsubset [ 0 > ] lsubset 4 swap ltake llist>list ] 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 diff --git a/contrib/parser-combinators/lazy.factor b/contrib/parser-combinators/lazy.factor index d3c8748c7a..a0522b46ee 100644 --- a/contrib/parser-combinators/lazy.factor +++ b/contrib/parser-combinators/lazy.factor @@ -23,174 +23,183 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: lazy -USE: kernel -USE: sequences -USE: namespaces -USE: math +USING: kernel sequences namespaces math vectors arrays ; 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 ; + #! 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 ; -: (force) ( -- 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 ; +: force ( -- 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: lcons car cdr ; +TUPLE: cons car cdr ; -SYMBOL: lazy-nil -[ [ ] ] delay lazy-nil set +: nil ( -- list ) + #! The nil lazy list. + T{ promise f [ { } ] t { } } ; -: lnil ( -- llist ) - #! Return the nil lazy list. - lazy-nil get ; +: nil? ( list -- bool ) + #! Is the given lazy cons the nil value + force dup array? [ empty? ] [ drop f ] if ; -: lnil? ( llist -- bool ) - #! Is the given lazy cons the nil value - (force) dup quotation? [ empty? ] [ drop f ] if ; +: car ( list -- car ) + #! Return the value of the head of the lazy list. + force cons-car ; -: lcar ( llist -- car ) - #! Return the value of the head of the lazy list. - (force) lcons-car ; +: cdr ( list -- cdr ) + #! Return the rest of the lazy list. + #! This is itself a lazy list. + force cons-cdr ; -: lcdr ( llist -- cdr ) - #! Return the rest of the lazy list. - #! This is itself a lazy list. - (force) lcons-cdr ; +: cons ( car cdr -- list ) + #! Given a car and cdr, both lazy values, return a lazy cons. + [ swap , , \ , ] [ ] make delay ; -: lcons ( lcar lcdr -- llist ) - #! Given a car and cdr, both lazy values, return a lazy cons. - [ ] curry curry delay ; +: lunit ( obj -- list ) + #! Given a value produce a lazy list containing that value. + nil cons ; -: lunit ( lvalue -- llist ) - #! Given a lazy value (a quotation that when called produces - #! the value) produce a lazy list containing that value. - lnil lcons ; +: lnth ( n list -- value ) + #! Return the nth item in a lazy list + swap [ cdr ] times car ; -: lnth ( n llist -- value ) - #! Return the nth item in a lazy list - swap [ lcdr ] times lcar ; - -: luncons ( lcons -- car cdr ) - #! Return the car and cdr of the lazy list - dup lcar swap lcdr ; +: uncons ( cons -- car cdr ) + #! Return the car and cdr of the lazy list + force dup cons-car swap cons-cdr ; DEFER: lmap -: (lmap) ( llist quot -- list ) - over lnil? [ drop ] +: (lmap) ( list quot -- list ) + over nil? [ drop ] [ - swap 2dup - lcdr swap lmap >r - lcar swap call r> - lcons + swap 2dup + cdr swap lmap >r + car swap call r> + cons ] if ; -: lmap ( llist quot -- llist ) +: lmap ( list quot -- list ) #! Return a lazy list containing the collected result of calling #! quot on the original lazy list. - [ (lmap) (force) ] curry curry delay ; + [ swap , , \ (lmap) , \ force , ] [ ] make delay ; DEFER: ltake -: (ltake) ( n llist -- llist ) - over 0 = [ 2drop lnil ] - [ dup lnil? [ nip ] +: (ltake) ( n list -- list ) + over 0 = [ 2drop nil ] + [ dup nil? [ nip ] [ - swap ( llist n -- ) - 1 - >r luncons r> swap ltake - lcons - ] if + swap ( list n -- list ) + 1 - >r uncons r> swap ltake + cons + ] if ] if ; -: ltake ( n llist -- llist ) +: ltake ( n list -- list ) #! Return a lazy list containing the first n items from #! the original lazy list. - [ (ltake) (force) ] curry curry delay ; + [ swap , , \ (ltake) , \ force , ] [ ] make delay ; DEFER: lsubset -: (lsubset) ( llist pred -- llist ) - >r dup lnil? [ r> drop ] +: (lsubset) ( list pred -- list ) + >r dup nil? [ r> drop ] [ - luncons swap dup r> dup >r call - [ swap r> lsubset lcons ] + uncons swap dup r> dup >r call + [ swap r> lsubset cons ] [ drop r> (lsubset) ] if ] if ; -: lsubset ( llist pred -- llist ) - #! Return a lazy list containing the elements in llist - #! satisfying pred - [ (lsubset) (force) ] curry curry delay ; +: lsubset ( list pred -- list ) + #! Return a lazy list containing the elements in llist + #! satisfying pred + [ swap , , \ (lsubset) , \ force , ] [ ] make delay ; -: llist>list ( llist -- list ) - #! Convert a lazy list to a normal list. This will cause - #! an infinite loop if the lazy list is an infinite list. - dup lnil? [ drop [ ] ] - [ luncons llist>list curry ] if ; +: (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 ; -DEFER: list>llist -: (list>llist) ( list -- llist ) - dup empty? [ drop lnil ] - [ dup first 0 rot remove-nth list>llist lcons ] if ; +: list>array ( list -- array ) + list>vector >array ; -: list>llist ( list -- llist ) - #! Convert a list to a lazy list. - [ (list>llist) (force) ] curry delay ; +DEFER: backwards-vector>list +: (backwards-vector>list) ( vector -- list ) + dup empty? [ drop nil ] + [ dup pop swap backwards-vector>list cons ] if ; + +: backwards-vector>list ( vector -- list ) + [ , \ (backwards-vector>list) , \ force , ] [ ] make delay ; + +: array>list ( array -- list ) + #! Convert a list to a lazy list. + reverse >vector backwards-vector>list ; DEFER: lappend* -: (lappend*) ( llists -- list ) - dup lnil? [ - luncons >r dup lnil? [ drop r> (lappend*) ] - [ luncons r> lcons lappend* lcons ] if +: (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) ] curry delay ; + #! 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 , ] [ ] make delay ; -: lappend ( llist1 llist2 -- llist ) - #! Concatenate two lazy lists such that they appear to be one big - #! lazy list. - lunit lcons lappend* ; +: lappend ( list1 list2 -- llist ) + #! Concatenate two lazy lists such that they appear to be one big + #! lazy list. + lunit cons lappend* ; -: leach ( llist quot -- ) - #! Call the quotation on each item in the lazy list. - #! Warning: If the list is infinite then this will - #! never return. - swap dup lnil? [ 2drop ] [ - luncons swap pick call swap leach +: 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 ( llist quot ) - #! Returns a lazy list which is - #! (cons (car llist) - #! (lappy (quot (car llist) (cdr llist)) quot)) +: 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 - [ over lnil? [ drop ] [ - swap dup lcar >r luncons pick call swap lapply - r> swap lcons - ] if (force) - ] curry curry delay ; - -: lfrom ( n -- llist ) + [ swap , , \ (lapply) , \ force , ] [ ] make delay ; + +: lfrom ( n -- list ) #! Return a lazy list of increasing numbers starting #! from the initial value 'n'. - [ dup 1 + lfrom lcons (force) ] curry delay ; + [ dup 1 + lfrom cons force ] curry delay ; -: lfrom-by ( n quot -- llist ) - #! Return a lazy list of values starting from n, with - #! each successive value being the result of applying quot to - #! n. - [ 2dup call swap lfrom-by lcons (force) ] curry curry delay ; +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 , ] [ ] make delay ; \ No newline at end of file