Re-implementing and renaming several words in lists
parent
7372423e4b
commit
6e174706af
|
@ -86,7 +86,7 @@ HELP: >list
|
|||
{ $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" } }
|
||||
|
|
|
@ -17,7 +17,7 @@ HELP: car
|
|||
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" } ;
|
||||
|
@ -55,16 +55,50 @@ HELP: llength
|
|||
{ $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 using a binary operation, and outputs 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 (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." } ;
|
||||
|
||||
|
|
|
@ -4,6 +4,10 @@ USING: tools.test lists math ;
|
|||
|
||||
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
|
||||
|
@ -17,7 +21,7 @@ IN: lists.tests
|
|||
T{ cons f 2
|
||||
T{ cons f 3
|
||||
T{ cons f 4
|
||||
+nil+ } } } } 0 [ + ] lreduce
|
||||
+nil+ } } } } 0 [ + ] foldl
|
||||
] unit-test
|
||||
|
||||
{ T{ cons f
|
||||
|
@ -38,13 +42,21 @@ IN: lists.tests
|
|||
] 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
|
||||
{ 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
|
|
@ -1,6 +1,6 @@
|
|||
! 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
|
||||
|
||||
|
@ -23,6 +23,8 @@ M: cons cdr ( cons -- cdr )
|
|||
SYMBOL: +nil+
|
||||
M: word nil? +nil+ eq? ;
|
||||
M: object nil? drop f ;
|
||||
|
||||
: atom? ( obj -- ? ) [ list? ] [ nil? ] bi or not ;
|
||||
|
||||
: nil ( -- +nil+ ) +nil+ ;
|
||||
|
||||
|
@ -38,6 +40,9 @@ M: object nil? drop f ;
|
|||
: 3list ( a b c -- cons )
|
||||
nil cons cons cons ;
|
||||
|
||||
: cadr ( cons -- elt )
|
||||
cdr car ;
|
||||
|
||||
: 2car ( cons -- car caar )
|
||||
[ car ] [ cdr car ] bi ;
|
||||
|
||||
|
@ -52,12 +57,38 @@ M: object nil? drop f ;
|
|||
|
||||
: 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
|
||||
|
||||
: lreduce ( list identity quot -- result )
|
||||
swapd leach ; 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@ = ;
|
||||
|
||||
: 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 ]
|
||||
|
@ -69,19 +100,14 @@ M: object nil? drop f ;
|
|||
: 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
|
Loading…
Reference in New Issue