Clean up documents

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>> <slice> ;
+    [ 1+ ] dip value>> <slice> ;
 
 : 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 <slice> r> each
+        [ [ first ] bi@ 1+ dup <slice> ] 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 <slice> , ;
@@ -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 ;