]> gitweb.factorcode.org Git - factor.git/commitdiff
Update more vocabs for >r/r> removal
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 18 Dec 2008 05:36:13 +0000 (23:36 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 18 Dec 2008 05:36:13 +0000 (23:36 -0600)
extra/cairo-demo/cairo-demo.factor
extra/faq/faq.factor
extra/icfp/2006/2006.factor
extra/multi-methods/multi-methods.factor
extra/opengl/gadgets/gadgets.factor
extra/sequences/merged/merged.factor
extra/taxes/usa/fica/fica.factor
extra/vars/vars.factor

index ea92e798a7689b98c2eeea0b96b901798b731148..cec6702ce06238959f60514e0b65d68227a8a988 100644 (file)
@@ -25,7 +25,7 @@ TUPLE: cairo-demo-gadget < gadget image-array cairo-t ;
 M: cairo-demo-gadget draw-gadget* ( gadget -- )
     0 0 glRasterPos2i
     1.0 -1.0 glPixelZoom
-    >r 384 256 GL_RGBA GL_UNSIGNED_BYTE r>
+    [ 384 256 GL_RGBA GL_UNSIGNED_BYTE ] dip
     image-array>> glDrawPixels ;
 
 : create-surface ( gadget -- cairo_surface_t )
index c0636c5fd7b118909d38cdcb1f546223cc6e24b9..512817bc4d54216e636f1c4a50642b2003c70d9a 100644 (file)
@@ -6,7 +6,7 @@ make math.parser io accessors ;
 IN: faq
 
 : find-after ( seq quot -- elem after )
-    over >r find r> rot 1+ tail ; inline
+    over [ find ] dip rot 1+ tail ; inline
 
 : tag-named*? ( tag name -- ? )
     assure-name swap tag-named? ;
@@ -18,7 +18,7 @@ C: <q/a> q/a
 : li>q/a ( li -- q/a )
     [ "br" tag-named*? not ] filter
     [ "strong" tag-named*? ] find-after
-    >r children>> r> <q/a> ;
+    [ children>> ] dip <q/a> ;
 
 : q/a>li ( q/a -- li )
     [ question>> "strong" build-tag* f "br" build-tag* 2array ] keep
@@ -48,7 +48,7 @@ C: <question-list> question-list
     title>> [ "title" pick set-at ] when* ;
 
 : html>question-list ( h3 ol -- question-list )
-    >r [ children>string ] [ f ] if* r>
+    [ [ children>string ] [ f ] if* ] dip
     children-tags [ li>q/a ] map <question-list> ;
 
 : question-list>h3 ( id question-list -- h3 )
@@ -58,8 +58,7 @@ C: <question-list> question-list
     ] [ drop f ] if* ;
 
 : question-list>html ( question-list start id -- h3/f ol )
-    -rot >r [ question-list>h3 ] keep
-    seq>> [ q/a>li ] map "ol" build-tag* r>
+    -rot [ [ question-list>h3 ] keep seq>> [ q/a>li ] map "ol" build-tag* ] dip
     number>string "start" pick set-at
     "margin-left: 5em" "style" pick set-at ;
 
@@ -69,7 +68,7 @@ C: <faq> faq
 
 : html>faq ( div -- faq )
     unclip swap { "h3" "ol" } [ tags-named ] with map
-    first2 >r f prefix r> [ html>question-list ] 2map <faq> ;
+    first2 [ f prefix ] dip [ html>question-list ] 2map <faq> ;
 
 : header, ( faq -- )
     dup header>> ,
index d12d35a6d2eef41e3556d246489865ff020a7486..819154f509f288d3326f546a4db86889618f3d95 100755 (executable)
@@ -46,19 +46,19 @@ SYMBOL: open-arrays
     get-cba rot reg-val zero? [
         2drop
     ] [
-        >r reg-val r> set-reg
+        [ reg-val ] dip set-reg
     ] if f ;
 
 : binary-op ( quot -- ? )
-    >r get-cba r>
-    swap >r >r [ reg-val ] bi@ swap r> call r>
+    [ get-cba ] dip
+    swap [ [ [ reg-val ] bi@ swap ] dip call ] dip
     set-reg f ; inline
 
 : op1 ( opcode -- ? )
     [ swap arr-val ] binary-op ;
 
 : op2 ( opcode -- ? )
-    get-cba >r [ reg-val ] bi@ r> reg-val set-arr f ;
+    get-cba [ [ reg-val ] bi@ ] dip reg-val set-arr f ;
 
 : op3 ( opcode -- ? )
     [ + >32bit ] binary-op ;
@@ -73,18 +73,18 @@ SYMBOL: open-arrays
     [ bitand HEX: ffffffff swap - ] binary-op ;
 
 : new-array ( size location -- )
-    >r 0 <array> r> arrays get set-nth ;
+    [ 0 <array> ] dip arrays get set-nth ;
 
 : ?grow-storage ( -- )
     open-arrays get dup empty? [
-        >r arrays get length r> push
+        [ arrays get length ] dip push
     ] [
         drop
     ] if ;
 
 : op8 ( opcode -- ? )
     ?grow-storage
-    get-cb >r reg-val open-arrays get pop [ new-array ] keep r>
+    get-cb [ reg-val open-arrays get pop [ new-array ] keep ] dip
     set-reg f ;
 
 : op9 ( opcode -- ? )
index 49532665f18ce3f91b55b40cb422e62014b954c8..5ad1d944d37276fc770c4e3048ffd15359e7b1e8 100755 (executable)
@@ -31,32 +31,33 @@ SYMBOL: total
 
 : canonicalize-specializer-2 ( specializer -- specializer' )
     [
-        >r
-        {
-            { [ dup integer? ] [ ] }
-            { [ dup word? ] [ hooks get index ] }
-        } cond args get + r>
+        [
+            {
+                { [ dup integer? ] [ ] }
+                { [ dup word? ] [ hooks get index ] }
+            } cond args get +
+        ] dip
     ] assoc-map ;
 
 : canonicalize-specializer-3 ( specializer -- specializer' )
-    >r total get object <array> dup <enum> r> update ;
+    [ total get object <array> dup <enum> ] dip update ;
 
 : canonicalize-specializers ( methods -- methods' hooks )
     [
-        [ >r canonicalize-specializer-0 r> ] assoc-map
+        [ [ canonicalize-specializer-0 ] dip ] assoc-map
 
         0 args set
         V{ } clone hooks set
 
-        [ >r canonicalize-specializer-1 r> ] assoc-map
+        [ [ canonicalize-specializer-1 ] dip ] assoc-map
 
         hooks [ natural-sort ] change
 
-        [ >r canonicalize-specializer-2 r> ] assoc-map
+        [ [ canonicalize-specializer-2 ] dip ] assoc-map
 
         args get hooks get length + total set
 
-        [ >r canonicalize-specializer-3 r> ] assoc-map
+        [ [ canonicalize-specializer-3 ] dip ] assoc-map
 
         hooks get
     ] with-scope ;
@@ -79,8 +80,8 @@ SYMBOL: total
     inline
 
 : topological-sort ( seq quot -- newseq )
-    >r >vector [ dup empty? not ] r>
-    [ dupd maximal-element >r over delete-nth r> ] curry
+    [ >vector [ dup empty? not ] ] dip
+    [ dupd maximal-element [ over delete-nth ] dip ] curry
     [ ] produce nip ; inline
 
 : classes< ( seq1 seq2 -- lt/eq/gt )
@@ -103,7 +104,7 @@ SYMBOL: total
         { 0 [ [ dup ] ] }
         { 1 [ [ over ] ] }
         { 2 [ [ pick ] ] }
-        [ 1- picker [ >r ] [ r> swap ] surround ]
+        [ 1- picker [ dip swap ] curry ]
     } case ;
 
 : (multi-predicate) ( class picker -- quot )
@@ -124,11 +125,11 @@ SYMBOL: total
 ERROR: no-method arguments generic ;
 
 : make-default-method ( methods generic -- quot )
-    >r argument-count r> [ >r narray r> no-method ] 2curry ;
+    [ argument-count ] dip [ [ narray ] dip no-method ] 2curry ;
 
 : multi-dispatch-quot ( methods generic -- quot )
     [ make-default-method ]
-    [ drop [ >r multi-predicate r> ] assoc-map reverse ]
+    [ drop [ [ multi-predicate ] dip ] assoc-map reverse ]
     2bi alist>quot ;
 
 ! Generic words
@@ -172,8 +173,9 @@ M: method-body crossref?
     swap >>props ;
 
 : with-methods ( word quot -- )
-    over >r >r "multi-methods" word-prop
-    r> call r> update-generic ; inline
+    over [
+        [ "multi-methods" word-prop ] dip call
+    ] dip update-generic ; inline
 
 : reveal-method ( method classes generic -- )
     [ set-at ] with-methods ;
@@ -252,7 +254,7 @@ syntax:M: generic definer drop \ GENERIC: f ;
 syntax:M: generic definition drop f ;
 
 PREDICATE: method-spec < array
-    unclip generic? >r [ class? ] all? r> and ;
+    unclip generic? [ [ class? ] all? ] dip and ;
 
 syntax:M: method-spec where
     dup unclip method [ ] [ first ] ?if where ;
index d028ea958cfd40fb90081611e58a82c6b97808a0..b24783e4ef68e2537f30e3ac709c2a50e51a2267 100644 (file)
@@ -23,8 +23,7 @@ textures init-cache
 refcounts init-cache
 
 : refcount-change ( gadget quot -- )
-    >r cache-key* refcounts get
-    [ [ 0 ] unless* ] r> compose change-at ;
+    [ cache-key* refcounts get [ [ 0 ] unless* ] ] dip compose change-at ;
 
 TUPLE: cache-entry tex dims ;
 C: <entry> cache-entry
@@ -86,7 +85,7 @@ M: texture-gadget ungraft* ( gadget -- )
     gen-texture [ (render-bytes) ] keep ;
 
 : render-bytes* ( dims bytes format -- texture dims )
-    pick >r render-bytes r> ;
+    pick [ render-bytes ] dip ;
 
 :: four-corners ( dim -- )
     [let* | w [ dim first ]
index 829555cfb12be571a25011d19eca63996c24b311..d64da6efe6ce6f5b1fd25ac982aff5e07dd4b2b3 100644 (file)
@@ -16,7 +16,7 @@ C: <merged> merged
     dupd <2merged> swap like ;
 
 : 3merge ( seq1 seq2 seq3 -- seq )
-    pick >r <3merged> r> like ;
+    pick [ <3merged> ] dip like ;
 
 M: merged length seqs>> [ length ] map sum ;
 
index c1e85b75b4e1ee1f963d02608135bb8b86cc49db..251f60e6d7ddedab514ee9815b1da9cc37f6cecd 100644 (file)
@@ -1,17 +1,17 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs.lib math math.order money ;
+USING: accessors math math.order money kernel assocs ;
 IN: taxes.usa.fica
 
 : fica-tax-rate ( -- x ) DECIMAL: .062 ; inline
 
-ERROR: fica-base-unknown year ;
+ERROR: fica-base-unknown ;
 
 : fica-base-rate ( year -- x )
     H{
         { 2008 102000 }
         { 2007  97500 }
-    } [ fica-base-unknown ] unless-at ;
+    } at [ fica-base-unknown ] unless* ;
 
 : fica-tax ( salary w4 -- x )
     year>> fica-base-rate min fica-tax-rate * ;
index 7316cd6a6db468474311a854bcf82a73817bdeac..c12367ba5ea35a82952aea6e68f9e3173d5c25b7 100644 (file)
@@ -2,7 +2,8 @@
 
 ! Thanks to Mackenzie Straight for the idea
 
-USING: accessors kernel parser lexer words namespaces sequences quotations ;
+USING: accessors kernel parser lexer words words.symbol
+namespaces sequences quotations ;
 
 IN: vars