Merge branch 'master' into new_ui

basis/columns/columns.factor

@@ -9,7 +9,7 @@ TUPLE: column seq col ;
 C: <column> column
 
 M: column virtual-seq seq>> ;
-M: column virtual@ dup col>> -rot seq>> nth bounds-check ;
+M: column virtual@ [ col>> swap ] [ seq>> ] bi nth bounds-check ;
 M: column length seq>> length ;
 
 INSTANCE: column virtual-sequence

basis/disjoint-sets/disjoint-sets.factor

@@ -60,8 +60,8 @@ GENERIC: add-atom ( a disjoint-set -- )
 
 M: disjoint-set add-atom
     [ dupd parents>> set-at ]
-    [ 0 -rot ranks>> set-at ]
+    [ [ 0 ] 2dip ranks>> set-at ]
-    [ 1 -rot counts>> set-at ]
+    [ [ 1 ] 2dip counts>> set-at ]
     2tri ;
 
 : add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ;

basis/inspector/inspector.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays generic hashtables io kernel assocs math
 namespaces prettyprint sequences strings io.styles vectors words
 quotations mirrors splitting math.parser classes vocabs refs
-sets sorting summary debugger continuations ;
+sets sorting summary debugger continuations fry ;
 IN: inspector
 
 : value-editor ( path -- )
@@ -53,7 +53,7 @@ SYMBOL: +editable+
     [ drop ] [
         dup enum? [ +sequence+ on ] when
         standard-table-style [
-            swap [ -rot describe-row ] curry each-index
+            swap '[ [ _ ] 2dip describe-row ] each-index
         ] tabular-output
     ] if-empty ;
 
@@ -64,7 +64,7 @@ M: tuple error. describe ;
 
 : namestack. ( seq -- )
     [ [ global eq? not ] filter [ keys ] gather ] keep
-    [ dupd assoc-stack ] curry H{ } map>assoc describe ;
+    '[ dup _ assoc-stack ] H{ } map>assoc describe ;
 
 : .vars ( -- )
     namestack namestack. ;

basis/logging/logging.factor

@@ -61,7 +61,7 @@ PRIVATE>
     [ dup ] 2dip 2curry annotate ;
 
 : call-logging-quot ( quot word level -- quot' )
-    "called" -rot [ log-message ] 3curry prepose ;
+    [ "called" ] 2dip [ log-message ] 3curry prepose ;
 
 : add-logging ( word level -- )
     [ call-logging-quot ] (define-logging) ;

basis/logging/server/server.factor

@@ -28,7 +28,7 @@ SYMBOL: log-files
 
 : multiline-header ( -- string ) 20 CHAR: - <string> ; foldable
 
-: (write-message) ( msg name>> level multi? -- )
+: (write-message) ( msg word-name level multi? -- )
     [
         "[" write multiline-header write "] " write
     ] [
@@ -36,18 +36,19 @@ SYMBOL: log-files
     ] if
     write bl write ": " write print ;
 
-: write-message ( msg name>> level -- )
+: write-message ( msg word-name level -- )
-    rot harvest {
+    [ harvest ] 2dip {
-        { [ dup empty? ] [ 3drop ] }
+        { [ pick empty? ] [ 3drop ] }
-        { [ dup length 1 = ] [ first -rot f (write-message) ] }
+        { [ pick length 1 = ] [ [ first ] 2dip f (write-message) ] }
         [
-            [ first -rot f (write-message) ] 3keep
+            [ [ first ] 2dip f (write-message) ]
-            rest -rot [ t (write-message) ] 2curry each
+            [ [ rest ] 2dip [ t (write-message) ] 2curry each ]
+            3bi
         ]
     } cond ;
 
 : (log-message) ( msg -- )
-    #! msg: { msg name>> level service }
+    #! msg: { msg word-name level service }
     first4 log-stream [ write-message flush ] with-output-stream* ;
 
 : try-dispose ( stream -- )

basis/math/ratios/ratios.factor

@@ -50,11 +50,11 @@ M: ratio <= scale <= ;
 M: ratio > scale > ;
 M: ratio >= scale >= ;
 
-M: ratio + 2dup scale + -rot ratio+d / ;
+M: ratio + [ scale + ] [ ratio+d ] 2bi / ;
-M: ratio - 2dup scale - -rot ratio+d / ;
+M: ratio - [ scale - ] [ ratio+d ] 2bi / ;
-M: ratio * 2>fraction * [ * ] dip / ;
+M: ratio * 2>fraction [ * ] 2bi@ / ;
 M: ratio / scale / ;
 M: ratio /i scale /i ;
 M: ratio /f scale /f ;
-M: ratio mod [ /i ] 2keep rot * - ;
+M: ratio mod 2dup /i * - ;
 M: ratio /mod [ /i ] 2keep mod ;

basis/mirrors/mirrors.factor

@@ -32,7 +32,7 @@ M: mirror set-at ( val key mirror -- )
     swap set-slot ;
 
 M: mirror delete-at ( key mirror -- )
-    f -rot set-at ;
+    [ f ] 2dip set-at ;
 
 M: mirror clear-assoc ( mirror -- )
     [ object>> ] [ object-slots ] bi [

basis/opengl/capabilities/capabilities.factor

@@ -1,14 +1,11 @@
 ! Copyright (C) 2008 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces make sequences splitting opengl.gl
-continuations math.parser math arrays sets math.order ;
+continuations math.parser math arrays sets math.order fry ;
 IN: opengl.capabilities
 
 : (require-gl) ( thing require-quot make-error-quot -- )
-    -rot dupd call
+    [ dupd call [ drop ] ] dip '[ _ " " make throw ] if ; inline
-    [ 2drop ]
-    [ swap " " make throw ]
-    if ; inline
 
 : gl-extensions ( -- seq )
     GL_EXTENSIONS glGetString " " split ;

basis/opengl/opengl.factor

@@ -6,7 +6,7 @@ USING: alien alien.c-types continuations kernel libc math macros
 namespaces math.vectors math.constants math.functions
 math.parser opengl.gl opengl.glu combinators arrays sequences
 splitting words byte-arrays assocs colors accessors
-generalizations locals specialized-arrays.float
+generalizations locals fry specialized-arrays.float
 specialized-arrays.uint ;
 IN: opengl
 
@@ -154,19 +154,21 @@ MACRO: all-enabled-client-state ( seq quot -- )
 : delete-gl-buffer ( id -- )
     [ glDeleteBuffers ] (delete-gl-object) ;
 
-: with-gl-buffer ( binding id quot -- )
+:: with-gl-buffer ( binding id quot -- )
-    -rot dupd glBindBuffer
+    binding id glBindBuffer
-    [ slip ] [ 0 glBindBuffer ] [ ] cleanup ; inline
+    quot [ binding 0 glBindBuffer ] [ ] cleanup ; inline
 
 : with-array-element-buffers ( array-buffer element-buffer quot -- )
-    -rot GL_ELEMENT_ARRAY_BUFFER swap [
+    [ GL_ELEMENT_ARRAY_BUFFER ] 2dip '[
-        swap GL_ARRAY_BUFFER -rot with-gl-buffer
+        GL_ARRAY_BUFFER swap _ with-gl-buffer
     ] with-gl-buffer ; inline
 
 : <gl-buffer> ( target data hint -- id )
-    pick gen-gl-buffer [ [
+    pick gen-gl-buffer [
-        [ dup byte-length swap ] dip glBufferData
+        [
-    ] with-gl-buffer ] keep ;
+            [ [ byte-length ] keep ] dip glBufferData
+        ] with-gl-buffer
+    ] keep ;
 
 : buffer-offset ( int -- alien )
     <alien> ; inline

basis/peg/parsers/parsers.factor

@@ -51,8 +51,7 @@ PRIVATE>
   dup zero? [
     2drop epsilon
   ] [
-    2dup exactly-n
+    [ exactly-n ] [ 1- at-most-n ] 2bi 2choice
-    -rot 1- at-most-n 2choice
   ] if ;
 
 : at-least-n ( parser n -- parser' )

basis/peg/peg.factor

@@ -373,7 +373,7 @@ TUPLE: range-parser min max ;
   pick empty? [ 
     3drop f 
   ] [
-    pick first -rot between? [
+    [ dup first ] 2dip between? [
       unclip-slice <parse-result>
     ] [ 
       drop f

basis/sequences/deep/deep.factor

@@ -14,11 +14,11 @@ M: object branch? drop f ;
 
 : deep-each ( obj quot: ( elt -- ) -- )
     [ call ] 2keep over branch?
-    [ [ deep-each ] curry each ] [ 2drop ] if ; inline recursive
+    [ '[ _ deep-each ] each ] [ 2drop ] if ; inline recursive
 
 : deep-map ( obj quot: ( elt -- elt' ) -- newobj )
     [ call ] keep over branch?
-    [ [ deep-map ] curry map ] [ drop ] if ; inline recursive
+    [ '[ _ deep-map ] map ] [ drop ] if ; inline recursive
 
 : deep-filter ( obj quot: ( elt -- ? ) -- seq )
     over [ pusher [ deep-each ] dip ] dip
@@ -27,7 +27,7 @@ M: object branch? drop f ;
 : (deep-find) ( obj quot: ( elt -- ? ) -- elt ? )
     [ call ] 2keep rot [ drop t ] [
         over branch? [
-            f -rot [ [ nip ] dip (deep-find) ] curry find drop >boolean
+            [ f ] 2dip '[ nip _ (deep-find) ] find drop >boolean
         ] [ 2drop f f ] if  
     ] if ; inline recursive
 
@@ -36,7 +36,7 @@ M: object branch? drop f ;
 : deep-contains? ( obj quot -- ? ) (deep-find) nip ; inline
 
 : deep-all? ( obj quot -- ? )
-    [ not ] compose deep-contains? not ; inline
+    '[ @ not ] deep-contains? not ; inline
 
 : deep-member? ( obj seq -- ? )
     swap '[
@@ -50,7 +50,7 @@ M: object branch? drop f ;
 
 : deep-change-each ( obj quot: ( elt -- elt' ) -- )
     over branch? [
-        [ [ call ] keep over [ deep-change-each ] dip ] curry change-each
+        '[ _ [ call ] keep over [ deep-change-each ] dip ] change-each
     ] [ 2drop ] if ; inline recursive
 
 : flatten ( obj -- seq )

basis/tools/deploy/macosx/macosx.factor

@@ -13,7 +13,7 @@ IN: tools.deploy.macosx
     vm parent-directory parent-directory ;
 
 : copy-bundle-dir ( bundle-name dir -- )
-    bundle-dir over append-path -rot
+    [ bundle-dir prepend-path swap ] keep
     "Contents" prepend-path append-path copy-tree ;
 
 : app-plist ( executable bundle-name -- assoc )

core/math/math.factor

@@ -114,7 +114,7 @@ M: float fp-infinity? ( float -- ? )
 
 <PRIVATE
 
-: iterate-prep ( n quot -- i n quot ) 0 -rot ; inline
+: iterate-prep ( n quot -- i n quot ) [ 0 ] 2dip ; inline
 
 : if-iterate? ( i n true false -- ) [ 2over < ] 2dip if ; inline
 

core/words/words.factor

@@ -54,7 +54,7 @@ M: primitive definition drop f ;
 SYMBOL: bootstrapping?
 
 : if-bootstrapping ( true false -- )
-    bootstrapping? get -rot if ; inline
+    [ bootstrapping? get ] 2dip if ; inline
 
 : bootstrap-word ( word -- target )
     [ target-word ] [ ] if-bootstrapping ;

extra/bunny/model/model.factor

@@ -30,7 +30,7 @@ IN: bunny.model
     [ n ] keep [ rot [ v+ ] change-nth ] with with each ;
 
 : normals ( vs is -- ns )
-    over length { 0.0 0.0 0.0 } <array> -rot
+    [ [ length { 0.0 0.0 0.0 } <array> ] keep ] dip
     [ [ 2dup ] dip normal ] each drop
     [ normalize ] map ;