Update remaining >r/r> usages
Slava Pestov
parent
bf7bde1bd4
commit
aa67844a23
|
|
@ -83,7 +83,7 @@ DEFER: collision-theta
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: theta-dd-small? ( par limit -- par ? ) >r dup theta-dd>> abs r> < ;
|
||||
: theta-dd-small? ( par limit -- par ? ) [ dup theta-dd>> abs ] dip < ;
|
||||
|
||||
: random-theta-dd ( par a b -- par ) 2random >>theta-dd ;
|
||||
|
||||
|
|
@ -149,8 +149,8 @@ METHOD: collide ( <axion> -- )
|
|||
: axion-white ( dy -- dy ) dup 1 swap dy>alpha gray boa \ stroke-color set ;
|
||||
: axion-black ( dy -- dy ) dup 0 swap dy>alpha gray boa \ stroke-color set ;
|
||||
|
||||
: axion-point- ( particle dy -- particle ) >r dup pos>> r> v-y point ;
|
||||
: axion-point+ ( particle dy -- particle ) >r dup pos>> r> v+y point ;
|
||||
: axion-point- ( particle dy -- particle ) [ dup pos>> ] dip v-y point ;
|
||||
: axion-point+ ( particle dy -- particle ) [ dup pos>> ] dip v+y point ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ M: descriptive-error summary
|
|||
|
||||
<PRIVATE
|
||||
: rethrower ( word inputs -- quot )
|
||||
[ length ] keep [ >r narray r> swap 2array flip ] 2curry
|
||||
[ length ] keep [ [ narray ] dip swap 2array flip ] 2curry
|
||||
[ 2 ndip descriptive-error ] 2curry ;
|
||||
|
||||
: [descriptive] ( word def -- newdef )
|
||||
|
|
|
|||
|
|
@ -2,7 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel peg strings sequences math math.parser
|
||||
namespaces make words quotations arrays hashtables io
|
||||
io.streams.string assocs ascii peg.parsers accessors ;
|
||||
io.streams.string assocs ascii peg.parsers accessors
|
||||
words.symbol ;
|
||||
IN: fjsc
|
||||
|
||||
TUPLE: ast-number value ;
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
|
|||
continuations debugger classes.tuple namespaces make vectors
|
||||
bit-arrays byte-arrays strings sbufs math.functions macros
|
||||
sequences.private combinators mirrors
|
||||
combinators.short-circuit fry ;
|
||||
combinators.short-circuit fry words.symbol ;
|
||||
RENAME: _ fry => __
|
||||
IN: inverse
|
||||
|
||||
|
|
@ -135,9 +135,6 @@ MACRO: undo ( quot -- ) [undo] ;
|
|||
\ not [ not ] define-inverse
|
||||
\ >boolean [ { t f } memq? assure ] define-inverse
|
||||
|
||||
\ >r [ r> ] define-inverse
|
||||
\ r> [ >r ] define-inverse
|
||||
|
||||
\ tuple>array [ >tuple ] define-inverse
|
||||
\ >tuple [ tuple>array ] define-inverse
|
||||
\ reverse [ reverse ] define-inverse
|
||||
|
|
|
|||
|
|
@ -15,13 +15,13 @@ SYMBOL: def-hash-keys
|
|||
|
||||
: more-defs ( hash -- )
|
||||
{
|
||||
{ -rot [ swap >r swap r> ] }
|
||||
{ -rot [ swap [ swap ] dip ] }
|
||||
{ -rot [ swap swapd ] }
|
||||
{ rot [ >r swap r> swap ] }
|
||||
{ rot [ [ swap ] dip swap ] }
|
||||
{ rot [ swapd swap ] }
|
||||
{ over [ dup swap ] }
|
||||
{ tuck [ dup -rot ] }
|
||||
{ swapd [ >r swap r> ] }
|
||||
{ swapd [ [ swap ] dip ] }
|
||||
{ 2nip [ nip nip ] }
|
||||
{ 2drop [ drop drop ] }
|
||||
{ 3drop [ drop drop drop ] }
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ DEFER: fake
|
|||
[ t ] [ { } \ fake <method> method-body? ] unit-test
|
||||
|
||||
[
|
||||
[ { } [ ] ] [ \ fake methods prepare-methods >r sort-methods r> ] unit-test
|
||||
[ { } [ ] ] [ \ fake methods prepare-methods [ sort-methods ] dip ] unit-test
|
||||
|
||||
[ t ] [ { } \ fake multi-dispatch-quot callable? ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ C: <ori> ori
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: make-matrix ( quot width -- matrix ) >r { } make r> group ; inline
|
||||
: make-matrix ( quot width -- matrix ) [ { } make ] dip group ; inline
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
|||
|
|
@ -7,16 +7,16 @@ USING: kernel continuations arrays sequences quotations ;
|
|||
[ 1array swap keep first continue-with ] callcc1 nip ;
|
||||
|
||||
: (bshift) ( v r k -- obj )
|
||||
>r dup first -rot r>
|
||||
[ dup first -rot ] dip
|
||||
[
|
||||
rot set-first
|
||||
continue-with
|
||||
] callcc1
|
||||
>r drop nip set-first r> ;
|
||||
[ drop nip set-first ] dip ;
|
||||
|
||||
: bshift ( r quot -- )
|
||||
swap [ ! quot r k
|
||||
over >r
|
||||
over [
|
||||
[ (bshift) ] 2curry swap call
|
||||
r> first continue-with
|
||||
] dip first continue-with
|
||||
] callcc1 2nip ; inline
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@ SYMBOL: *calling*
|
|||
*calling* get-global at ; inline
|
||||
|
||||
: timed-call ( quot word -- )
|
||||
[ calling ] [ >r benchmark r> register-time ] [ finished ] tri ; inline
|
||||
[ calling ] [ [ benchmark ] dip register-time ] [ finished ] tri ; inline
|
||||
|
||||
: time-unless-recursing ( quot word -- )
|
||||
dup called-recursively? not
|
||||
|
|
@ -71,9 +71,10 @@ SYMBOL: *calling*
|
|||
|
||||
: wordtimer-call ( quot -- )
|
||||
reset-word-timer
|
||||
benchmark >r
|
||||
benchmark [
|
||||
correct-for-timing-overhead
|
||||
"total time:" write r> pprint nl
|
||||
"total time:" write
|
||||
] dip pprint nl
|
||||
print-word-timings nl ;
|
||||
|
||||
: profile-vocab ( vocab quot -- )
|
||||
|
|
@ -81,9 +82,10 @@ SYMBOL: *calling*
|
|||
over [ reset-vocab ] [ add-timers ] bi
|
||||
reset-word-timer
|
||||
"executing quotation..." print flush
|
||||
benchmark >r
|
||||
benchmark [
|
||||
"resetting annotations..." print flush
|
||||
reset-vocab
|
||||
correct-for-timing-overhead
|
||||
"total time:" write r> pprint
|
||||
"total time:" write
|
||||
] dip pprint
|
||||
print-word-timings ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue