Refactoring lazy-lists to use new accessors

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

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 } ] [

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 car>> not-memoized? [
-    dup memoized-cons-original car [ swap set-memoized-cons-car ] keep
+    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 cdr>> not-memoized? [
-    dup memoized-cons-original cdr [ swap set-memoized-cons-cdr ] keep
+    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 nil?>> not-memoized? [
-    dup memoized-cons-original nil? [ swap set-memoized-cons-nil? ] keep
+    dup original>> nil? [ >>nil? drop ] keep
   ] [
-    memoized-cons-nil?
+    nil?>>
   ] if ;
 
 TUPLE: lazy-map cons quot ;
@@ -134,15 +99,15 @@ C: <lazy-map> lazy-map
     over nil? [ 2drop nil ] [ <lazy-map> <memoized-cons> ] if ;
 
 M: lazy-map car ( lazy-map -- car )
-  [ lazy-map-cons car ] keep
+  [ cons>> car ] keep
-  lazy-map-quot call ;
+  quot>> call ;
 
 M: lazy-map cdr ( lazy-map -- cdr )
-  [ lazy-map-cons cdr ] keep
+  [ cons>> cdr ] keep
-  lazy-map-quot lmap ;
+  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> lazy-take
     over zero? [ 2drop nil ] [ <lazy-take> ] 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
+  [ n>> 1- ] keep
-  lazy-take-cons cdr ltake ;
+  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> lazy-until
   over nil? [ drop ] [ <lazy-until> ] 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> lazy-while
   over nil? [ drop ] [ <lazy-while> ] 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> lazy-filter
     over nil? [ 2drop nil ] [ <lazy-filter> <memoized-cons> ] if ;
 
 : car-filter?  ( lazy-filter -- ? )
-  [ lazy-filter-cons car ] keep
+  [ cons>> car ] keep
-  lazy-filter-quot call ;
+  quot>> call ;
 
 : skip ( lazy-filter -- )
-  [ lazy-filter-cons cdr ] keep
+  dup cons>> cdr >>cons ;
-  set-lazy-filter-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
+    [ cons>> cdr ] keep
-    lazy-filter-quot lfilter
+    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> lazy-append
   over nil? [ nip ] [ <lazy-append> ] 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
+  [ list1>> cdr  ] keep
-  lazy-append-list2 lappend ;
+  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
+  [ n>> ] keep
-  lazy-from-by-quot dup slip lfrom-by ;
+  quot>> dup slip lfrom-by ;
 
 M: lazy-from-by nil? ( lazy-from-by -- bool )
   drop f ;
@@ -287,10 +251,10 @@ C: <lazy-zip> lazy-zip
     [ 2drop nil ] [ <lazy-zip> ] 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> sequence-cons
   ] if ;
 
 M: sequence-cons car ( sequence-cons -- car )
-  [ sequence-cons-index ] keep
+  [ index>> ] keep
-  sequence-cons-seq nth ;
+  seq>> nth ;
 
 M: sequence-cons cdr ( sequence-cons -- cdr )
-  [ sequence-cons-index 1+ ] keep
+  [ index>> 1+ ] keep
-  sequence-cons-seq seq>list ;
+  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? [
+  dup car>> nil? [
-    lazy-concat-cdr nil?
+    cdr>> nil?
   ] [
     drop f
   ] if ;
@@ -404,22 +368,22 @@ C: <lazy-io> lazy-io
   f f [ stream-readln ] <lazy-io> ;
 
 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
+    [ stream>> ] keep
-    [ lazy-io-quot ] keep
+    [ quot>> ] keep
     car [
-      [ f f ] dip <lazy-io> [ swap set-lazy-io-cdr ] keep
+      [ f f ] dip <lazy-io> [ >>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

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 ;
+    [ cdr ] [ car ] bi ;
-
-: null? ( cons -- ? )
-    uncons and not ;
-
-: <car> ( x -- cons )
-    cons swap >>car ;
 
 : seq>cons ( seq -- cons )
-    <reversed> cons [ <car> swap >>cdr ] reduce ;
+    <reversed> 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 ]
+    pick nil? [ drop nip ]
-    [ [ uncons ] 2dip swapd [ call ] keep reduce-cons ] if ;
+    [ [ uncons ] 2dip swapd [ call ] keep reduce-cons ] if ;
+    
+INSTANCE: cons list