From 2be5693f38f8e0f982cdda17e294dd859b2d5948 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 22 Nov 2008 00:30:39 -0600 Subject: [PATCH] Clean up documents --- basis/documents/documents.factor | 68 +++++++++++++++++--------------- 1 file changed, 36 insertions(+), 32 deletions(-) diff --git a/basis/documents/documents.factor b/basis/documents/documents.factor index 54bc85284a..a82437ba40 100644 --- a/basis/documents/documents.factor +++ b/basis/documents/documents.factor @@ -5,9 +5,9 @@ sequences strings splitting combinators unicode.categories math.order ; IN: documents -: +col ( loc n -- newloc ) >r first2 r> + 2array ; +: +col ( loc n -- newloc ) [ first2 ] dip + 2array ; -: +line ( loc n -- newloc ) >r first2 swap r> + swap 2array ; +: +line ( loc n -- newloc ) [ first2 swap ] dip + swap 2array ; : =col ( n loc -- newloc ) first swap 2array ; @@ -31,10 +31,10 @@ TUPLE: document < model locs ; : doc-line ( n document -- string ) value>> nth ; : doc-lines ( from to document -- slice ) - >r 1+ r> value>> ; + [ 1+ ] dip value>> ; : start-on-line ( document from line# -- n1 ) - >r dup first r> = [ nip second ] [ 2drop 0 ] if ; + [ dup first ] dip = [ nip second ] [ 2drop 0 ] if ; : end-on-line ( document to line# -- n2 ) over first over = [ @@ -47,12 +47,14 @@ TUPLE: document < model locs ; 2over = [ 3drop ] [ - >r [ first ] bi@ 1+ dup r> each + [ [ first ] bi@ 1+ dup ] dip each ] if ; inline : start/end-on-line ( from to line# -- n1 n2 ) - tuck >r >r document get -rot start-on-line r> r> - document get -rot end-on-line ; + tuck + [ [ document get ] 2dip start-on-line ] + [ [ document get ] 2dip end-on-line ] + 2bi* ; : (doc-range) ( from to line# -- ) [ start/end-on-line ] keep document get doc-line , ; @@ -60,16 +62,18 @@ TUPLE: document < model locs ; : doc-range ( from to document -- string ) [ document set 2dup [ - >r 2dup r> (doc-range) + [ 2dup ] dip (doc-range) ] each-line 2drop ] { } make "\n" join ; : text+loc ( lines loc -- loc ) - over >r over length 1 = [ - nip first2 - ] [ - first swap length 1- + 0 - ] if r> peek length + 2array ; + over [ + over length 1 = [ + nip first2 + ] [ + first swap length 1- + 0 + ] if + ] dip peek length + 2array ; : prepend-first ( str seq -- ) 0 swap [ append ] change-nth ; @@ -78,25 +82,25 @@ TUPLE: document < model locs ; [ length 1- ] keep [ prepend ] change-nth ; : loc-col/str ( loc document -- str col ) - >r first2 swap r> nth swap ; + [ first2 swap ] dip nth swap ; : prepare-insert ( newinput from to lines -- newinput ) - tuck loc-col/str tail-slice >r loc-col/str head-slice r> + tuck [ loc-col/str head-slice ] [ loc-col/str tail-slice ] 2bi* pick append-last over prepend-first ; : (set-doc-range) ( newlines from to lines -- ) [ prepare-insert ] 3keep - >r [ first ] bi@ 1+ r> + [ [ first ] bi@ 1+ ] dip replace-slice ; : set-doc-range ( string from to document -- ) [ - >r >r >r string-lines r> [ text+loc ] 2keep r> r> + [ [ string-lines ] dip [ text+loc ] 2keep ] 2dip [ [ (set-doc-range) ] keep ] change-model ] keep update-locs ; : remove-doc-range ( from to document -- ) - >r >r >r "" r> r> r> set-doc-range ; + [ "" ] 3dip set-doc-range ; : last-line# ( document -- line ) value>> length 1- ; @@ -111,7 +115,7 @@ TUPLE: document < model locs ; dupd doc-line length 2array ; : line-end? ( loc document -- ? ) - >r first2 swap r> doc-line length = ; + [ first2 swap ] dip doc-line length = ; : doc-end ( document -- loc ) [ last-line# ] keep line-end ; @@ -123,7 +127,7 @@ TUPLE: document < model locs ; over first 0 < [ 2drop { 0 0 } ] [ - >r first2 swap tuck r> validate-col 2array + [ first2 swap tuck ] dip validate-col 2array ] if ] if ; @@ -131,7 +135,7 @@ TUPLE: document < model locs ; value>> "\n" join ; : set-doc-string ( string document -- ) - >r string-lines V{ } like r> [ set-model ] keep + [ string-lines V{ } like ] dip [ set-model ] keep [ doc-end ] [ update-locs ] bi ; : clear-doc ( document -- ) @@ -141,17 +145,17 @@ GENERIC: prev-elt ( loc document elt -- newloc ) GENERIC: next-elt ( loc document elt -- newloc ) : prev/next-elt ( loc document elt -- start end ) - 3dup next-elt >r prev-elt r> ; + [ prev-elt ] [ next-elt ] 3bi ; : elt-string ( loc document elt -- string ) - over >r prev/next-elt r> doc-range ; + [ prev/next-elt ] [ drop ] 2bi doc-range ; TUPLE: char-elt ; : (prev-char) ( loc document quot -- loc ) -rot { { [ over { 0 0 } = ] [ drop ] } - { [ over second zero? ] [ >r first 1- r> line-end ] } + { [ over second zero? ] [ [ first 1- ] dip line-end ] } [ pick call ] } cond nip ; inline @@ -175,14 +179,14 @@ M: one-char-elt prev-elt 2drop ; M: one-char-elt next-elt 2drop ; : (word-elt) ( loc document quot -- loc ) - pick >r - >r >r first2 swap r> doc-line r> call - r> =col ; inline + pick [ + [ [ first2 swap ] dip doc-line ] dip call + ] dip =col ; inline : ((word-elt)) ( n seq -- ? n seq ) [ ?nth blank? ] 2keep ; : break-detector ( ? -- quot ) - [ >r blank? r> xor ] curry ; inline + [ [ blank? ] dip xor ] curry ; inline : (prev-word) ( ? col str -- col ) rot break-detector find-last-from drop ?1+ ; @@ -195,17 +199,17 @@ TUPLE: one-word-elt ; M: one-word-elt prev-elt drop - [ f -rot >r 1- r> (prev-word) ] (word-elt) ; + [ [ [ f ] dip 1- ] dip (prev-word) ] (word-elt) ; M: one-word-elt next-elt drop - [ f -rot (next-word) ] (word-elt) ; + [ [ f ] 2dip (next-word) ] (word-elt) ; TUPLE: word-elt ; M: word-elt prev-elt drop - [ [ >r 1- r> ((word-elt)) (prev-word) ] (word-elt) ] + [ [ [ 1- ] dip ((word-elt)) (prev-word) ] (word-elt) ] (prev-char) ; M: word-elt next-elt @@ -219,7 +223,7 @@ M: one-line-elt prev-elt 2drop first 0 2array ; M: one-line-elt next-elt - drop >r first dup r> doc-line length 2array ; + drop [ first dup ] dip doc-line length 2array ; TUPLE: line-elt ;