]> gitweb.factorcode.org Git - factor.git/commitdiff
clean up some stack shuffling
authorDoug Coleman <erg@jobim.local>
Sun, 31 May 2009 13:53:42 +0000 (08:53 -0500)
committerDoug Coleman <erg@jobim.local>
Sun, 31 May 2009 13:53:42 +0000 (08:53 -0500)
extra/cursors/cursors.factor

index 059129f22ef71e8295660d38a10ae725dfd18b3d..11b9bf4bf47fd3dd53579e418346097fdca20d94 100644 (file)
@@ -12,31 +12,32 @@ GENERIC: cursor-write ( obj cursor -- )
 ERROR: cursor-ended cursor ;
 
 : cursor-get ( cursor -- obj )
-   dup cursor-done?
-   [ cursor-ended ] [ cursor-get-unsafe ] if ; inline
+    dup cursor-done?
+    [ cursor-ended ] [ cursor-get-unsafe ] if ; inline
 
-: find-done? ( quot cursor -- ? )
-   dup cursor-done? [ 2drop t ] [ cursor-get-unsafe swap call ] if ; inline
-
-: cursor-until ( quot cursor -- )
-   [ find-done? not ]
-   [ cursor-advance drop ] bi-curry bi-curry while ; inline
+: find-done? ( cursor quot -- ? )
+    over cursor-done?
+    [ 2drop t ] [ [ cursor-get-unsafe ] dip call ] if ; inline
 
+: cursor-until ( cursor quot -- )
+    [ find-done? not ]
+    [ drop cursor-advance ] bi-curry bi-curry while ; inline
 : cursor-each ( cursor quot -- )
-   [ f ] compose swap cursor-until ; inline
+    [ f ] compose cursor-until ; inline
 
 : cursor-find ( cursor quot -- obj ? )
-   swap [ cursor-until ] keep
-   dup cursor-done? [ drop f f ] [ cursor-get t ] if ; inline
+    [ cursor-until ] [ drop ] 2bi
+    dup cursor-done? [ drop f f ] [ cursor-get t ] if ; inline
 
 : cursor-any? ( cursor quot -- ? )
-   cursor-find nip ; inline
+    cursor-find nip ; inline
 
 : cursor-all? ( cursor quot -- ? )
-   [ not ] compose cursor-any? not ; inline
+    [ not ] compose cursor-any? not ; inline
 
 : cursor-map-quot ( quot to -- quot' )
-   [ [ call ] dip cursor-write ] 2curry ; inline
+    [ [ call ] dip cursor-write ] 2curry ; inline
 
 : cursor-map ( from to quot -- )
    swap cursor-map-quot cursor-each ; inline
@@ -46,10 +47,10 @@ ERROR: cursor-ended cursor ;
     [ cursor-write ] 2curry when ; inline
 
 : cursor-filter-quot ( quot to -- quot' )
-   [ cursor-write-if ] 2curry ; inline
+    [ cursor-write-if ] 2curry ; inline
 
 : cursor-filter ( from to quot -- )
-   swap cursor-filter-quot cursor-each ; inline
+    swap cursor-filter-quot cursor-each ; inline
 
 TUPLE: from-sequence { seq sequence } { n integer } ;
 
@@ -60,19 +61,19 @@ M: from-sequence cursor-done? ( cursor -- ? )
     >from-sequence< length >= ;
 
 M: from-sequence cursor-valid?
-   >from-sequence< bounds-check? not ;
+    >from-sequence< bounds-check? not ;
 
 M: from-sequence cursor-get-unsafe
-   >from-sequence< nth-unsafe ;
+    >from-sequence< nth-unsafe ;
 
 M: from-sequence cursor-advance
-   [ 1+ ] change-n drop ;
+    [ 1+ ] change-n drop ;
 
 : >input ( seq -- cursor )
-   0 from-sequence boa ; inline
+    0 from-sequence boa ; inline
 
 : iterate ( seq quot iterator -- )
-   [ >input ] 2dip call ; inline
+    [ >input ] 2dip call ; inline
 
 : each ( seq quot -- ) [ cursor-each ] iterate ; inline
 : find ( seq quot -- ? ) [ cursor-find ] iterate ; inline
@@ -82,18 +83,19 @@ M: from-sequence cursor-advance
 TUPLE: to-sequence { seq sequence } { exemplar sequence } ;
 
 M: to-sequence cursor-write
-   seq>> push ;
+    seq>> push ;
 
 : freeze ( cursor -- seq )
-   [ seq>> ] [ exemplar>> ] bi like ; inline
+    [ seq>> ] [ exemplar>> ] bi like ; inline
 
 : >output ( seq -- cursor )
-   [ [ length ] keep new-resizable ] keep
-   to-sequence boa ; inline
+    [ [ length ] keep new-resizable ] keep
+    to-sequence boa ; inline
 
 : transform ( seq quot transformer -- newseq )
-   [ [ >input ] [ >output ] bi ] 2dip
-   [ call ] [ 2drop freeze ] 3bi ; inline
+    [ [ >input ] [ >output ] bi ] 2dip
+    [ call ]
+    [ 2drop freeze ] 3bi ; inline
 
 : map ( seq quot -- ) [ cursor-map ] transform ; inline
 : filter ( seq quot -- newseq ) [ cursor-filter ] transform ; inline