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
: 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>> ;

View File

@ -13,10 +13,10 @@ IN: math.bitwise
: unmask? ( x n -- ? ) unmask 0 > ; inline
: mask ( x n -- ? ) bitand ; 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
: 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
: shift-mod ( n s w -- n )
@ -64,8 +64,8 @@ DEFER: byte-bit-count
<<
\ byte-bit-count
256 [
8 <bits> 0 [ [ 1+ ] when ] reduce
256 iota [
8 <bits> 0 [ [ 1 + ] when ] reduce
] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ]
(( byte -- table )) define-declared
@ -97,12 +97,12 @@ PRIVATE>
! Signed byte array to integer conversion
: signed-le> ( bytes -- x )
[ le> ] [ length 8 * 1- on-bits ] bi
[ le> ] [ length 8 * 1 - on-bits ] bi
2dup > [ bitnot bitor ] [ drop ] if ;
: signed-be> ( bytes -- x )
<reversed> signed-le> ;
: >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
(prepare-swap) [ XSWAP ] 2dip ;
M: VECTOR Viamax
(prepare-nrm2) IXAMAX 1- ;
(prepare-nrm2) IXAMAX 1 - ;
M: VECTOR (blas-vector-like)
drop <VECTOR> ;

View File

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

View File

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

View File

@ -29,7 +29,7 @@ PRIVATE>
: n*p ( n p -- n*p ) n*v ;
: 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 )
2unempty pextend-conv <reversed> dup length
@ -44,7 +44,7 @@ PRIVATE>
2ptrim
2dup [ length ] bi@ -
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 )
#! divide the last two numbers in the sequences

View File

@ -10,7 +10,7 @@ TUPLE: range
{ step read-only } ;
: <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 )
length>> ;

View File

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