Refactor >list to be a generic word
							parent
							
								
									8d6df6d128
								
							
						
					
					
						commit
						edff21ada3
					
				| 
						 | 
					@ -60,7 +60,7 @@ ARTICLE: { "lists.lazy" "manipulation" } "Manipulating lazy lists"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: lazy-cons
 | 
					HELP: lazy-cons
 | 
				
			||||||
{ $values { "car" { $quotation ( -- elt ) } } { "cdr" { $quotation ( -- cons ) } } { "promise" "the resulting cons object" } }
 | 
					{ $values { "car" { $quotation ( -- elt ) } } { "cdr" { $quotation ( -- cons ) } } { "promise" "the resulting cons object" } }
 | 
				
			||||||
{ $description "Constructs a cons object for a lazy list from two quotations. The " { $snippet "car" } " quotation should return the head of the list, and the " { $snippet "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." } 
 | 
					{ $description "Constructs a cons object for a lazy list from two quotations. The " { $snippet "car" } " quotation should return the head of the list, and the " { $snippet "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? } ;
 | 
					{ $see-also cons car cdr nil nil? } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{ 1lazy-list 2lazy-list 3lazy-list } related-words
 | 
					{ 1lazy-list 2lazy-list 3lazy-list } related-words
 | 
				
			||||||
| 
						 | 
					@ -79,7 +79,7 @@ HELP: 3lazy-list
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: <memoized-cons>
 | 
					HELP: <memoized-cons>
 | 
				
			||||||
{ $values { "cons" "a cons object" } { "memoized-cons" "the resulting memoized-cons object" } }
 | 
					{ $values { "cons" "a cons object" } { "memoized-cons" "the resulting memoized-cons object" } }
 | 
				
			||||||
{ $description "Constructs a cons object that wraps an existing cons object. Requests for the car, cdr and nil? will be remembered after the first call, and the previous result returned on subsequent calls." } 
 | 
					{ $description "Constructs a cons object that wraps an existing cons object. Requests for the car, cdr and nil? will be remembered after the first call, and the previous result returned on subsequent calls." }
 | 
				
			||||||
{ $see-also cons car cdr nil nil? } ;
 | 
					{ $see-also cons car cdr nil nil? } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{ lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
 | 
					{ lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
 | 
				
			||||||
| 
						 | 
					@ -121,11 +121,6 @@ HELP: sequence-tail>list
 | 
				
			||||||
{ $description "Convert the sequence into a list, starting from " { $snippet "index" } "." }
 | 
					{ $description "Convert the sequence into a list, starting from " { $snippet "index" } "." }
 | 
				
			||||||
{ $see-also >list } ;
 | 
					{ $see-also >list } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: >list
 | 
					 | 
				
			||||||
{ $values { "object" object } { "list" "a list" } }
 | 
					 | 
				
			||||||
{ $description "Convert the object into a list. Existing lists are passed through intact, sequences are converted using " { $link sequence-tail>list } " and other objects cause an error to be thrown." } 
 | 
					 | 
				
			||||||
{ $see-also sequence-tail>list } ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
{ leach foldl lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
 | 
					{ leach foldl lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: lconcat
 | 
					HELP: lconcat
 | 
				
			||||||
| 
						 | 
					@ -153,17 +148,17 @@ HELP: lcomp*
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: lmerge
 | 
					HELP: lmerge
 | 
				
			||||||
{ $values { "list1" "a list" } { "list2" "a list" } { "result" "lazy list merging list1 and list2" } }
 | 
					{ $values { "list1" "a list" } { "list2" "a list" } { "result" "lazy list merging list1 and list2" } }
 | 
				
			||||||
{ $description "Return the result of merging the two lists in a lazy manner." } 
 | 
					{ $description "Return the result of merging the two lists in a lazy manner." }
 | 
				
			||||||
{ $examples
 | 
					{ $examples
 | 
				
			||||||
  { $example "USING: lists lists.lazy prettyprint ;" "{ 1 2 3 } >list { 4 5 6 } >list lmerge list>array ." "{ 1 4 2 5 3 6 }" }
 | 
					  { $example "USING: lists lists.lazy prettyprint ;" "{ 1 2 3 } >list { 4 5 6 } >list lmerge list>array ." "{ 1 4 2 5 3 6 }" }
 | 
				
			||||||
} ;
 | 
					} ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: lcontents
 | 
					HELP: lcontents
 | 
				
			||||||
{ $values { "stream" "a stream" } { "result" string } }
 | 
					{ $values { "stream" "a stream" } { "result" string } }
 | 
				
			||||||
{ $description "Returns a lazy list of all characters in the file. " { $link car } " returns the next character in the file, " { $link cdr } " returns the remaining characters as a lazy list. " { $link nil? } " indicates end of file." } 
 | 
					{ $description "Returns a lazy list of all characters in the file. " { $link car } " returns the next character in the file, " { $link cdr } " returns the remaining characters as a lazy list. " { $link nil? } " indicates end of file." }
 | 
				
			||||||
{ $see-also llines } ;
 | 
					{ $see-also llines } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: llines
 | 
					HELP: llines
 | 
				
			||||||
{ $values { "stream" "a stream" } { "result" "a list" } }
 | 
					{ $values { "stream" "a stream" } { "result" "a list" } }
 | 
				
			||||||
{ $description "Returns a lazy list of all lines in the file. " { $link car } " returns the next lines in the file, " { $link cdr } " returns the remaining lines as a lazy list. " { $link nil? } " indicates end of file." } 
 | 
					{ $description "Returns a lazy list of all lines in the file. " { $link car } " returns the next lines in the file, " { $link cdr } " returns the remaining lines as a lazy list. " { $link nil? } " indicates end of file." }
 | 
				
			||||||
{ $see-also lcontents } ;
 | 
					{ $see-also lcontents } ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,7 +1,7 @@
 | 
				
			||||||
! Copyright (C) 2004, 2008 Chris Double, Matthew Willis, James Cash.
 | 
					! Copyright (C) 2004, 2008 Chris Double, Matthew Willis, James Cash.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
USING: accessors arrays combinators io kernel lists math
 | 
					USING: accessors arrays combinators io kernel lists math
 | 
				
			||||||
promises quotations sequences summary vectors ;
 | 
					promises quotations sequences vectors ;
 | 
				
			||||||
IN: lists.lazy
 | 
					IN: lists.lazy
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: promise car ( promise -- car )
 | 
					M: promise car ( promise -- car )
 | 
				
			||||||
| 
						 | 
					@ -12,7 +12,7 @@ M: promise cdr ( promise -- cdr )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: promise nil? ( cons -- ? )
 | 
					M: promise nil? ( cons -- ? )
 | 
				
			||||||
    force nil? ;
 | 
					    force nil? ;
 | 
				
			||||||
 
 | 
					
 | 
				
			||||||
! Both 'car' and 'cdr' are promises
 | 
					! Both 'car' and 'cdr' are promises
 | 
				
			||||||
TUPLE: lazy-cons-state car cdr ;
 | 
					TUPLE: lazy-cons-state car cdr ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -241,17 +241,7 @@ M: sequence-cons cdr ( sequence-cons -- cdr )
 | 
				
			||||||
M: sequence-cons nil? ( sequence-cons -- ? )
 | 
					M: sequence-cons nil? ( sequence-cons -- ? )
 | 
				
			||||||
    drop f ;
 | 
					    drop f ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
ERROR: list-conversion-error object ;
 | 
					M: sequence >list 0 swap sequence-tail>list ;
 | 
				
			||||||
 | 
					 | 
				
			||||||
M: list-conversion-error summary
 | 
					 | 
				
			||||||
    drop "Could not convert object to list" ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: >list ( object -- list )
 | 
					 | 
				
			||||||
    {
 | 
					 | 
				
			||||||
        { [ dup sequence? ] [ 0 swap sequence-tail>list ] }
 | 
					 | 
				
			||||||
        { [ dup list? ] [ ] }
 | 
					 | 
				
			||||||
        [ list-conversion-error ]
 | 
					 | 
				
			||||||
    } cond ;
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
TUPLE: lazy-concat car cdr ;
 | 
					TUPLE: lazy-concat car cdr ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -263,7 +253,7 @@ DEFER: lconcat
 | 
				
			||||||
    over nil? [ nip lconcat ] [ <lazy-concat> ] if ;
 | 
					    over nil? [ nip lconcat ] [ <lazy-concat> ] if ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: lconcat ( list -- result )
 | 
					: lconcat ( list -- result )
 | 
				
			||||||
    dup nil? [ drop nil ] [ uncons (lconcat) ] if ; 
 | 
					    dup nil? [ drop nil ] [ uncons (lconcat) ] if ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: lazy-concat car ( lazy-concat -- car )
 | 
					M: lazy-concat car ( lazy-concat -- car )
 | 
				
			||||||
    car>> car ;
 | 
					    car>> car ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -169,3 +169,6 @@ HELP: lmap>array
 | 
				
			||||||
{ $values { "list" list } { "quot" quotation } { "array" array } }
 | 
					{ $values { "list" list } { "quot" quotation } { "array" array } }
 | 
				
			||||||
{ $description "Executes the quotation on each element of the list, collecting the results in an array." } ;
 | 
					{ $description "Executes the quotation on each element of the list, collecting the results in an array." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: >list
 | 
				
			||||||
 | 
					{ $values { "object" object } { "list" "a list" } }
 | 
				
			||||||
 | 
					{ $description "Converts the object into a list." } ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,7 +1,7 @@
 | 
				
			||||||
! Copyright (C) 2008 James Cash, Daniel Ehrenberg, Chris Double.
 | 
					! Copyright (C) 2008 James Cash, Daniel Ehrenberg, Chris Double.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
USING: kernel sequences accessors math arrays vectors classes words
 | 
					USING: kernel sequences accessors math arrays vectors classes words
 | 
				
			||||||
combinators.short-circuit combinators locals ;
 | 
					combinators.short-circuit combinators locals summary ;
 | 
				
			||||||
IN: lists
 | 
					IN: lists
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! List Protocol
 | 
					! List Protocol
 | 
				
			||||||
| 
						 | 
					@ -9,7 +9,7 @@ MIXIN: list
 | 
				
			||||||
GENERIC: car ( cons -- car )
 | 
					GENERIC: car ( cons -- car )
 | 
				
			||||||
GENERIC: cdr ( cons -- cdr )
 | 
					GENERIC: cdr ( cons -- cdr )
 | 
				
			||||||
GENERIC: nil? ( object -- ?   )
 | 
					GENERIC: nil? ( object -- ?   )
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
TUPLE: cons-state { car read-only } { cdr read-only } ;
 | 
					TUPLE: cons-state { car read-only } { cdr read-only } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
C: cons cons-state
 | 
					C: cons cons-state
 | 
				
			||||||
| 
						 | 
					@ -41,9 +41,9 @@ M: object nil? drop f ;
 | 
				
			||||||
: 3list ( a b c -- cons ) 2list cons ; inline
 | 
					: 3list ( a b c -- cons ) 2list cons ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: cadr ( list -- elt ) cdr car ; inline
 | 
					: cadr ( list -- elt ) cdr car ; inline
 | 
				
			||||||
 
 | 
					
 | 
				
			||||||
: 2car ( list -- car caar ) [ car ] [ cadr ] bi ; inline
 | 
					: 2car ( list -- car caar ) [ car ] [ cadr ] bi ; inline
 | 
				
			||||||
 
 | 
					
 | 
				
			||||||
: 3car ( list -- car cadr caddr ) [ car ] [ cadr ] [ cdr cadr ] tri ; inline
 | 
					: 3car ( list -- car cadr caddr ) [ car ] [ cadr ] [ cdr cadr ] tri ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: lnth ( n list -- elt ) swap [ cdr ] times car ; inline
 | 
					: lnth ( n list -- elt ) swap [ cdr ] times car ; inline
 | 
				
			||||||
| 
						 | 
					@ -84,14 +84,18 @@ PRIVATE>
 | 
				
			||||||
    [ [ unswons ] dip cons ] times
 | 
					    [ [ unswons ] dip cons ] times
 | 
				
			||||||
    lreverse swap ;
 | 
					    lreverse swap ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: sequence>list ( sequence -- list )    
 | 
					: sequence>list ( sequence -- list )
 | 
				
			||||||
    <reversed> nil [ swons ] reduce ;
 | 
					    <reversed> nil [ swons ] reduce ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: lmap>array ( ... list quot: ( ... elt -- ... newelt ) -- ... array )
 | 
					: lmap>array ( ... list quot: ( ... elt -- ... newelt ) -- ... array )
 | 
				
			||||||
    collector [ leach ] dip { } like ; inline
 | 
					    collector [ leach ] dip { } like ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: list>array ( list -- array )  
 | 
					: list>array ( list -- array )
 | 
				
			||||||
    [ ] lmap>array ;
 | 
					    [ ] lmap>array ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
INSTANCE: cons-state list
 | 
					INSTANCE: cons-state list
 | 
				
			||||||
INSTANCE: +nil+ list
 | 
					INSTANCE: +nil+ list
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					GENERIC: >list ( object -- list )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: list >list ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue