diff --git a/extra/lazy-lists/lazy-lists-docs.factor b/extra/lazy-lists/lazy-lists-docs.factor index b240b3fbc2..fb87bee10f 100644 --- a/extra/lazy-lists/lazy-lists-docs.factor +++ b/extra/lazy-lists/lazy-lists-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax sequences strings ; +USING: help.markup help.syntax sequences strings lists ; IN: lazy-lists { car cons cdr nil nil? list? uncons } related-words diff --git a/extra/lazy-lists/lazy-lists-tests.factor b/extra/lazy-lists/lazy-lists-tests.factor index 302299b452..7dd0c0f009 100644 --- a/extra/lazy-lists/lazy-lists-tests.factor +++ b/extra/lazy-lists/lazy-lists-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Matthew Willis and Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: lazy-lists tools.test kernel math io sequences ; +USING: lists lazy-lists tools.test kernel math io sequences ; IN: lazy-lists.tests [ { 1 2 3 4 } ] [ diff --git a/extra/lazy-lists/lazy-lists.factor b/extra/lazy-lists/lazy-lists.factor index 6db82ed2c1..ae123580f7 100644 --- a/extra/lazy-lists/lazy-lists.factor +++ b/extra/lazy-lists/lazy-lists.factor @@ -5,15 +5,9 @@ ! Updated by Chris Double, September 2006 ! USING: kernel sequences math vectors arrays namespaces -quotations promises combinators io ; +quotations promises combinators io lists accessors ; IN: lazy-lists -! Lazy List Protocol -MIXIN: list -GENERIC: car ( cons -- car ) -GENERIC: cdr ( cons -- cdr ) -GENERIC: nil? ( cons -- ? ) - M: promise car ( promise -- car ) force car ; @@ -22,32 +16,7 @@ M: promise cdr ( promise -- cdr ) M: promise nil? ( cons -- bool ) force nil? ; - -TUPLE: cons car cdr ; - -C: cons cons - -M: cons car ( cons -- car ) - cons-car ; - -M: cons cdr ( cons -- cdr ) - cons-cdr ; - -: nil ( -- cons ) - T{ cons f f f } ; - -M: cons nil? ( cons -- bool ) - nil eq? ; - -: 1list ( obj -- cons ) - nil cons ; - -: 2list ( a b -- cons ) - nil cons cons ; - -: 3list ( a b c -- cons ) - nil cons cons cons ; - + ! Both 'car' and 'cdr' are promises TUPLE: lazy-cons car cdr ; @@ -57,10 +26,10 @@ TUPLE: lazy-cons car cdr ; [ set-promise-value ] keep ; M: lazy-cons car ( lazy-cons -- car ) - lazy-cons-car force ; + car>> force ; M: lazy-cons cdr ( lazy-cons -- cdr ) - lazy-cons-cdr force ; + cdr>> force ; M: lazy-cons nil? ( lazy-cons -- bool ) nil eq? ; @@ -83,12 +52,8 @@ M: lazy-cons nil? ( lazy-cons -- bool ) : llength ( list -- n ) 0 (llength) ; -: uncons ( cons -- car cdr ) - #! Return the car and cdr of the lazy list - dup car swap cdr ; - : leach ( list quot -- ) - swap dup nil? [ 2drop ] [ uncons swapd over 2slip leach ] if ; inline + over nil? [ 2drop ] [ [ uncons ] dip tuck call leach ] if ; inline : lreduce ( list identity quot -- result ) swapd leach ; inline @@ -106,24 +71,24 @@ TUPLE: memoized-cons original car cdr nil? ; memoized-cons boa ; M: memoized-cons car ( memoized-cons -- car ) - dup memoized-cons-car not-memoized? [ - dup memoized-cons-original car [ swap set-memoized-cons-car ] keep + dup car>> not-memoized? [ + dup original>> car [ >>car drop ] keep ] [ - memoized-cons-car + car>> ] if ; M: memoized-cons cdr ( memoized-cons -- cdr ) - dup memoized-cons-cdr not-memoized? [ - dup memoized-cons-original cdr [ swap set-memoized-cons-cdr ] keep + dup cdr>> not-memoized? [ + dup original>> cdr [ >>cdr drop ] keep ] [ - memoized-cons-cdr + cdr>> ] if ; M: memoized-cons nil? ( memoized-cons -- bool ) - dup memoized-cons-nil? not-memoized? [ - dup memoized-cons-original nil? [ swap set-memoized-cons-nil? ] keep + dup nil?>> not-memoized? [ + dup original>> nil? [ >>nil? drop ] keep ] [ - memoized-cons-nil? + nil?>> ] if ; TUPLE: lazy-map cons quot ; @@ -134,15 +99,15 @@ C: lazy-map over nil? [ 2drop nil ] [ ] if ; M: lazy-map car ( lazy-map -- car ) - [ lazy-map-cons car ] keep - lazy-map-quot call ; + [ cons>> car ] keep + quot>> call ; M: lazy-map cdr ( lazy-map -- cdr ) - [ lazy-map-cons cdr ] keep - lazy-map-quot lmap ; + [ cons>> cdr ] keep + quot>> lmap ; M: lazy-map nil? ( lazy-map -- bool ) - lazy-map-cons nil? ; + cons>> nil? ; : lmap-with ( value list quot -- result ) with lmap ; @@ -155,17 +120,17 @@ C: lazy-take over zero? [ 2drop nil ] [ ] if ; M: lazy-take car ( lazy-take -- car ) - lazy-take-cons car ; + cons>> car ; M: lazy-take cdr ( lazy-take -- cdr ) - [ lazy-take-n 1- ] keep - lazy-take-cons cdr ltake ; + [ n>> 1- ] keep + cons>> cdr ltake ; M: lazy-take nil? ( lazy-take -- bool ) - dup lazy-take-n zero? [ + dup n>> zero? [ drop t ] [ - lazy-take-cons nil? + cons>> nil? ] if ; TUPLE: lazy-until cons quot ; @@ -176,10 +141,10 @@ C: lazy-until over nil? [ drop ] [ ] if ; M: lazy-until car ( lazy-until -- car ) - lazy-until-cons car ; + cons>> car ; M: lazy-until cdr ( lazy-until -- cdr ) - [ lazy-until-cons uncons swap ] keep lazy-until-quot tuck call + [ cons>> uncons ] keep quot>> tuck call [ 2drop nil ] [ luntil ] if ; M: lazy-until nil? ( lazy-until -- bool ) @@ -193,13 +158,13 @@ C: lazy-while over nil? [ drop ] [ ] if ; M: lazy-while car ( lazy-while -- car ) - lazy-while-cons car ; + cons>> car ; M: lazy-while cdr ( lazy-while -- cdr ) - [ lazy-while-cons cdr ] keep lazy-while-quot lwhile ; + [ cons>> cdr ] keep quot>> lwhile ; M: lazy-while nil? ( lazy-while -- bool ) - [ car ] keep lazy-while-quot call not ; + [ car ] keep quot>> call not ; TUPLE: lazy-filter cons quot ; @@ -209,26 +174,25 @@ C: lazy-filter over nil? [ 2drop nil ] [ ] if ; : car-filter? ( lazy-filter -- ? ) - [ lazy-filter-cons car ] keep - lazy-filter-quot call ; + [ cons>> car ] keep + quot>> call ; : skip ( lazy-filter -- ) - [ lazy-filter-cons cdr ] keep - set-lazy-filter-cons ; + dup cons>> cdr >>cons ; M: lazy-filter car ( lazy-filter -- car ) - dup car-filter? [ lazy-filter-cons ] [ dup skip ] if car ; + dup car-filter? [ cons>> ] [ dup skip ] if car ; M: lazy-filter cdr ( lazy-filter -- cdr ) dup car-filter? [ - [ lazy-filter-cons cdr ] keep - lazy-filter-quot lfilter + [ cons>> cdr ] keep + quot>> lfilter ] [ dup skip cdr ] if ; M: lazy-filter nil? ( lazy-filter -- bool ) - dup lazy-filter-cons nil? [ + dup cons>> nil? [ drop t ] [ dup car-filter? [ @@ -252,11 +216,11 @@ C: lazy-append over nil? [ nip ] [ ] if ; M: lazy-append car ( lazy-append -- car ) - lazy-append-list1 car ; + list1>> car ; M: lazy-append cdr ( lazy-append -- cdr ) - [ lazy-append-list1 cdr ] keep - lazy-append-list2 lappend ; + [ list1>> cdr ] keep + list2>> lappend ; M: lazy-append nil? ( lazy-append -- bool ) drop f ; @@ -269,11 +233,11 @@ C: lfrom-by lazy-from-by ( n quot -- list ) [ 1+ ] lfrom-by ; M: lazy-from-by car ( lazy-from-by -- car ) - lazy-from-by-n ; + n>> ; M: lazy-from-by cdr ( lazy-from-by -- cdr ) - [ lazy-from-by-n ] keep - lazy-from-by-quot dup slip lfrom-by ; + [ n>> ] keep + quot>> dup slip lfrom-by ; M: lazy-from-by nil? ( lazy-from-by -- bool ) drop f ; @@ -287,10 +251,10 @@ C: lazy-zip [ 2drop nil ] [ ] if ; M: lazy-zip car ( lazy-zip -- car ) - [ lazy-zip-list1 car ] keep lazy-zip-list2 car 2array ; + [ list1>> car ] keep list2>> car 2array ; M: lazy-zip cdr ( lazy-zip -- cdr ) - [ lazy-zip-list1 cdr ] keep lazy-zip-list2 cdr lzip ; + [ list1>> cdr ] keep list2>> cdr lzip ; M: lazy-zip nil? ( lazy-zip -- bool ) drop f ; @@ -307,12 +271,12 @@ C: sequence-cons ] if ; M: sequence-cons car ( sequence-cons -- car ) - [ sequence-cons-index ] keep - sequence-cons-seq nth ; + [ index>> ] keep + seq>> nth ; M: sequence-cons cdr ( sequence-cons -- cdr ) - [ sequence-cons-index 1+ ] keep - sequence-cons-seq seq>list ; + [ index>> 1+ ] keep + seq>> seq>list ; M: sequence-cons nil? ( sequence-cons -- bool ) drop f ; @@ -341,18 +305,18 @@ DEFER: lconcat dup nil? [ drop nil ] [ - uncons (lconcat) + uncons swap (lconcat) ] if ; M: lazy-concat car ( lazy-concat -- car ) - lazy-concat-car car ; + car>> car ; M: lazy-concat cdr ( lazy-concat -- cdr ) - [ lazy-concat-car cdr ] keep lazy-concat-cdr (lconcat) ; + [ car>> cdr ] keep cdr>> (lconcat) ; M: lazy-concat nil? ( lazy-concat -- bool ) - dup lazy-concat-car nil? [ - lazy-concat-cdr nil? + dup car>> nil? [ + cdr>> nil? ] [ drop f ] if ; @@ -404,22 +368,22 @@ C: lazy-io f f [ stream-readln ] ; M: lazy-io car ( lazy-io -- car ) - dup lazy-io-car dup [ + dup car>> dup [ nip ] [ - drop dup lazy-io-stream over lazy-io-quot call + drop dup stream>> over quot>> call swap dupd set-lazy-io-car ] if ; M: lazy-io cdr ( lazy-io -- cdr ) - dup lazy-io-cdr dup [ + dup cdr>> dup [ nip ] [ drop dup - [ lazy-io-stream ] keep - [ lazy-io-quot ] keep + [ stream>> ] keep + [ quot>> ] keep car [ - [ f f ] dip [ swap set-lazy-io-cdr ] keep + [ f f ] dip [ >>cdr drop ] keep ] [ 3drop nil ] if @@ -428,7 +392,6 @@ M: lazy-io cdr ( lazy-io -- cdr ) M: lazy-io nil? ( lazy-io -- bool ) car not ; -INSTANCE: cons list INSTANCE: sequence-cons list INSTANCE: memoized-cons list INSTANCE: promise list diff --git a/extra/lists/lists.factor b/extra/lists/lists.factor index da26580305..4b8cc77658 100644 --- a/extra/lists/lists.factor +++ b/extra/lists/lists.factor @@ -4,23 +4,45 @@ USING: kernel sequences accessors ; IN: lists +! Lazy List Protocol +MIXIN: list +GENERIC: car ( cons -- car ) +GENERIC: cdr ( cons -- cdr ) +GENERIC: nil? ( cons -- ? ) + TUPLE: cons car cdr ; -: cons \ cons new ; + +C: cons cons + +M: cons car ( cons -- car ) + car>> ; + +M: cons cdr ( cons -- cdr ) + cdr>> ; + +: nil ( -- cons ) + T{ cons f f f } ; + +M: cons nil? ( cons -- bool ) + nil eq? ; + +: 1list ( obj -- cons ) + nil cons ; + +: 2list ( a b -- cons ) + nil cons cons ; + +: 3list ( a b c -- cons ) + nil cons cons cons ; : uncons ( cons -- cdr car ) - [ cdr>> ] [ car>> ] bi ; - -: null? ( cons -- ? ) - uncons and not ; - -: ( x -- cons ) - cons swap >>car ; + [ cdr ] [ car ] bi ; : seq>cons ( seq -- cons ) - cons [ swap >>cdr ] reduce ; + nil [ f cons swap >>cdr ] reduce ; : (map-cons) ( acc cons quot -- seq ) - over null? [ 2drop ] + over nil? [ 2drop ] [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (map-cons) ] if ; : map-cons ( cons quot -- seq ) @@ -30,5 +52,7 @@ TUPLE: cons car cdr ; [ ] map-cons ; : reduce-cons ( cons identity quot -- result ) - pick null? [ drop nip ] - [ [ uncons ] 2dip swapd [ call ] keep reduce-cons ] if ; \ No newline at end of file + pick nil? [ drop nip ] + [ [ uncons ] 2dip swapd [ call ] keep reduce-cons ] if ; + +INSTANCE: cons list \ No newline at end of file