Renaming map-cons to lmap and lmap to lazy-map

db4
James Cash 2008-06-03 16:28:02 -04:00
parent 10e5c074d9
commit 707226859a
5 changed files with 64 additions and 38 deletions

View File

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

View File

@ -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> lazy-map
: lmap ( list quot -- result )
: lazy-map ( list quot -- result )
over nil? [ 2drop nil ] [ <lazy-map> <memoized-cons> ] 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

View File

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

View File

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

View File

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