From a423ca63f44e9f8c17e08b6e1b9250fc343e55d3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 11 Feb 2008 00:14:40 -0600 Subject: [PATCH] Tiny cleanup of combinators.lib and sequences.lib --- extra/combinators/lib/lib.factor | 114 +++++++++---------------------- extra/sequences/lib/lib.factor | 47 +++++++++++-- 2 files changed, 73 insertions(+), 88 deletions(-) diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 9f0f7df1ce..9ccada1ec1 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -1,11 +1,9 @@ ! Copyright (C) 2007 Slava Pestov, Chris Double, Doug Coleman, ! Eduardo Cavazos, Daniel Ehrenberg. -! ! See http://factorcode.org/license.txt for BSD license. - -USING: kernel combinators namespaces quotations hashtables sequences assocs - arrays inference effects math math.ranges arrays.lib shuffle macros - bake combinators.cleave ; +USING: kernel combinators namespaces quotations hashtables +sequences assocs arrays inference effects math math.ranges +arrays.lib shuffle macros bake combinators.cleave ; IN: combinators.lib @@ -51,22 +49,6 @@ MACRO: napply ( n -- ) : dipd ( x y quot -- y ) 2 ndip ; inline -! each-with - -: each-withn ( seq quot n -- ) nwith each ; inline - -: each-with ( seq quot -- ) with each ; inline - -: each-with2 ( obj obj list quot -- ) 2 each-withn ; inline - -! map-with - -: map-withn ( seq quot n -- newseq ) nwith map ; inline - -: map-with ( seq quot -- ) with map ; inline - -: map-with2 ( obj obj list quot -- newseq ) 2 map-withn ; inline - : 2with ( param1 param2 obj quot -- obj curry ) with with ; inline @@ -88,39 +70,23 @@ MACRO: napply ( n -- ) : assoc-map-with ( obj assoc quot -- assoc ) with* assoc-map ; inline - -MACRO: nfirst ( n -- ) - [ [ swap nth ] curry [ keep ] curry ] map concat [ drop ] compose ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: sigma ( seq quot -- n ) [ rot slip + ] curry 0 swap reduce ; inline - -: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! short circuiting words ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! : short-circuit ( quots quot default -- quot ) -! >r { } map>assoc r> -! 1quotation swap alist>quot ; - : short-circuit ( quots quot default -- quot ) 1quotation -rot { } map>assoc alist>quot ; -! : short-circuit ( quots quot default -- quot ) -! 1quotation -rot map>alist alist>quot ; - -MACRO: && ( quots -- ? ) [ [ not ] append [ f ] ] t short-circuit ; +MACRO: && ( quots -- ? ) + [ [ not ] append [ f ] ] t short-circuit ; MACRO: <-&& ( quots -- ) - [ [ dup ] swap append [ not ] append [ f ] ] t short-circuit - [ nip ] append ; + [ [ dup ] swap append [ not ] append [ f ] ] t short-circuit + [ nip ] append ; MACRO: <--&& ( quots -- ) - [ [ 2dup ] swap append [ not ] append [ f ] ] t short-circuit - [ 2nip ] append ; + [ [ 2dup ] swap append [ not ] append [ f ] ] t short-circuit + [ 2nip ] append ; MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ; @@ -129,25 +95,25 @@ MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! MACRO: ifte ( quot quot quot -- ) - pick infer effect-in - dup 1+ swap - [ >r >r , nkeep , nrot r> r> if ] - bake ; + pick infer effect-in + dup 1+ swap + [ >r >r , nkeep , nrot r> r> if ] + bake ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! switch ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : preserving ( predicate -- quot ) - dup infer effect-in - dup 1+ spin - [ , , nkeep , nrot ] - bake ; + dup infer effect-in + dup 1+ spin + [ , , nkeep , nrot ] + bake ; MACRO: switch ( quot -- ) - [ [ preserving ] [ ] bi* ] assoc-map - [ , cond ] - bake ; + [ [ preserving ] [ ] bi* ] assoc-map + [ , cond ] + bake ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -156,41 +122,34 @@ MACRO: switch ( quot -- ) ! : pcall ( seq quots -- seq ) [ call ] 2map ; MACRO: parallel-call ( quots -- ) - [ [ unclip % r> dup >r push ] bake ] map concat - [ V{ } clone >r % drop r> >array ] bake ; - -! MACRO: parallel-call ( quots -- ) -! [ [ unclip ] swap append ] map -! [ [ r> swap add >r ] append ] map -! concat -! [ { } >r ] swap append ! pre -! [ drop r> ] append ; ! post - + [ [ unclip % r> dup >r push ] bake ] map concat + [ V{ } clone >r % drop r> >array ] bake ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! map-call and friends ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : (make-call-with) ( quots -- quot ) - [ [ keep ] curry ] map concat [ drop ] append ; + [ [ keep ] curry ] map concat [ drop ] append ; MACRO: call-with ( quots -- ) - (make-call-with) ; + (make-call-with) ; MACRO: map-call-with ( quots -- ) - [ (make-call-with) ] keep length [ narray ] curry compose ; + [ (make-call-with) ] keep length [ narray ] curry compose ; : (make-call-with2) ( quots -- quot ) - [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat - [ 2drop ] append ; + [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat + [ 2drop ] append ; MACRO: call-with2 ( quots -- ) - (make-call-with2) ; + (make-call-with2) ; MACRO: map-call-with2 ( quots -- ) - dup >r (make-call-with2) r> length [ narray ] curry append ; + [ (make-call-with2) ] keep length [ narray ] curry append ; -MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ; +MACRO: map-exec-with ( words -- ) + [ 1quotation ] map [ map-call-with ] curry ; MACRO: construct-slots ( assoc tuple-class -- tuple ) [ construct-empty ] curry swap [ @@ -208,14 +167,3 @@ MACRO: construct-slots ( assoc tuple-class -- tuple ) : and? ( obj quot1 quot2 -- ? ) >r keep r> rot [ call ] [ 2drop f ] if ; inline - -: prepare-index ( seq quot -- seq n quot ) - >r dup length r> ; inline - -: each-index ( seq quot -- ) - #! quot: ( elt index -- ) - prepare-index 2each ; inline - -: map-index ( seq quot -- ) - #! quot: ( elt index -- obj ) - prepare-index 2map ; inline diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index d89c5eec89..f7ac9c340d 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -1,8 +1,45 @@ +! Copyright (C) 2007 Slava Pestov, Chris Double, Doug Coleman, +! Eduardo Cavazos, Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: combinators.lib kernel sequences math namespaces assocs random sequences.private shuffle math.functions mirrors arrays math.parser sorting strings ascii ; IN: sequences.lib +: each-withn ( seq quot n -- ) nwith each ; inline + +: each-with ( seq quot -- ) with each ; inline + +: each-with2 ( obj obj list quot -- ) 2 each-withn ; inline + +: map-withn ( seq quot n -- newseq ) nwith map ; inline + +: map-with ( seq quot -- ) with map ; inline + +: map-with2 ( obj obj list quot -- newseq ) 2 map-withn ; inline + +MACRO: nfirst ( n -- ) + [ [ swap nth ] curry [ keep ] curry ] map concat [ drop ] compose ; + +: prepare-index ( seq quot -- seq n quot ) + >r dup length r> ; inline + +: each-index ( seq quot -- ) + #! quot: ( elt index -- ) + prepare-index 2each ; inline + +: map-index ( seq quot -- ) + #! quot: ( elt index -- obj ) + prepare-index 2map ; inline + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: sigma ( seq quot -- n ) + [ rot slip + ] curry 0 swap reduce ; inline + +: count ( seq quot -- n ) + [ 1 0 ? ] compose sigma ; inline + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : map-reduce ( seq map-quot reduce-quot -- result ) @@ -66,7 +103,7 @@ IN: sequences.lib : split-around ( seq quot -- before elem after ) dupd find over [ "Element not found" throw ] unless - >r cut-slice 1 tail r> swap ; inline + >r cut 1 tail r> swap ; inline : (map-until) ( quot pred -- quot ) [ dup ] swap 3compose @@ -149,7 +186,7 @@ PRIVATE> ! List the positions of obj in seq : indices ( seq obj -- seq ) - >r dup length swap r> - [ = [ ] [ drop f ] if ] curry - 2map - [ ] subset ; + >r dup length swap r> + [ = [ ] [ drop f ] if ] curry + 2map + [ ] subset ;