remove 1-, 1+, use iota somewhere

db4
Doug Coleman 2009-05-05 23:32:23 -05:00
parent ffbd19faba
commit d168f76ab0
8 changed files with 22 additions and 22 deletions

View File

@ -7,7 +7,7 @@ TUPLE: bits { number read-only } { length read-only } ;
C: <bits> bits C: <bits> bits
: make-bits ( number -- bits ) : make-bits ( number -- bits )
dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1+ <bits> ] if ; inline dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if ; inline
M: bits length length>> ; M: bits length length>> ;

View File

@ -13,10 +13,10 @@ IN: math.bitwise
: unmask? ( x n -- ? ) unmask 0 > ; inline : unmask? ( x n -- ? ) unmask 0 > ; inline
: mask ( x n -- ? ) bitand ; inline : mask ( x n -- ? ) bitand ; inline
: mask? ( x n -- ? ) mask 0 > ; inline : mask? ( x n -- ? ) mask 0 > ; inline
: wrap ( m n -- m' ) 1- bitand ; inline : wrap ( m n -- m' ) 1 - bitand ; inline
: bits ( m n -- m' ) 2^ wrap ; inline : bits ( m n -- m' ) 2^ wrap ; inline
: mask-bit ( m n -- m' ) 2^ mask ; inline : mask-bit ( m n -- m' ) 2^ mask ; inline
: on-bits ( n -- m ) 2^ 1- ; inline : on-bits ( n -- m ) 2^ 1 - ; inline
: toggle-bit ( m n -- m' ) 2^ bitxor ; inline : toggle-bit ( m n -- m' ) 2^ bitxor ; inline
: shift-mod ( n s w -- n ) : shift-mod ( n s w -- n )
@ -64,8 +64,8 @@ DEFER: byte-bit-count
<< <<
\ byte-bit-count \ byte-bit-count
256 [ 256 iota [
8 <bits> 0 [ [ 1+ ] when ] reduce 8 <bits> 0 [ [ 1 + ] when ] reduce
] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ] ] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ]
(( byte -- table )) define-declared (( byte -- table )) define-declared
@ -97,12 +97,12 @@ PRIVATE>
! Signed byte array to integer conversion ! Signed byte array to integer conversion
: signed-le> ( bytes -- x ) : signed-le> ( bytes -- x )
[ le> ] [ length 8 * 1- on-bits ] bi [ le> ] [ length 8 * 1 - on-bits ] bi
2dup > [ bitnot bitor ] [ drop ] if ; 2dup > [ bitnot bitor ] [ drop ] if ;
: signed-be> ( bytes -- x ) : signed-be> ( bytes -- x )
<reversed> signed-le> ; <reversed> signed-le> ;
: >signed ( x n -- y ) : >signed ( x n -- y )
2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ; 2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;

View File

@ -164,7 +164,7 @@ M: VECTOR element-type
M: VECTOR Vswap M: VECTOR Vswap
(prepare-swap) [ XSWAP ] 2dip ; (prepare-swap) [ XSWAP ] 2dip ;
M: VECTOR Viamax M: VECTOR Viamax
(prepare-nrm2) IXAMAX 1- ; (prepare-nrm2) IXAMAX 1 - ;
M: VECTOR (blas-vector-like) M: VECTOR (blas-vector-like)
drop <VECTOR> ; drop <VECTOR> ;

View File

@ -18,7 +18,7 @@ M: real sqrt
: factor-2s ( n -- r s ) : factor-2s ( n -- r s )
#! factor an integer into 2^r * s #! factor an integer into 2^r * s
dup 0 = [ 1 ] [ dup 0 = [ 1 ] [
0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] while 0 swap [ dup even? ] [ [ 1 + ] [ 2/ ] bi* ] while
] if ; inline ] if ; inline
<PRIVATE <PRIVATE
@ -216,17 +216,17 @@ M: real tanh ftanh ;
: coth ( x -- y ) tanh recip ; inline : coth ( x -- y ) tanh recip ; inline
: acosh ( x -- y ) : acosh ( x -- y )
dup sq 1- sqrt + log ; inline dup sq 1 - sqrt + log ; inline
: asech ( x -- y ) recip acosh ; inline : asech ( x -- y ) recip acosh ; inline
: asinh ( x -- y ) : asinh ( x -- y )
dup sq 1+ sqrt + log ; inline dup sq 1 + sqrt + log ; inline
: acosech ( x -- y ) recip asinh ; inline : acosech ( x -- y ) recip asinh ; inline
: atanh ( x -- y ) : atanh ( x -- y )
[ 1+ ] [ 1- neg ] bi / log 2 / ; inline [ 1 + ] [ 1 - neg ] bi / log 2 / ; inline
: acoth ( x -- y ) recip atanh ; inline : acoth ( x -- y ) recip atanh ; inline
@ -259,7 +259,7 @@ M: real atan fatan ;
: floor ( x -- y ) : floor ( x -- y )
dup 1 mod dup zero? dup 1 mod dup zero?
[ drop ] [ dup 0 < [ - 1- ] [ - ] if ] if ; foldable [ drop ] [ dup 0 < [ - 1 - ] [ - ] if ] if ; foldable
: ceiling ( x -- y ) neg floor neg ; foldable : ceiling ( x -- y ) neg floor neg ; foldable

View File

@ -380,7 +380,7 @@ SYMBOL: incomparable
[ [
to>> first 1 max dup most-positive-fixnum > to>> first 1 max dup most-positive-fixnum >
[ drop full-interval interval-log2 ] [ drop full-interval interval-log2 ]
[ 1+ >integer log2 0 swap [a,b] ] [ 1 + >integer log2 0 swap [a,b] ]
if if
] ]
} case ; } case ;
@ -407,7 +407,7 @@ SYMBOL: incomparable
: integral-closure ( i1 -- i2 ) : integral-closure ( i1 -- i2 )
dup special-interval? [ dup special-interval? [
[ from>> first2 [ 1+ ] unless ] [ from>> first2 [ 1 + ] unless ]
[ to>> first2 [ 1- ] unless ] [ to>> first2 [ 1 - ] unless ]
bi [a,b] bi [a,b]
] unless ; ] unless ;

View File

@ -29,7 +29,7 @@ PRIVATE>
: n*p ( n p -- n*p ) n*v ; : n*p ( n p -- n*p ) n*v ;
: pextend-conv ( p q -- p q ) : pextend-conv ( p q -- p q )
2dup [ length ] bi@ + 1- 2pad-tail [ >vector ] bi@ ; 2dup [ length ] bi@ + 1 - 2pad-tail [ >vector ] bi@ ;
: p* ( p q -- r ) : p* ( p q -- r )
2unempty pextend-conv <reversed> dup length 2unempty pextend-conv <reversed> dup length
@ -44,7 +44,7 @@ PRIVATE>
2ptrim 2ptrim
2dup [ length ] bi@ - 2dup [ length ] bi@ -
dup 1 < [ drop 1 ] when dup 1 < [ drop 1 ] when
[ over length + 0 pad-head pextend ] keep 1+ ; [ over length + 0 pad-head pextend ] keep 1 + ;
: /-last ( seq seq -- a ) : /-last ( seq seq -- a )
#! divide the last two numbers in the sequences #! divide the last two numbers in the sequences

View File

@ -10,7 +10,7 @@ TUPLE: range
{ step read-only } ; { step read-only } ;
: <range> ( a b step -- range ) : <range> ( a b step -- range )
[ over - ] dip [ /i 1+ 0 max ] keep range boa ; inline [ over - ] dip [ /i 1 + 0 max ] keep range boa ; inline
M: range length ( seq -- n ) M: range length ( seq -- n )
length>> ; length>> ;

View File

@ -15,7 +15,7 @@ IN: math.statistics
: median ( seq -- n ) : median ( seq -- n )
natural-sort dup length even? [ natural-sort dup length even? [
[ midpoint@ dup 1- 2array ] keep nths mean [ midpoint@ dup 1 - 2array ] keep nths mean
] [ ] [
[ midpoint@ ] keep nth [ midpoint@ ] keep nth
] if ; ] if ;
@ -33,7 +33,7 @@ IN: math.statistics
drop 0 drop 0
] [ ] [
[ [ mean ] keep [ - sq ] with sigma ] keep [ [ mean ] keep [ - sq ] with sigma ] keep
length 1- / length 1 - /
] if ; ] if ;
: std ( seq -- x ) : std ( seq -- x )
@ -47,7 +47,7 @@ IN: math.statistics
0 [ [ [ pick ] dip swap - ] bi@ * + ] 2reduce 2nip ; 0 [ [ [ pick ] dip swap - ] bi@ * + ] 2reduce 2nip ;
: (r) ( mean(x) mean(y) {x} {y} sx sy -- r ) : (r) ( mean(x) mean(y) {x} {y} sx sy -- r )
* recip [ [ ((r)) ] keep length 1- / ] dip * ; * recip [ [ ((r)) ] keep length 1 - / ] dip * ;
: [r] ( {{x,y}...} -- mean(x) mean(y) {x} {y} sx sy ) : [r] ( {{x,y}...} -- mean(x) mean(y) {x} {y} sx sy )
first2 [ [ [ mean ] bi@ ] 2keep ] 2keep [ std ] bi@ ; first2 [ [ [ mean ] bi@ ] 2keep ] 2keep [ std ] bi@ ;