Merge branch 'master' into new_ui

basis/random/random.factor

@@ -51,6 +51,9 @@ PRIVATE>
         [ length random-integer ] keep nth
     ] if-empty ;
 
+: randomize ( seq -- seq' )
+    dup length 1 (a,b] [ dup random pick exchange ] each ;
+
 : delete-random ( seq -- elt )
     [ length random-integer ] keep [ nth ] 2keep delete-nth ;
 

basis/ui/gadgets/panes/panes.factor

@@ -358,25 +358,25 @@ M: f sloppy-pick-up*
     [ 3drop { } ]
     if ;
 
-: move-caret ( pane -- pane )
-    dup hand-rel over sloppy-pick-up >>caret
+: move-caret ( pane loc -- pane )
+    over screen-loc v- over sloppy-pick-up >>caret
     dup relayout-1 ;
 
 : begin-selection ( pane -- )
     f >>selecting?
-    move-caret
+    hand-loc get move-caret
     f >>mark
     drop ;
 
 : extend-selection ( pane -- )
     hand-moved? [
         dup selecting?>> [
-            move-caret
+            hand-loc get move-caret
         ] [
             dup hand-clicked get child? [
                 t >>selecting?
                 dup hand-clicked set-global
-                move-caret
+                hand-click-loc get move-caret
                 caret>mark
             ] when
         ] if
@@ -394,7 +394,7 @@ M: f sloppy-pick-up*
 : select-to-caret ( pane -- )
     t >>selecting?
     dup mark>> [ caret>mark ] unless
-    move-caret
+    hand-loc get move-caret
     dup request-focus
     com-copy-selection ;
 

extra/automata/ui/ui.factor

@@ -15,7 +15,7 @@ USING: kernel namespaces math quotations arrays hashtables sequences threads
        ui.gadgets.theme
        ui.gadgets.handler
        accessors
-       namespaces.lib assocs.lib vars
+       vars fry
        rewrite-closures automata math.geometry.rect newfx ;
 
 IN: automata.ui
@@ -24,9 +24,9 @@ IN: automata.ui
 
 : draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ;
 
-: draw-line ( y line -- ) 0 swap [ >r 2dup r> draw-point 1+ ] each 2drop ;
+: draw-line ( y line -- ) 0 swap [ [ 2dup ] dip draw-point 1+ ] each 2drop ;
 
-: (draw-bitmap) ( bitmap -- ) 0 swap [ >r dup r> draw-line 1+ ] each drop ;
+: (draw-bitmap) ( bitmap -- ) 0 swap [ [ dup ] dip draw-line 1+ ] each drop ;
 
 : draw-bitmap ( bitmap -- ) GL_POINTS glBegin (draw-bitmap) glEnd ;
 
@@ -46,9 +46,9 @@ VAR: slate
 
 ! Create a quotation that is appropriate for buttons and gesture handler.
 
-: view-action ( quot -- quot ) [ drop [ ] with-view ] make* closed-quot ;
+: view-action ( quot -- quot ) '[ drop _ with-view ] closed-quot ;
 
-: view-button ( label quot -- ) >r <label> r> view-action <bevel-button> ;
+: view-button ( label quot -- button ) [ <label> ] dip view-action <bevel-button> ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/bind-in/bind-in.factor

@@ -1,12 +0,0 @@
-
-USING: kernel parser lexer locals.parser locals.types ;
-
-IN: bind-in
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: ->
-  "[" parse-tokens make-locals dup push-locals
-  \ ] (parse-lambda) <lambda>
-  parsed-lambda
-  \ call parsed ; parsing

extra/bubble-chamber/bubble-chamber.factor

@@ -83,7 +83,7 @@ DEFER: collision-theta
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: theta-dd-small? ( par limit -- par ? ) >r dup theta-dd>> abs r> < ;
+: theta-dd-small? ( par limit -- par ? ) [ dup theta-dd>> abs ] dip < ;
 
 : random-theta-dd  ( par a b -- par ) 2random >>theta-dd ;
 
@@ -149,8 +149,8 @@ METHOD: collide ( <axion> -- )
 : axion-white ( dy -- dy ) dup 1 swap dy>alpha gray boa \ stroke-color set ;
 : axion-black ( dy -- dy ) dup 0 swap dy>alpha gray boa \ stroke-color set ;
 
-: axion-point- ( particle dy -- particle ) >r dup pos>> r> v-y point ;
-: axion-point+ ( particle dy -- particle ) >r dup pos>> r> v+y point ;
+: axion-point- ( particle dy -- particle ) [ dup pos>> ] dip v-y point ;
+: axion-point+ ( particle dy -- particle ) [ dup pos>> ] dip v+y point ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/cfdg/cfdg.factor

@@ -1,6 +1,6 @@
 
 USING: kernel alien.c-types combinators namespaces make arrays
-       sequences sequences.lib namespaces.lib splitting
+       sequences splitting
        math math.functions math.vectors math.trig
        opengl.gl opengl.glu opengl ui ui.gadgets.slate
        vars colors self self.slots
@@ -60,7 +60,7 @@ VAR: color-stack
 : double-nth* ( c-array indices -- seq )
   swap byte-array>double-array [ nth ] curry map ;
 
-: check-size ( modelview -- num ) { 0 1 4 5 } double-nth* [ abs ] map biggest ;
+: check-size ( modelview -- num ) { 0 1 4 5 } double-nth* [ abs ] map supremum ;
 
 VAR: threshold
 

extra/descriptive/descriptive.factor

@@ -11,7 +11,7 @@ M: descriptive-error summary
 
 <PRIVATE
 : rethrower ( word inputs -- quot )
-    [ length ] keep [ >r narray r> swap 2array flip ] 2curry
+    [ length ] keep [ [ narray ] dip swap 2array flip ] 2curry
     [ 2 ndip descriptive-error ] 2curry ;
 
 : [descriptive] ( word def -- newdef )

extra/dns/dns.factor

@@ -413,11 +413,12 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
         [ 6 + get-double ]
       }
         2cleave
-      >r >r >r
-      get-question-section r>
-      get-rr-section       r>
-      get-rr-section       r>
-      get-rr-section
+      {
+        [ get-question-section ]
+        [ get-rr-section ]
+        [ get-rr-section ]
+        [ get-rr-section ]
+      } spread
       2drop
     ]
   }
@@ -425,7 +426,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
 
 : ba->message ( ba -- message ) parse-message ;
 
-: with-message-bytes ( ba quot -- ) >r ba->message r> call message->ba ; inline
+: with-message-bytes ( ba quot -- ) [ ba->message ] dip call message->ba ; inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/dns/server/server.factor

@@ -1,8 +1,8 @@
 
 USING: kernel combinators sequences sets math threads namespaces continuations
        debugger io io.sockets unicode.case accessors destructors
-       combinators.cleave combinators.lib combinators.short-circuit 
-       newfx bake bake.fry
+       combinators.cleave combinators.short-circuit 
+       newfx fry
        dns dns.util dns.misc ;
 
 IN: dns.server
@@ -204,5 +204,5 @@ DEFER: query->rrs
   [ receive-packet handle-request ] [ receive-loop ] bi ;
 
 : loop ( addr-spec -- )
-  [ <datagram> '[ , [ receive-loop ] with-disposal ] try ] [ loop ] bi ;
+  [ <datagram> '[ _ [ receive-loop ] with-disposal ] try ] [ loop ] bi ;
 

extra/dns/util/util.factor

@@ -1,14 +1,12 @@
 
-USING: kernel sequences sorting math math.order macros bake bake.fry ;
+USING: kernel sequences sorting math math.order macros fry ;
 
 IN: dns.util
 
 : tri-chain ( obj p q r -- x y z )
-  >r >r call dup r> call dup r> call ; inline
+  [ [ call dup ] dip call dup ] dip call ; inline
 
-MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ;
-
-! : 1if ( test then else -- ) >r >r >r dup r> call r> r> if ; inline ;
+MACRO: 1if ( test then else -- ) '[ dup @ _ _ if ] ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/fjsc/fjsc.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel peg strings sequences math math.parser
 namespaces make words quotations arrays hashtables io
-io.streams.string assocs ascii peg.parsers accessors ;
+io.streams.string assocs ascii peg.parsers accessors
+words.symbol ;
 IN: fjsc
 
 TUPLE: ast-number value ;

extra/inverse/inverse.factor

@@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
 continuations debugger classes.tuple namespaces make vectors
 bit-arrays byte-arrays strings sbufs math.functions macros
 sequences.private combinators mirrors
-combinators.short-circuit fry ;
+combinators.short-circuit fry words.symbol ;
 RENAME: _ fry => __
 IN: inverse
 
@@ -135,9 +135,6 @@ MACRO: undo ( quot -- ) [undo] ;
 \ not [ not ] define-inverse
 \ >boolean [ { t f } memq? assure ] define-inverse
 
-\ >r [ r> ] define-inverse
-\ r> [ >r ] define-inverse
-
 \ tuple>array [ >tuple ] define-inverse
 \ >tuple [ tuple>array ] define-inverse
 \ reverse [ reverse ] define-inverse

extra/lint/lint.factor

@@ -15,13 +15,13 @@ SYMBOL: def-hash-keys
 
 : more-defs ( hash -- )
     {
-        { -rot [ swap >r swap r> ] }
+        { -rot [ swap [ swap ] dip ] }
         { -rot [ swap swapd ] }
-        { rot [ >r swap r> swap ] }
+        { rot [ [ swap ] dip swap ] }
         { rot [ swapd swap ] }
         { over [ dup swap ] }
         { tuck [ dup -rot ] }
-        { swapd [ >r swap r> ] }
+        { swapd [ [ swap ] dip ] }
         { 2nip [ nip nip ] }
         { 2drop [ drop drop ] }
         { 3drop [ drop drop drop ] }

extra/math/function-tools/function-tools.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Reginald Keith Ford II.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math arrays sequences sequences.lib ;
+USING: kernel math arrays sequences ;
 IN: math.function-tools
 
 ! Tools for quickly comparing, transforming, and evaluating mathematical functions

extra/multi-methods/tests/definitions.factor

@@ -16,7 +16,7 @@ DEFER: fake
 [ t ] [ { } \ fake <method> method-body? ] unit-test
 
 [
-    [ { } [ ] ] [ \ fake methods prepare-methods >r sort-methods r> ] unit-test
+    [ { } [ ] ] [ \ fake methods prepare-methods [ sort-methods ] dip ] unit-test
 
     [ t ] [ { } \ fake multi-dispatch-quot callable? ] unit-test
 

extra/newfx/newfx.factor

@@ -1,5 +1,5 @@
 
-USING: kernel sequences assocs circular sets fry sequences.lib ;
+USING: kernel sequences assocs circular sets fry ;
 
 USING: math multi-methods ;
 
@@ -62,8 +62,8 @@ METHOD: as { sequence object  number }      pick set-nth ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-METHOD: is-of { number object  sequence } dup >r swapd set-nth r> ;
-METHOD: as-of { object  number sequence } dup >r       set-nth r> ;
+METHOD: is-of { number object  sequence } dup [ swapd set-nth ] dip ;
+METHOD: as-of { object  number sequence } dup [       set-nth ] dip ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -93,8 +93,8 @@ METHOD: as { assoc object object }      pick set-at ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-METHOD: is-of { object object assoc } dup >r swapd set-at r> ;
-METHOD: as-of { object object assoc } dup >r       set-at r> ;
+METHOD: is-of { object object assoc } dup [ swapd set-at ] dip ;
+METHOD: as-of { object object assoc } dup [       set-at ] dip ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -213,7 +213,7 @@ METHOD: as-mutate { object object assoc }       set-at ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: snip          ( seq a b -- seq ) >r over r> [ head ] [ tail ] 2bi* append ;
+: snip          ( seq a b -- seq ) [ over ] dip [ head ] [ tail ] 2bi* append ;
 : snip-this     ( a b seq -- seq ) -rot snip ;
 : snip!         ( seq a b -- seq )      pick delete-slice ;
 : snip-this!    ( a b seq -- seq ) -rot pick delete-slice ;
@@ -222,7 +222,7 @@ METHOD: as-mutate { object object assoc }       set-at ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: invert-index ( seq i -- seq i ) >r dup length 1 - r> - ;
+: invert-index ( seq i -- seq i ) [ dup length 1 - ] dip - ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -236,9 +236,9 @@ METHOD: as-mutate { object object assoc }       set-at ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: insert ( seq i obj -- seq ) >r cut r> prefix append ;
+: insert ( seq i obj -- seq ) [ cut ] dip prefix append ;
 
-: splice ( seq i seq -- seq ) >r cut r> prepend append ;
+: splice ( seq i seq -- seq ) [ cut ] dip prepend append ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/ori/ori.factor

@@ -17,7 +17,7 @@ C: <ori> ori
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: make-matrix ( quot width -- matrix ) >r { } make r> group ; inline
+: make-matrix ( quot width -- matrix ) [ { } make ] dip group ; inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/partial-continuations/partial-continuations.factor

@@ -7,16 +7,16 @@ USING: kernel continuations arrays sequences quotations ;
     [ 1array swap keep first continue-with ] callcc1 nip ;
 
 : (bshift) ( v r k -- obj )
-    >r dup first -rot r>
+    [ dup first -rot ] dip
     [
         rot set-first
         continue-with
     ] callcc1
-    >r drop nip set-first r> ;
+    [ drop nip set-first ] dip ;
 
 : bshift ( r quot -- )
     swap [ ! quot r k
-        over >r
+        over [
             [ (bshift) ] 2curry swap call
-        r> first continue-with
+        ] dip first continue-with
     ] callcc1 2nip ; inline

extra/random-weighted/random-weighted.factor

@@ -1,6 +1,6 @@
 
 USING: kernel namespaces arrays quotations sequences assocs combinators
-       mirrors math math.vectors random macros bake bake.fry ;
+       mirrors math math.vectors random macros fry ;
 
 IN: random-weighted
 
@@ -17,4 +17,4 @@ dup [ second ] map swap [ first ] map random-weighted swap nth ;
 
 MACRO: call-random-weighted ( exp -- )
   [ keys ] [ values <enum> >alist ] bi
-  '[ , random-weighted , case ] ;
+  '[ _ random-weighted _ case ] ;

extra/rewrite-closures/rewrite-closures.factor

@@ -1,6 +1,5 @@
 
-USING: kernel parser math quotations namespaces sequences macros
-bake bake.fry ;
+USING: kernel parser math quotations namespaces sequences macros fry ;
 
 IN: rewrite-closures
 
@@ -12,12 +11,12 @@ MACRO: set-parameters ( seq -- quot ) [set-parameters] ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: parametric-quot ( parameters quot -- quot ) '[ , set-parameters , call ] ;
+: parametric-quot ( parameters quot -- quot ) '[ _ set-parameters _ call ] ;
 
-: scoped-quot ( quot -- quot ) '[ , with-scope ] ;
+: scoped-quot ( quot -- quot ) '[ _ with-scope ] ;
 
 : closed-quot ( quot -- quot )
-  namestack swap '[ namestack [ , set-namestack @ ] dip set-namestack ] ;
+  namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/self/self.factor

@@ -7,6 +7,4 @@ VAR: self
 
 : with-self ( quot obj -- ) [ >self call ] with-scope ;
 
-: save-self ( quot -- ) self> >r self> clone >self call r> >self ;
-
-! : save-self ( quot -- ) [ self> clone >self call ] with-scope ;
+: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;

extra/trails/trails.factor

@@ -1,5 +1,5 @@
 
-USING: kernel accessors locals namespaces sequences sequences.lib threads
+USING: kernel accessors locals namespaces sequences threads
        math math.order math.vectors
        calendar
        colors opengl ui ui.gadgets ui.gestures ui.render
@@ -65,6 +65,16 @@ M: <trails-gadget> pref-dim* ( <trails-gadget> -- dim ) drop { 500 500 } ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: each-percent ( seq quot -- )
+  [
+    dup length
+    dup [ / ] curry
+    [ 1+ ] prepose
+  ] dip compose
+  2each ;                       inline
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 M:: <trails-gadget> draw-gadget* ( GADGET -- )
   origin get
   [

extra/wordtimer/wordtimer.factor

@@ -30,7 +30,7 @@ SYMBOL: *calling*
   *calling* get-global at ; inline
     
 : timed-call ( quot word -- )
-  [ calling ] [ >r benchmark r> register-time ] [ finished ] tri ; inline
+  [ calling ] [ [ benchmark ] dip register-time ] [ finished ] tri ; inline
 
 : time-unless-recursing ( quot word -- )
   dup called-recursively? not
@@ -71,9 +71,10 @@ SYMBOL: *calling*
 
 : wordtimer-call ( quot -- )
   reset-word-timer 
-  benchmark >r
+  benchmark [
       correct-for-timing-overhead
-  "total time:" write r> pprint nl
+      "total time:" write
+  ] dip pprint nl
   print-word-timings nl ;
 
 : profile-vocab ( vocab quot -- )
@@ -81,9 +82,10 @@ SYMBOL: *calling*
   over [ reset-vocab ] [ add-timers ] bi
   reset-word-timer
   "executing quotation..." print flush
-  benchmark >r
+  benchmark [
       "resetting annotations..." print flush
       reset-vocab
       correct-for-timing-overhead
-  "total time:" write r> pprint
+      "total time:" write
+  ] dip pprint
   print-word-timings ;

unmaintained/bake/bake.factor

@@ -1,7 +1,7 @@
 
 USING: kernel parser namespaces sequences quotations arrays vectors splitting
        strings words math generalizations
-       macros combinators.lib combinators.conditional newfx ;
+       macros combinators.conditional newfx ;
 
 IN: bake