]> gitweb.factorcode.org Git - factor.git/commitdiff
Cleaning up more -rot usages
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 22 Dec 2008 11:41:01 +0000 (05:41 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 22 Dec 2008 11:41:01 +0000 (05:41 -0600)
16 files changed:
basis/columns/columns.factor
basis/disjoint-sets/disjoint-sets.factor
basis/inspector/inspector.factor
basis/logging/logging.factor
basis/logging/server/server.factor
basis/math/ratios/ratios.factor
basis/mirrors/mirrors.factor
basis/opengl/capabilities/capabilities.factor
basis/opengl/opengl.factor
basis/peg/parsers/parsers.factor
basis/peg/peg.factor
basis/sequences/deep/deep.factor
basis/tools/deploy/macosx/macosx.factor
core/math/math.factor
core/words/words.factor
extra/bunny/model/model.factor

index 5ac8531f586c7ff05377c79b5092c85a93175d83..8f45dab8728c4e7ef153f94692dea47d0b2c36a1 100644 (file)
@@ -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
index ea246cfa28e73859e7062f7725b6dcabbf72f9b4..a3e5c7ceb7bce396bcf55635302a92fcf42a57ff 100644 (file)
@@ -60,8 +60,8 @@ GENERIC: add-atom ( a disjoint-set -- )
 
 M: disjoint-set add-atom
     [ dupd parents>> set-at ]
-    [ 0 -rot ranks>> set-at ]
-    [ 1 -rot counts>> set-at ]
+    [ [ 0 ] 2dip ranks>> set-at ]
+    [ [ 1 ] 2dip counts>> set-at ]
     2tri ;
 
 : add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ;
index b47426f5bbd9ce140f69239f649baece62fde7ce..9c61d092e5622ea66f1bec001fe9620006d2ec52 100644 (file)
@@ -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. ;
index fb6b32899078dfc67d8736bf516a1c3859241390..6769932c886ab54b2a65690115fea9bb1c45bc94 100644 (file)
@@ -61,7 +61,7 @@ PRIVATE>
     [ dup ] 2dip 2curry annotate ;\r
 \r
 : call-logging-quot ( quot word level -- quot' )\r
-    "called" -rot [ log-message ] 3curry prepose ;\r
+    [ "called" ] 2dip [ log-message ] 3curry prepose ;\r
 \r
 : add-logging ( word level -- )\r
     [ call-logging-quot ] (define-logging) ;\r
index 68f8d74571eb9d016e5133db6baa737a29957c66..618dba544cb8637e7d7e92b367735803350600b7 100644 (file)
@@ -28,7 +28,7 @@ SYMBOL: log-files
 \r
 : multiline-header ( -- string ) 20 CHAR: - <string> ; foldable\r
 \r
-: (write-message) ( msg name>> level multi? -- )\r
+: (write-message) ( msg word-name level multi? -- )\r
     [\r
         "[" write multiline-header write "] " write\r
     ] [\r
@@ -36,18 +36,19 @@ SYMBOL: log-files
     ] if\r
     write bl write ": " write print ;\r
 \r
-: write-message ( msg name>> level -- )\r
-    rot harvest {\r
-        { [ dup empty? ] [ 3drop ] }\r
-        { [ dup length 1 = ] [ first -rot f (write-message) ] }\r
+: write-message ( msg word-name level -- )\r
+    [ harvest ] 2dip {\r
+        { [ pick empty? ] [ 3drop ] }\r
+        { [ pick length 1 = ] [ [ first ] 2dip f (write-message) ] }\r
         [\r
-            [ first -rot f (write-message) ] 3keep\r
-            rest -rot [ t (write-message) ] 2curry each\r
+            [ [ first ] 2dip f (write-message) ]\r
+            [ [ rest ] 2dip [ t (write-message) ] 2curry each ]\r
+            3bi\r
         ]\r
     } cond ;\r
 \r
 : (log-message) ( msg -- )\r
-    #! msg: { msg name>> level service }\r
+    #! msg: { msg word-name level service }\r
     first4 log-stream [ write-message flush ] with-output-stream* ;\r
 \r
 : try-dispose ( stream -- )\r
index 81294d29f74cb6c942bd8b4a8fd110ebf7d4d4f6..15914e7b05d4d9d91d5138dcf8ef644c29e01927 100644 (file)
@@ -50,11 +50,11 @@ M: ratio <= scale <= ;
 M: ratio > scale > ;
 M: ratio >= scale >= ;
 
-M: ratio + 2dup scale + -rot ratio+d / ;
-M: ratio - 2dup scale - -rot ratio+d / ;
-M: ratio * 2>fraction * [ * ] dip / ;
+M: ratio + [ scale + ] [ ratio+d ] 2bi / ;
+M: ratio - [ scale - ] [ ratio+d ] 2bi / ;
+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 ;
index d3d6dbdb04259aa32577c60cf23b4af5615c3cc8..25486d127deb83c5bfc1ebd8b6e6d53ee545a139 100644 (file)
@@ -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 [
index 3972fea7b34487278825858afda8a55a35817a33..09d49b33c284645939a952a03696b9acb8babb60 100755 (executable)
@@ -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
-    [ 2drop ]
-    [ swap " " make throw ]
-    if ; inline
+    [ dupd call [ drop ] ] dip '[ _ " " make throw ] if ; inline
 
 : gl-extensions ( -- seq )
     GL_EXTENSIONS glGetString " " split ;
index 10f9c57a838129b54e34012f34b452a35f6b36fb..f5868ee7a13ee0732ece4bfd9103cc16fe83b198 100644 (file)
@@ -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 -- )
-    -rot dupd glBindBuffer
-    [ slip ] [ 0 glBindBuffer ] [ ] cleanup ; inline
+:: with-gl-buffer ( binding id quot -- )
+    binding id glBindBuffer
+    quot [ binding 0 glBindBuffer ] [ ] cleanup ; inline
 
 : with-array-element-buffers ( array-buffer element-buffer quot -- )
-    -rot GL_ELEMENT_ARRAY_BUFFER swap [
-        swap GL_ARRAY_BUFFER -rot with-gl-buffer
+    [ GL_ELEMENT_ARRAY_BUFFER ] 2dip '[
+        GL_ARRAY_BUFFER swap _ with-gl-buffer
     ] with-gl-buffer ; inline
 
 : <gl-buffer> ( target data hint -- id )
-    pick gen-gl-buffer [ [
-        [ dup byte-length swap ] dip glBufferData
-    ] with-gl-buffer ] keep ;
+    pick gen-gl-buffer [
+        [
+            [ [ byte-length ] keep ] dip glBufferData
+        ] with-gl-buffer
+    ] keep ;
 
 : buffer-offset ( int -- alien )
     <alien> ; inline
index 7434ca6a7a21873c4bd13ee01736edb2108ce0a2..a9fb3668121afc7f28a8f4df732bb2486667a26b 100644 (file)
@@ -51,8 +51,7 @@ PRIVATE>
   dup zero? [
     2drop epsilon
   ] [
-    2dup exactly-n
-    -rot 1- at-most-n 2choice
+    [ exactly-n ] [ 1- at-most-n ] 2bi 2choice
   ] if ;
 
 : at-least-n ( parser n -- parser' )
index 3fc6fec8edc060d75b6647d239ed635f64368bf5..206a054d3540389ea963e5be58f51cd02439820a 100644 (file)
@@ -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
index 244040d60ac316a7e523ab411ed3b18ab9b7dfeb..d942b3f4c4e66d6f76811b6d008cab6ad1400a76 100644 (file)
@@ -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 )
index 1dcc6fe4c18b45a6177397cb9ed01e0ebedf22ca..91b4d603af9fcc85c93ee817b99d30963a254474 100644 (file)
@@ -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 )
index 7c9be868b3f7443205a5518e4a25f75e24b737c2..412fd325cc71f28dd447a32d4fcfa06f7cae4e92 100755 (executable)
@@ -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
 
index c75711ea39c4e6217ac55776cc16547fa9803b91..6a3b63ab8ab9d83a92e2126f021bb88d4276533f 100644 (file)
@@ -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 ;
index 255e6eb343ffa845b42aba924e28522c7a76fb5c..0009e39fa7a4460b5538edb2e0dee9332ebb493b 100755 (executable)
@@ -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 ;