From 3d1c46417aceebe5bb8638c1db142efb5d92e860 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 17 Dec 2008 23:36:13 -0600 Subject: [PATCH] Update more vocabs for >r/r> removal --- extra/cairo-demo/cairo-demo.factor | 2 +- extra/faq/faq.factor | 11 ++++--- extra/icfp/2006/2006.factor | 14 ++++----- extra/multi-methods/multi-methods.factor | 38 +++++++++++++----------- extra/opengl/gadgets/gadgets.factor | 5 ++-- extra/sequences/merged/merged.factor | 2 +- extra/taxes/usa/fica/fica.factor | 6 ++-- extra/vars/vars.factor | 3 +- 8 files changed, 41 insertions(+), 40 deletions(-) diff --git a/extra/cairo-demo/cairo-demo.factor b/extra/cairo-demo/cairo-demo.factor index ea92e798a7..cec6702ce0 100644 --- a/extra/cairo-demo/cairo-demo.factor +++ b/extra/cairo-demo/cairo-demo.factor @@ -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 ) diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index c0636c5fd7..512817bc4d 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -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 : li>q/a ( li -- q/a ) [ "br" tag-named*? not ] filter [ "strong" tag-named*? ] find-after - >r children>> r> ; + [ children>> ] dip ; : q/a>li ( q/a -- li ) [ question>> "strong" build-tag* f "br" build-tag* 2array ] keep @@ -48,7 +48,7 @@ C: 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>h3 ( id question-list -- h3 ) @@ -58,8 +58,7 @@ C: 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 : html>faq ( div -- faq ) unclip swap { "h3" "ol" } [ tags-named ] with map - first2 >r f prefix r> [ html>question-list ] 2map ; + first2 [ f prefix ] dip [ html>question-list ] 2map ; : header, ( faq -- ) dup header>> , diff --git a/extra/icfp/2006/2006.factor b/extra/icfp/2006/2006.factor index d12d35a6d2..819154f509 100755 --- a/extra/icfp/2006/2006.factor +++ b/extra/icfp/2006/2006.factor @@ -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 r> arrays get set-nth ; + [ 0 ] 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 -- ? ) diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 49532665f1..5ad1d944d3 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -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 dup r> update ; + [ total get object dup ] 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 ; diff --git a/extra/opengl/gadgets/gadgets.factor b/extra/opengl/gadgets/gadgets.factor index d028ea958c..b24783e4ef 100644 --- a/extra/opengl/gadgets/gadgets.factor +++ b/extra/opengl/gadgets/gadgets.factor @@ -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: 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 ] diff --git a/extra/sequences/merged/merged.factor b/extra/sequences/merged/merged.factor index 829555cfb1..d64da6efe6 100644 --- a/extra/sequences/merged/merged.factor +++ b/extra/sequences/merged/merged.factor @@ -16,7 +16,7 @@ C: 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 ; diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor index c1e85b75b4..251f60e6d7 100644 --- a/extra/taxes/usa/fica/fica.factor +++ b/extra/taxes/usa/fica/fica.factor @@ -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 * ; diff --git a/extra/vars/vars.factor b/extra/vars/vars.factor index 7316cd6a6d..c12367ba5e 100644 --- a/extra/vars/vars.factor +++ b/extra/vars/vars.factor @@ -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