From 707226859a945656ead5d161719ca1106343145b Mon Sep 17 00:00:00 2001 From: James Cash Date: Tue, 3 Jun 2008 16:28:02 -0400 Subject: [PATCH] Renaming map-cons to lmap and lmap to lazy-map --- extra/lists/lazy/lazy-docs.factor | 2 ++ extra/lists/lazy/lazy.factor | 31 ++++++----------------- extra/lists/lists-docs.factor | 26 ++++++++++++++++++-- extra/lists/lists.factor | 41 ++++++++++++++++++++++--------- extra/monads/monads.factor | 2 +- 5 files changed, 64 insertions(+), 38 deletions(-) diff --git a/extra/lists/lazy/lazy-docs.factor b/extra/lists/lazy/lazy-docs.factor index 1de98971f6..0e6c93766d 100644 --- a/extra/lists/lazy/lazy-docs.factor +++ b/extra/lists/lazy/lazy-docs.factor @@ -107,6 +107,8 @@ HELP: >list { $values { "object" "an object" } { "list" "a 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 lmap lmap-with ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lreduce lwhile luntil } related-words HELP: lconcat { $values { "list" "a list of lists" } { "result" "a list" } } diff --git a/extra/lists/lazy/lazy.factor b/extra/lists/lazy/lazy.factor index f8b1a6e6ef..7ab5bbb84e 100644 --- a/extra/lists/lazy/lazy.factor +++ b/extra/lists/lazy/lazy.factor @@ -44,21 +44,6 @@ M: lazy-cons nil? ( lazy-cons -- bool ) : 3lazy-list ( a b c -- lazy-cons ) 2lazy-list 1quotation lazy-cons ; -: lnth ( n list -- elt ) - swap [ cdr ] times car ; - -: (llength) ( list acc -- n ) - over nil? [ nip ] [ [ cdr ] dip 1+ (llength) ] if ; - -: llength ( list -- n ) - 0 (llength) ; - -: leach ( list quot -- ) - over nil? [ 2drop ] [ [ uncons ] dip tuck call leach ] if ; inline - -: lreduce ( list identity quot -- result ) - swapd leach ; inline - TUPLE: memoized-cons original car cdr nil? ; : not-memoized ( -- obj ) @@ -96,7 +81,7 @@ TUPLE: lazy-map cons quot ; C: lazy-map -: lmap ( list quot -- result ) +: lazy-map ( list quot -- result ) over nil? [ 2drop nil ] [ ] if ; M: lazy-map car ( lazy-map -- car ) @@ -105,13 +90,13 @@ M: lazy-map car ( lazy-map -- car ) M: lazy-map cdr ( lazy-map -- cdr ) [ cons>> cdr ] keep - quot>> lmap ; + quot>> lazy-map ; M: lazy-map nil? ( lazy-map -- bool ) cons>> nil? ; -: lmap-with ( value list quot -- result ) - with lmap ; +: lazy-map-with ( value list quot -- result ) + with lazy-map ; TUPLE: lazy-take n cons ; @@ -323,22 +308,22 @@ M: lazy-concat nil? ( lazy-concat -- bool ) ] if ; : lcartesian-product ( list1 list2 -- result ) - swap [ swap [ 2array ] lmap-with ] lmap-with lconcat ; + swap [ swap [ 2array ] lazy-map-with ] lazy-map-with lconcat ; : lcartesian-product* ( lists -- result ) dup nil? [ drop nil ] [ [ car ] keep cdr [ car lcartesian-product ] keep cdr list>array swap [ - swap [ swap [ suffix ] lmap-with ] lmap-with lconcat + swap [ swap [ suffix ] lazy-map-with ] lazy-map-with lconcat ] reduce ] if ; : lcomp ( list quot -- result ) - [ lcartesian-product* ] dip lmap ; + [ lcartesian-product* ] dip lazy-map ; : lcomp* ( list guards quot -- result ) - [ [ lcartesian-product* ] dip [ lfilter ] each ] dip lmap ; + [ [ lcartesian-product* ] dip [ lfilter ] each ] dip lazy-map ; DEFER: lmerge diff --git a/extra/lists/lists-docs.factor b/extra/lists/lists-docs.factor index 94407765fc..8a691cd4e2 100644 --- a/extra/lists/lists-docs.factor +++ b/extra/lists/lists-docs.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax ; IN: lists -USING: help.markup help.syntax ; { car cons cdr nil nil? list? uncons } related-words @@ -42,4 +42,26 @@ HELP: 2list HELP: 3list { $values { "a" "an object" } { "b" "an object" } { "c" "an object" } { "cons" "a cons object" } } -{ $description "Create a list with 3 elements." } ; \ No newline at end of file +{ $description "Create a list with 3 elements." } ; + +HELP: lnth +{ $values { "n" "an integer index" } { "list" "a cons object" } { "elt" "the element at the nth index" } } +{ $description "Outputs the nth element of the list." } +{ $see-also llength cons car cdr } ; + +HELP: llength +{ $values { "list" "a cons object" } { "n" "a non-negative integer" } } +{ $description "Outputs the length of the list. This should not be called on an infinite 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" } } +{ $description "Put the head and tail of the list on the stack." } ; + +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 +{ $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." } ; diff --git a/extra/lists/lists.factor b/extra/lists/lists.factor index 4b8cc77658..d9af80a2bc 100644 --- a/extra/lists/lists.factor +++ b/extra/lists/lists.factor @@ -1,10 +1,10 @@ -! Copyright (C) 2008 James Cash +! Copyright (C) 2008 Chris Double & James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences accessors ; +USING: kernel sequences accessors math ; IN: lists -! Lazy List Protocol +! List Protocol MIXIN: list GENERIC: car ( cons -- car ) GENERIC: cdr ( cons -- cdr ) @@ -28,31 +28,48 @@ M: cons nil? ( cons -- bool ) : 1list ( obj -- cons ) nil cons ; - + : 2list ( a b -- cons ) nil cons cons ; : 3list ( a b c -- cons ) nil cons cons cons ; +: 2car ( cons -- car caar ) + [ car ] [ cdr car ] bi ; + +: 3car ( cons -- car caar caaar ) + [ car ] [ cdr car ] [ cdr cdr car ] tri ; + : uncons ( cons -- cdr car ) [ cdr ] [ car ] bi ; +: lnth ( n list -- elt ) + swap [ cdr ] times car ; + +: (llength) ( list acc -- n ) + over nil? [ nip ] [ [ cdr ] dip 1+ (llength) ] if ; + +: llength ( list -- n ) + 0 (llength) ; + +: leach ( list quot -- ) + over nil? [ 2drop ] [ [ uncons ] dip tuck call leach ] if ; inline + +: lreduce ( list identity quot -- result ) + swapd leach ; inline + : seq>cons ( seq -- cons ) nil [ f cons swap >>cdr ] reduce ; -: (map-cons) ( acc cons quot -- seq ) +: (lmap) ( acc cons quot -- seq ) over nil? [ 2drop ] - [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (map-cons) ] if ; + [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (map-cons) ] if ; inline -: map-cons ( cons quot -- seq ) - [ { } clone ] 2dip (map-cons) ; +: lmap ( cons quot -- seq ) + [ { } clone ] 2dip (map-cons) ; inline : cons>seq ( cons -- array ) [ ] map-cons ; -: reduce-cons ( cons identity quot -- result ) - pick nil? [ drop nip ] - [ [ uncons ] 2dip swapd [ call ] keep reduce-cons ] if ; - INSTANCE: cons list \ No newline at end of file diff --git a/extra/monads/monads.factor b/extra/monads/monads.factor index 18820d1b53..c1ab4400ba 100644 --- a/extra/monads/monads.factor +++ b/extra/monads/monads.factor @@ -124,7 +124,7 @@ M: list-monad fail 2drop nil ; M: list monad-of drop list-monad ; -M: list >>= '[ , _ lmap lconcat ] ; +M: list >>= '[ , _ lazy-map lconcat ] ; ! State SINGLETON: state-monad -- 2.34.1