Renaming map-cons to lmap and lmap to lazy-map
parent
10e5c074d9
commit
707226859a
|
@ -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" } }
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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." } ;
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue