{ $description "Convert the object into a list. Existing lists are passed through intact, sequences are converted using " { $link seq>list } " and other objects cause an error to be thrown." }
{ $see-also seq>list } ;
-{ leach lreduce lazy-map lazy-map-with ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lreduce lwhile luntil } related-words
+{ leach foldl lazy-map lazy-map-with ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
HELP: lconcat
{ $values { "list" "a list of lists" } { "result" "a list" } }
HELP: cdr
{ $values { "cons" "a cons object" } { "cdr" "a cons object" } }
{ $description "Returns the tail of the list." } ;
-
+
HELP: nil
{ $values { "cons" "An empty cons" } }
{ $description "Returns a representation of an empty list" } ;
{ $see-also lnth cons car cdr } ;
HELP: uncons
-{ $values { "cons" "a cons object" } { "car" "the head of the list" } { "cdr" "the tail of the list" } }
+{ $values { "cons" "a cons object" } { "cdr" "the tail of the list" } { "car" "the head of the list" } }
{ $description "Put the head and tail of the list on the stack." } ;
-{ leach lreduce lmap>array } related-words
+{ leach foldl lmap>array } related-words
HELP: leach
{ $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( obj -- )" } }
{ $description "Call the quotation for each item in the list." } ;
-HELP: lreduce
+HELP: foldl
+{ $values { "list" "a cons object" } { "identity" "an object" } { "quot" "a quotation with stack effect ( prev elt -- next )" } { "result" "the final result" } }
+{ $description "Combines successive elements of the list (in a left-assocative order) using a binary operation and outputs the final result." } ;
+
+HELP: foldr
{ $values { "list" "a cons object" } { "identity" "an object" } { "quot" "a quotation with stack effect ( prev elt -- next )" } { "result" "the final result" } }
-{ $description "Combines successive elements of the list using a binary operation, and outputs the final result." } ;
+{ $description "Combines successive elements of the list (in a right-assocative order) using a binary operation, and outputs the final result." } ;
+HELP: lmap
+{ $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( old -- new )" } { "result" "the final result" } }
+{ $description "Applies the quotation to each element of the list in order, collecting the new elements into a new list." } ;
+
+HELP: lreverse
+{ $values { "list" "a cons object" } { "newlist" "a new cons object" } }
+{ $description "Reverses the input list, outputing a new, reversed list" } ;
+
+HELP: list>seq
+{ $values { "list" "a cons object" } { "array" "an array object" } }
+{ $description "Turns the given cons object into an array, maintaing order." } ;
+
+HELP: seq>list
+{ $values { "array" "an array object" } { "list" "a cons object" } }
+{ $description "Turns the given array into a cons object, maintaing order." } ;
+
+HELP: cons>seq
+{ $values { "cons" "a cons object" } { "array" "an array object" } }
+{ $description "Recursively turns the given cons object into an array, maintaing order and also converting nested lists." } ;
+
+HELP: seq>cons
+{ $values { "seq" "a sequence object" } { "cons" "a cons object" } }
+{ $description "Recursively turns the given sequence into a cons object, maintaing order and also converting nested lists." } ;
+
+HELP: traverse
+{ $values { " list" "a cons object" } { "pred" } { "a quotation with stack effect ( list/elt -- ? )" }
+ { "quot" "a quotation with stack effect ( list/elt -- result)" } { "result" "a new cons object" } }
+{ $description "Recursively traverses the list object, replacing any elements (which can themselves be sublists) that " { $snippet pred }
+ " returns true for with the result of applying " { $snippet quot } " to." } ;
+
IN: lists.tests
+{ { 3 4 5 6 7 } } [
+ { 1 2 3 4 5 } seq>list [ 2 + ] lmap list>seq
+] unit-test
+
{ { 3 4 5 6 } } [
T{ cons f 1
T{ cons f 2
T{ cons f 2
T{ cons f 3
T{ cons f 4
- +nil+ } } } } 0 [ + ] lreduce
+ +nil+ } } } } 0 [ + ] foldl
] unit-test
{ T{ cons f
] unit-test
{ { 1 2 { 3 4 { 5 } } } } [
- { 1 2 { 3 4 { 5 } } } seq>cons cons>seq
+ { 1 2 { 3 4 { 5 } } } seq>cons cons>seq
] unit-test
{ T{ cons f 2 T{ cons f 3 T{ cons f 4 T{ cons f 5 +nil+ } } } } } [
{ 1 2 3 4 } seq>cons [ 1+ ] lmap
] unit-test
-! { { 3 4 { 5 6 { 7 } } } } [
-! { 1 2 { 3 4 { 5 } } } seq>cons [ 2 + ] traverse cons>seq
-! ] unit-test
\ No newline at end of file
+{ 15 } [
+ { 1 2 3 4 5 } seq>list 0 [ + ] foldr
+] unit-test
+
+{ { 5 4 3 2 1 } } [
+ { 1 2 3 4 5 } seq>list lreverse list>seq
+] unit-test
+
+{ { 3 4 { 5 6 { 7 } } } } [
+ { 1 2 { 3 4 { 5 } } } seq>cons [ atom? ] [ 2 + ] traverse cons>seq
+] unit-test
\ No newline at end of file
! Copyright (C) 2008 Chris Double & James Cash
! 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 locals ;
IN: lists
SYMBOL: +nil+
M: word nil? +nil+ eq? ;
M: object nil? drop f ;
+
+: atom? ( obj -- ? ) [ list? ] [ nil? ] bi or not ;
: nil ( -- +nil+ ) +nil+ ;
: 3list ( a b c -- cons )
nil cons cons cons ;
+: cadr ( cons -- elt )
+ cdr car ;
+
: 2car ( cons -- car caar )
[ car ] [ cdr car ] bi ;
: llength ( list -- n )
0 (llength) ;
+
+: (leach) ( list quot -- cdr quot )
+ [ [ car ] dip call ] [ [ cdr ] dip ] 2bi ; inline
: leach ( list quot -- )
- over nil? [ 2drop ] [ [ uncons swap ] dip tuck [ call ] 2dip leach ] if ; inline
+ over nil? [ 2drop ] [ (leach) leach ] if ; inline
+
+: lmap ( list quot -- result )
+ over nil? [ drop ] [ (leach) lmap cons ] if ; inline
+
+: foldl ( list ident quot -- result ) swapd leach ; inline
+
+: foldr ( list ident quot -- result )
+ pick nil? [ [ drop ] [ ] [ drop ] tri* ] [
+ [ [ cdr ] 2dip foldr ] [ nip [ car ] dip ] 3bi
+ call
+ ] if ; inline
+
+: lreverse ( list -- newlist )
+ nil [ swap cons ] foldl ;
+
+: lappend ( list1 list2 -- newlist )
+ ;
+
+: seq>list ( seq -- list )
+ <reversed> nil [ swap cons ] reduce ;
+
+: same? ( obj1 obj2 -- ? )
+ [ class ] bi@ = ;
-: lreduce ( list identity quot -- result )
- swapd leach ; inline
+: seq>cons ( seq -- cons )
+ [ <reversed> ] keep nil [ tuck same? [ seq>cons ] when f cons swap >>cdr ] with reduce ;
: (lmap>array) ( acc cons quot -- newcons )
over nil? [ 2drop ]
: lmap-as ( cons quot exemplar -- seq )
[ lmap>array ] dip like ;
-: lmap ( list quot -- newlist )
- lmap>array <reversed> nil [ swap cons ] reduce ;
-
-: same? ( obj1 obj2 -- ? )
- [ class ] bi@ = ;
-
-: seq>cons ( seq -- cons )
- [ <reversed> ] keep nil [ tuck same? [ seq>cons ] when f cons swap >>cdr ] with reduce ;
-
: cons>seq ( cons -- array )
[ dup cons? [ cons>seq ] when ] lmap>array ;
-: traverse ( list quot -- newlist )
- [ over list? [ traverse ] [ call ] if ] curry lmap ;
+: list>seq ( list -- array )
+ [ ] lmap>array ;
+
+: traverse ( list pred quot -- result )
+ [ 2over call [ tuck [ call ] 2dip ] when
+ pick list? [ traverse ] [ 2drop ] if ] 2curry lmap ;
INSTANCE: cons list
\ No newline at end of file
projects / factor.git / commitdiff