Tiny cleanup of combinators.lib and sequences.lib
parent
41a5629090
commit
a423ca63f4
|
@ -1,11 +1,9 @@
|
||||||
! Copyright (C) 2007 Slava Pestov, Chris Double, Doug Coleman,
|
! Copyright (C) 2007 Slava Pestov, Chris Double, Doug Coleman,
|
||||||
! Eduardo Cavazos, Daniel Ehrenberg.
|
! Eduardo Cavazos, Daniel Ehrenberg.
|
||||||
!
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: kernel combinators namespaces quotations hashtables
|
||||||
USING: kernel combinators namespaces quotations hashtables sequences assocs
|
sequences assocs arrays inference effects math math.ranges
|
||||||
arrays inference effects math math.ranges arrays.lib shuffle macros
|
arrays.lib shuffle macros bake combinators.cleave ;
|
||||||
bake combinators.cleave ;
|
|
||||||
|
|
||||||
IN: combinators.lib
|
IN: combinators.lib
|
||||||
|
|
||||||
|
@ -51,22 +49,6 @@ MACRO: napply ( n -- )
|
||||||
|
|
||||||
: dipd ( x y quot -- y ) 2 ndip ; inline
|
: 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 )
|
: 2with ( param1 param2 obj quot -- obj curry )
|
||||||
with with ; inline
|
with with ; inline
|
||||||
|
|
||||||
|
@ -88,39 +70,23 @@ MACRO: napply ( n -- )
|
||||||
: assoc-map-with ( obj assoc quot -- assoc )
|
: assoc-map-with ( obj assoc quot -- assoc )
|
||||||
with* assoc-map ; inline
|
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 circuiting words
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
! : short-circuit ( quots quot default -- quot )
|
|
||||||
! >r { } map>assoc <reversed> r>
|
|
||||||
! 1quotation swap alist>quot ;
|
|
||||||
|
|
||||||
: short-circuit ( quots quot default -- quot )
|
: short-circuit ( quots quot default -- quot )
|
||||||
1quotation -rot { } map>assoc <reversed> alist>quot ;
|
1quotation -rot { } map>assoc <reversed> alist>quot ;
|
||||||
|
|
||||||
! : short-circuit ( quots quot default -- quot )
|
MACRO: && ( quots -- ? )
|
||||||
! 1quotation -rot map>alist <reversed> alist>quot ;
|
[ [ not ] append [ f ] ] t short-circuit ;
|
||||||
|
|
||||||
MACRO: && ( quots -- ? ) [ [ not ] append [ f ] ] t short-circuit ;
|
|
||||||
|
|
||||||
MACRO: <-&& ( quots -- )
|
MACRO: <-&& ( quots -- )
|
||||||
[ [ dup ] swap append [ not ] append [ f ] ] t short-circuit
|
[ [ dup ] swap append [ not ] append [ f ] ] t short-circuit
|
||||||
[ nip ] append ;
|
[ nip ] append ;
|
||||||
|
|
||||||
MACRO: <--&& ( quots -- )
|
MACRO: <--&& ( quots -- )
|
||||||
[ [ 2dup ] swap append [ not ] append [ f ] ] t short-circuit
|
[ [ 2dup ] swap append [ not ] append [ f ] ] t short-circuit
|
||||||
[ 2nip ] append ;
|
[ 2nip ] append ;
|
||||||
|
|
||||||
MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ;
|
MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ;
|
||||||
|
|
||||||
|
@ -129,25 +95,25 @@ MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ;
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
MACRO: ifte ( quot quot quot -- )
|
MACRO: ifte ( quot quot quot -- )
|
||||||
pick infer effect-in
|
pick infer effect-in
|
||||||
dup 1+ swap
|
dup 1+ swap
|
||||||
[ >r >r , nkeep , nrot r> r> if ]
|
[ >r >r , nkeep , nrot r> r> if ]
|
||||||
bake ;
|
bake ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
! switch
|
! switch
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: preserving ( predicate -- quot )
|
: preserving ( predicate -- quot )
|
||||||
dup infer effect-in
|
dup infer effect-in
|
||||||
dup 1+ spin
|
dup 1+ spin
|
||||||
[ , , nkeep , nrot ]
|
[ , , nkeep , nrot ]
|
||||||
bake ;
|
bake ;
|
||||||
|
|
||||||
MACRO: switch ( quot -- )
|
MACRO: switch ( quot -- )
|
||||||
[ [ preserving ] [ ] bi* ] assoc-map
|
[ [ preserving ] [ ] bi* ] assoc-map
|
||||||
[ , cond ]
|
[ , cond ]
|
||||||
bake ;
|
bake ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -156,41 +122,34 @@ MACRO: switch ( quot -- )
|
||||||
! : pcall ( seq quots -- seq ) [ call ] 2map ;
|
! : pcall ( seq quots -- seq ) [ call ] 2map ;
|
||||||
|
|
||||||
MACRO: parallel-call ( quots -- )
|
MACRO: parallel-call ( quots -- )
|
||||||
[ [ unclip % r> dup >r push ] bake ] map concat
|
[ [ unclip % r> dup >r push ] bake ] map concat
|
||||||
[ V{ } clone >r % drop r> >array ] bake ;
|
[ 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
|
|
||||||
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
! map-call and friends
|
! map-call and friends
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: (make-call-with) ( quots -- quot )
|
: (make-call-with) ( quots -- quot )
|
||||||
[ [ keep ] curry ] map concat [ drop ] append ;
|
[ [ keep ] curry ] map concat [ drop ] append ;
|
||||||
|
|
||||||
MACRO: call-with ( quots -- )
|
MACRO: call-with ( quots -- )
|
||||||
(make-call-with) ;
|
(make-call-with) ;
|
||||||
|
|
||||||
MACRO: map-call-with ( quots -- )
|
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 )
|
: (make-call-with2) ( quots -- quot )
|
||||||
[ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
|
[ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
|
||||||
[ 2drop ] append ;
|
[ 2drop ] append ;
|
||||||
|
|
||||||
MACRO: call-with2 ( quots -- )
|
MACRO: call-with2 ( quots -- )
|
||||||
(make-call-with2) ;
|
(make-call-with2) ;
|
||||||
|
|
||||||
MACRO: map-call-with2 ( quots -- )
|
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 )
|
MACRO: construct-slots ( assoc tuple-class -- tuple )
|
||||||
[ construct-empty ] curry swap [
|
[ construct-empty ] curry swap [
|
||||||
|
@ -208,14 +167,3 @@ MACRO: construct-slots ( assoc tuple-class -- tuple )
|
||||||
|
|
||||||
: and? ( obj quot1 quot2 -- ? )
|
: and? ( obj quot1 quot2 -- ? )
|
||||||
>r keep r> rot [ call ] [ 2drop f ] if ; inline
|
>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
|
|
||||||
|
|
|
@ -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
|
USING: combinators.lib kernel sequences math namespaces assocs
|
||||||
random sequences.private shuffle math.functions mirrors
|
random sequences.private shuffle math.functions mirrors
|
||||||
arrays math.parser sorting strings ascii ;
|
arrays math.parser sorting strings ascii ;
|
||||||
IN: sequences.lib
|
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 )
|
: map-reduce ( seq map-quot reduce-quot -- result )
|
||||||
|
@ -66,7 +103,7 @@ IN: sequences.lib
|
||||||
|
|
||||||
: split-around ( seq quot -- before elem after )
|
: split-around ( seq quot -- before elem after )
|
||||||
dupd find over [ "Element not found" throw ] unless
|
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 )
|
: (map-until) ( quot pred -- quot )
|
||||||
[ dup ] swap 3compose
|
[ dup ] swap 3compose
|
||||||
|
@ -149,7 +186,7 @@ PRIVATE>
|
||||||
! List the positions of obj in seq
|
! List the positions of obj in seq
|
||||||
|
|
||||||
: indices ( seq obj -- seq )
|
: indices ( seq obj -- seq )
|
||||||
>r dup length swap r>
|
>r dup length swap r>
|
||||||
[ = [ ] [ drop f ] if ] curry
|
[ = [ ] [ drop f ] if ] curry
|
||||||
2map
|
2map
|
||||||
[ ] subset ;
|
[ ] subset ;
|
||||||
|
|
Loading…
Reference in New Issue