move random-tester2 to apps/, add random-tester2

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"
 } } ;

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-integer>x-quot ( -- quot ) 1-integer>x pick-one unit ;
-: random-1-ratio>x-quot ( -- quot ) 1-ratio>x nth-rand unit ;
+: random-1-ratio>x-quot ( -- quot ) 1-ratio>x pick-one unit ;
-: random-1-float>x-quot ( -- quot ) 1-float>x nth-rand unit ;
+: random-1-float>x-quot ( -- quot ) 1-float>x pick-one unit ;
-: random-1-complex>x-quot ( -- quot ) 1-complex>x nth-rand 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-1-float>float-quot ( -- obj ) 1-float>float pick-one unit ;
-: random-2-float>float-quot ( -- obj ) 2-float>float nth-rand 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 , ]
+                [ 2-float>float pick-one , random-float , ]
-                [ 1-float>float nth-rand ,  ]
+                [ 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-integer>x-throws-quot ( -- obj ) 1-integer>x-throws pick-one unit ;
-: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws nth-rand 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 ;
 

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 ;

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