Tiny cleanup of combinators.lib and sequences.lib

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
-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
 
@@ -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 <reversed> r>
-!   1quotation swap alist>quot ;
-
 : short-circuit ( quots quot default -- 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 -- )
-  [ [ dup ] swap append [ not ] append [ f ] ] t short-circuit
+    [ [ dup ] swap append [ not ] append [ f ] ] t short-circuit
-  [ nip ] append ;
+    [ nip ] append ;
 
 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 ;
 
@@ -129,25 +95,25 @@ MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ;
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 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
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : 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 -- )
-  [ [ 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 ;
 
 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
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : (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
+    [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
-  [ 2drop ] append ;
+    [ 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

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>
+    >r dup length swap r>
-  [ = [ ] [ drop f ] if ] curry
+    [ = [ ] [ drop f ] if ] curry
-  2map
+    2map
-  [ ] subset ;
+    [ ] subset ;