From b5405f69ae8e48c7495cddff6348bf9819929f3b Mon Sep 17 00:00:00 2001 From: James Cash Date: Tue, 3 Jun 2008 20:11:03 -0400 Subject: [PATCH] adding map-as, fixing seq>cons --- extra/lists/lists.factor | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/extra/lists/lists.factor b/extra/lists/lists.factor index d9af80a2bc..0af026edd1 100644 --- a/extra/lists/lists.factor +++ b/extra/lists/lists.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Chris Double & James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences accessors math ; +USING: kernel sequences accessors math arrays vectors classes ; IN: lists @@ -55,21 +55,27 @@ M: cons nil? ( cons -- bool ) : 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 ) - nil [ f cons swap >>cdr ] reduce ; - : (lmap) ( acc cons quot -- seq ) over nil? [ 2drop ] - [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (map-cons) ] if ; inline + [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap) ] if ; inline : lmap ( cons quot -- seq ) - [ { } clone ] 2dip (map-cons) ; inline + [ { } clone ] 2dip (lmap) ; inline + +: lmap-as ( cons quot exemplar -- seq ) + [ lmap ] dip like ; + +: same? ( obj1 obj2 -- ? ) + [ class ] bi@ = ; + +: seq>cons ( seq -- cons ) + [ ] keep nil [ tuck same? [ seq>cons ] when f cons swap >>cdr ] with reduce ; : cons>seq ( cons -- array ) - [ ] map-cons ; + [ ] lmap ; INSTANCE: cons list \ No newline at end of file