steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

random-tester 

fixed bugs in random-tester
removed debug statement in base64
erg 2006-02-19 21:26:27 +00:00
parent 49257f2498
commit ba79f3178a
2 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
contrib/crypto/base64.factor
View File

@ -15,7 +15,6 @@ IN: crypto-internals
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" nth ; "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" nth ;
: base64>ch ( ch -- ch ) : base64>ch ( ch -- ch )
#! extra f is to adjust index
{ {
f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f
f f f f f f f f f f 62 f f f 63 52 53 54 55 56 57 58 59 60 61 f f f f f f f f f f f f 62 f f f 63 52 53 54 55 56 57 58 59 60 61 f f

22
contrib/random-tester/random-tester.factor
View File

@ -35,14 +35,13 @@ IN: random-tester
: ratio>x : ratio>x
{ {
1+ 1- >bignum >digit >fixnum abs absq arg 1+ 1- >bignum >digit >fixnum abs absq arg ceiling
cis conjugate cos cosec cosech cis conjugate cos cosec cosech
cosh cot coth double>bits exp float>bits floor imaginary cosh cot coth double>bits exp float>bits floor imaginary
log neg next-power-of-2 quadrant real sec log neg next-power-of-2 quadrant real sec
sech sgn sin sinh sq sqrt tan tanh truncate sech sgn sin sinh sq sqrt tan tanh truncate
} ; } ;
! ceiling, truncate, floor eventually
: float>x ( float -- x ) : float>x ( float -- x )
{ {
1+ 1- >bignum >digit >fixnum abs absq arg 1+ 1- >bignum >digit >fixnum abs absq arg
@ -198,11 +197,10 @@ SYMBOL: first-arg
= [ "problem in runtime" throw ] unless ; = [ "problem in runtime" throw ] unless ;
: interp-runtime-check ( quot -- ) : interp-runtime-check ( quot -- )
dup . ! dup .
! 0 [ tan tan ] compile-1 drop
[ last-quot set ] keep [ last-quot set ] keep
[ call ] keep compile-1 [ call ] keep call ! compile-1
2dup swap unparse write " " write unparse print ! 2dup swap unparse write " " write unparse print
= [ "problem in math" throw ] unless ; = [ "problem in math" throw ] unless ;
: interp-compile-check-1 ( x quot -- ) : interp-compile-check-1 ( x quot -- )
@ -280,24 +278,24 @@ SYMBOL: first-arg
random-ratio ratio>x-throw nth-rand unit cons interp-compile-check-catch ; random-ratio ratio>x-throw nth-rand unit cons interp-compile-check-catch ;
: test-update-xt ( -- ) : test-update-xt ( -- )
random-integer random-integer 2integer>x nth-rand unit swons swons update-xt-check ; random-integer random-integer 2integer>x nth-rand unit cons cons update-xt-check ;
! 2-arg tests ! 2-arg tests
: test-2integer>x ( -- ) : test-2integer>x ( -- )
random-integer random-integer 2integer>x nth-rand unit swons swons interp-runtime-check ; random-integer random-integer 2integer>x nth-rand unit cons cons interp-runtime-check ;
: test-2ratio>x ( -- ) : test-2ratio>x ( -- )
random-ratio random-ratio 2ratio>x nth-rand unit swons swons interp-runtime-check ; random-ratio random-ratio 2ratio>x nth-rand unit cons cons interp-runtime-check ;
: test-2float>x ( -- ) : test-2float>x ( -- )
random-float random-float 2float>x nth-rand unit swons swons interp-runtime-check ; random-float random-float 2float>x nth-rand unit cons cons interp-runtime-check ;
: test-2complex>x ( -- ) : test-2complex>x ( -- )
random-complex random-complex 2complex>x nth-rand unit swons swons interp-runtime-check ; random-complex random-complex 2complex>x nth-rand unit cons cons interp-runtime-check ;
: test-2random>x ( -- ) : test-2random>x ( -- )
random-number random-number math-2 nth-rand unit swons swons interp-runtime-check ; random-number random-number math-2 nth-rand unit cons cons interp-runtime-check ;