From 058ba127cb36fde0592d13ccd54d25cc3fde5067 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Dec 2008 05:41:01 -0600
Subject: [PATCH] Cleaning up more -rot usages
---
basis/columns/columns.factor | 2 +-
basis/disjoint-sets/disjoint-sets.factor | 4 ++--
basis/inspector/inspector.factor | 6 +++---
basis/logging/logging.factor | 2 +-
basis/logging/server/server.factor | 17 ++++++++--------
basis/math/ratios/ratios.factor | 8 ++++----
basis/mirrors/mirrors.factor | 2 +-
basis/opengl/capabilities/capabilities.factor | 7 ++-----
basis/opengl/opengl.factor | 20 ++++++++++---------
basis/peg/parsers/parsers.factor | 3 +--
basis/peg/peg.factor | 2 +-
basis/sequences/deep/deep.factor | 10 +++++-----
basis/tools/deploy/macosx/macosx.factor | 2 +-
core/math/math.factor | 2 +-
core/words/words.factor | 2 +-
extra/bunny/model/model.factor | 2 +-
16 files changed, 45 insertions(+), 46 deletions(-)
diff --git a/basis/columns/columns.factor b/basis/columns/columns.factor
index 5ac8531f58..8f45dab872 100644
--- a/basis/columns/columns.factor
+++ b/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
diff --git a/basis/disjoint-sets/disjoint-sets.factor b/basis/disjoint-sets/disjoint-sets.factor
index ea246cfa28..a3e5c7ceb7 100644
--- a/basis/disjoint-sets/disjoint-sets.factor
+++ b/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 ]
- [ 1 -rot counts>> set-at ]
+ [ [ 0 ] 2dip ranks>> set-at ]
+ [ [ 1 ] 2dip counts>> set-at ]
2tri ;
: add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ;
diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor
index b47426f5bb..9c61d092e5 100644
--- a/basis/inspector/inspector.factor
+++ b/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. ;
diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor
index fb6b328990..6769932c88 100644
--- a/basis/logging/logging.factor
+++ b/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) ;
diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor
index 68f8d74571..618dba544c 100644
--- a/basis/logging/server/server.factor
+++ b/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 -- )
- rot harvest {
- { [ dup empty? ] [ 3drop ] }
- { [ dup length 1 = ] [ first -rot f (write-message) ] }
+: write-message ( msg word-name level -- )
+ [ harvest ] 2dip {
+ { [ pick empty? ] [ 3drop ] }
+ { [ pick length 1 = ] [ [ first ] 2dip f (write-message) ] }
[
- [ first -rot f (write-message) ] 3keep
- rest -rot [ t (write-message) ] 2curry each
+ [ [ first ] 2dip f (write-message) ]
+ [ [ 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 -- )
diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor
index 81294d29f7..15914e7b05 100644
--- a/basis/math/ratios/ratios.factor
+++ b/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 - 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 ;
diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor
index d3d6dbdb04..25486d127d 100644
--- a/basis/mirrors/mirrors.factor
+++ b/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 [
diff --git a/basis/opengl/capabilities/capabilities.factor b/basis/opengl/capabilities/capabilities.factor
index 3972fea7b3..09d49b33c2 100755
--- a/basis/opengl/capabilities/capabilities.factor
+++ b/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
- [ 2drop ]
- [ swap " " make throw ]
- if ; inline
+ [ dupd call [ drop ] ] dip '[ _ " " make throw ] if ; inline
: gl-extensions ( -- seq )
GL_EXTENSIONS glGetString " " split ;
diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor
index 10f9c57a83..f5868ee7a1 100644
--- a/basis/opengl/opengl.factor
+++ b/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 -- )
- -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
diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor
index 7434ca6a7a..a9fb366812 100644
--- a/basis/peg/parsers/parsers.factor
+++ b/basis/peg/parsers/parsers.factor
@@ -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' )
diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor
index 3fc6fec8ed..206a054d35 100644
--- a/basis/peg/peg.factor
+++ b/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
diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor
index 244040d60a..d942b3f4c4 100644
--- a/basis/sequences/deep/deep.factor
+++ b/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 )
diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor
index 1dcc6fe4c1..91b4d603af 100644
--- a/basis/tools/deploy/macosx/macosx.factor
+++ b/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 )
diff --git a/core/math/math.factor b/core/math/math.factor
index 7c9be868b3..412fd325cc 100755
--- a/core/math/math.factor
+++ b/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
diff --git a/core/words/words.factor b/core/words/words.factor
index c75711ea39..6a3b63ab8a 100644
--- a/core/words/words.factor
+++ b/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 ;
diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor
index 255e6eb343..0009e39fa7 100755
--- a/extra/bunny/model/model.factor
+++ b/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 ;