diff --git a/libs/random-tester/load.factor b/apps/random-tester/load.factor similarity index 60% rename from libs/random-tester/load.factor rename to apps/random-tester/load.factor index 757602b005..3404605873 100644 --- a/libs/random-tester/load.factor +++ b/apps/random-tester/load.factor @@ -1,6 +1,7 @@ -PROVIDE: libs/random-tester +PROVIDE: apps/random-tester { +files+ { "utils.factor" "random.factor" "random-tester.factor" + "random-tester2.factor" } } ; diff --git a/libs/random-tester/random-tester.factor b/apps/random-tester/random-tester.factor similarity index 87% rename from libs/random-tester/random-tester.factor rename to apps/random-tester/random-tester.factor index 4fc64b9d0e..ab24e6554b 100644 --- a/libs/random-tester/random-tester.factor +++ b/apps/random-tester/random-tester.factor @@ -105,10 +105,6 @@ IN: random-tester : 2-complex>complex { * + - /f } ; - - - - SYMBOL: last-quot SYMBOL: first-arg SYMBOL: second-arg @@ -178,10 +174,10 @@ SYMBOL: second-arg ! RANDOM QUOTATIONS TO TEST -: random-1-integer>x-quot ( -- quot ) 1-integer>x nth-rand unit ; -: random-1-ratio>x-quot ( -- quot ) 1-ratio>x nth-rand unit ; -: random-1-float>x-quot ( -- quot ) 1-float>x nth-rand unit ; -: random-1-complex>x-quot ( -- quot ) 1-complex>x nth-rand unit ; +: random-1-integer>x-quot ( -- quot ) 1-integer>x pick-one unit ; +: random-1-ratio>x-quot ( -- quot ) 1-ratio>x pick-one unit ; +: random-1-float>x-quot ( -- quot ) 1-float>x pick-one unit ; +: random-1-complex>x-quot ( -- quot ) 1-complex>x pick-one unit ; : test-1-integer>x ( -- ) random-integer random-1-integer>x-quot 1-interpreted-vs-compiled-check ; @@ -193,18 +189,18 @@ SYMBOL: second-arg random-complex random-1-complex>x-quot 1-interpreted-vs-compiled-check ; -: random-1-float>float-quot ( -- obj ) 1-float>float nth-rand unit ; -: random-2-float>float-quot ( -- obj ) 2-float>float nth-rand unit ; +: random-1-float>float-quot ( -- obj ) 1-float>float pick-one unit ; +: random-2-float>float-quot ( -- obj ) 2-float>float pick-one unit ; : nrandom-2-float>float-quot ( -- obj ) [ 5 [ { - [ 2-float>float nth-rand , random-float , ] - [ 1-float>float nth-rand , ] + [ 2-float>float pick-one , random-float , ] + [ 1-float>float pick-one , ] } do-one ] times - 2-float>float nth-rand , + 2-float>float pick-one , ] [ ] make ; : test-1-float>float ( -- ) @@ -220,8 +216,8 @@ SYMBOL: second-arg : test-1-integer>x-runtime ( -- ) random-integer random-1-integer>x-quot 1-runtime-check ; -: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws nth-rand unit ; -: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws nth-rand unit ; +: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws pick-one unit ; +: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws pick-one unit ; : test-1-integer>x-throws ( -- obj ) random-integer random-1-integer>x-throws-quot 1-interpreted-vs-compiled-check-catch ; @@ -234,16 +230,9 @@ SYMBOL: second-arg : test-2-integer>x-throws ( -- ) [ random-integer , random-integer , - 2-x>y-throws nth-rand , + 2-x>y-throws pick-one , ] [ ] make 2-interpreted-vs-compiled-check-catch ; -! : test-^-shift ( -- ) -! [ - ! 100 random-int 50 - , - ! 100 random-int 50 - , - ! { ^ shift } nth-rand , - ! ] [ ] make 2-interpreted-vs-compiled-check-catch ; - ! : test-^-ratio ( -- ) ! [ ! random-ratio , random-ratio , \ ^ , @@ -251,27 +240,27 @@ SYMBOL: second-arg : test-0-float?-when [ - random-number , \ dup , \ float? , 1-float>x nth-rand unit , \ when , + random-number , \ dup , \ float? , 1-float>x pick-one unit , \ when , ] [ ] make 0-runtime-check ; : test-1-integer?-when random-integer [ - \ dup , \ integer? , 1-integer>x nth-rand unit , \ when , + \ dup , \ integer? , 1-integer>x pick-one unit , \ when , ] [ ] make 1-interpreted-vs-compiled-check ; : test-1-ratio?-when random-ratio [ - \ dup , \ ratio? , 1-ratio>x nth-rand unit , \ when , + \ dup , \ ratio? , 1-ratio>x pick-one unit , \ when , ] [ ] make 1-interpreted-vs-compiled-check ; : test-1-float?-when random-float [ - \ dup , \ float? , 1-float>x nth-rand unit , \ when , + \ dup , \ float? , 1-float>x pick-one unit , \ when , ] [ ] make 1-interpreted-vs-compiled-check ; : test-1-complex?-when random-complex [ - \ dup , \ complex? , 1-complex>x nth-rand unit , \ when , + \ dup , \ complex? , 1-complex>x pick-one unit , \ when , ] [ ] make 1-interpreted-vs-compiled-check ; @@ -308,5 +297,5 @@ SYMBOL: second-arg test-1-complex?-when ! full-gc ! code-gc - } nth-rand dup . execute terpri ; + } pick-one dup . execute terpri ; diff --git a/libs/random-tester/random.factor b/apps/random-tester/random.factor similarity index 94% rename from libs/random-tester/random.factor rename to apps/random-tester/random.factor index 39673c1b0a..fe614aebdb 100644 --- a/libs/random-tester/random.factor +++ b/apps/random-tester/random.factor @@ -22,7 +22,7 @@ IN: random-tester random-int 2 swap ^ random-int ; : random-seq ( -- seq ) - { [ ] { } V{ } "" } nth-rand + { [ ] { } V{ } "" } pick-one [ max-length random-int [ max-value random-int , ] times ] swap make ; : random-string @@ -56,7 +56,7 @@ SYMBOL: special-complexes coin-flip [ random-fixnum ] [ - coin-flip [ random-bignum ] [ special-integers nth-rand ] if + coin-flip [ random-bignum ] [ special-integers pick-one ] if ] if ; : random-positive-integer ( -- int ) @@ -70,7 +70,7 @@ SYMBOL: special-complexes 1000000000 dup [ random-int ] 2apply 1+ / coin-flip [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; : random-float ( -- float ) - coin-flip [ random-ratio ] [ special-floats nth-rand ] if + coin-flip [ random-ratio ] [ special-floats pick-one ] if coin-flip [ .0000000000000000001 /f ] [ coin-flip [ .00000000000000001 * ] when ] if >float ; diff --git a/libs/random-tester/utils.factor b/apps/random-tester/utils.factor similarity index 64% rename from libs/random-tester/utils.factor rename to apps/random-tester/utils.factor index c305cefda0..d8458ff242 100644 --- a/libs/random-tester/utils.factor +++ b/apps/random-tester/utils.factor @@ -3,11 +3,12 @@ arrays parser compiler syntax io optimizer inference tools prettyprint ; IN: random-tester -: nth-rand ( seq -- elem ) [ length random-int ] keep nth ; +: pick-one ( seq -- elt ) + [ length random-int ] keep nth ; ! HASHTABLES : random-hash-entry ( hash -- key value ) - hash>alist nth-rand first2 ; + hash>alist pick-one first2 ; : coin-flip ( -- bool ) 2 random-int zero? ; -: do-one ( seq -- ) nth-rand call ; inline +: do-one ( seq -- ) pick-one call ; inline