From ae75b41a43db09d4504170f205d1801e081f92b9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 31 May 2009 08:53:42 -0500 Subject: [PATCH] clean up some stack shuffling --- extra/cursors/cursors.factor | 56 +++++++++++++++++++----------------- 1 file changed, 29 insertions(+), 27 deletions(-) diff --git a/extra/cursors/cursors.factor b/extra/cursors/cursors.factor index 059129f22e..11b9bf4bf4 100644 --- a/extra/cursors/cursors.factor +++ b/extra/cursors/cursors.factor @@ -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