From f63e6f1e35a7332fb50385c74c3157f28cfcfbfc Mon Sep 17 00:00:00 2001 From: James Cash Date: Tue, 3 Jun 2008 23:39:45 -0400 Subject: [PATCH] Fixing some bugs/oddities in lists implementations --- extra/lists/lists.factor | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/extra/lists/lists.factor b/extra/lists/lists.factor index 0af026edd1..b7e5e6523f 100644 --- a/extra/lists/lists.factor +++ b/extra/lists/lists.factor @@ -22,10 +22,13 @@ M: cons cdr ( cons -- cdr ) : nil ( -- cons ) T{ cons f f f } ; + +: uncons ( cons -- cdr car ) + [ cdr ] [ car ] bi ; -M: cons nil? ( cons -- bool ) - nil eq? ; - +M: cons nil? ( cons -- ? ) + uncons and not ; + : 1list ( obj -- cons ) nil cons ; @@ -40,9 +43,6 @@ M: cons nil? ( cons -- bool ) : 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 ; @@ -57,14 +57,15 @@ M: cons nil? ( cons -- bool ) over nil? [ 2drop ] [ [ uncons ] dip tuck call leach ] if ; inline : lreduce ( list identity quot -- result ) - swapd leach ; inline + pick nil? [ drop nip ] + [ [ uncons ] 2dip swapd [ call ] keep lreduce ] if ; inline : (lmap) ( acc cons quot -- seq ) over nil? [ 2drop ] [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap) ] if ; inline : lmap ( cons quot -- seq ) - [ { } clone ] 2dip (lmap) ; inline + { } -rot (lmap) ; inline : lmap-as ( cons quot exemplar -- seq ) [ lmap ] dip like ; @@ -76,6 +77,6 @@ M: cons nil? ( cons -- bool ) [ ] keep nil [ tuck same? [ seq>cons ] when f cons swap >>cdr ] with reduce ; : cons>seq ( cons -- array ) - [ ] lmap ; + [ dup cons? [ cons>seq ] when ] lmap ; INSTANCE: cons list \ No newline at end of file