steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Re-implementing and renaming several words in lists

db4
James Cash 2008-06-05 04:13:51 -04:00
parent 7372423e4b
commit 6e174706af
4 changed files with 98 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/lists/lazy/lazy-docs.factor
View File

@ -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" } }

44
extra/lists/lists-docs.factor
View File

@ -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." } ;

22
extra/lists/lists-tests.factor
View File

@ -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

56
extra/lists/lists.factor
View File

@ -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