fix permutations for random-tester

diff --git a/apps/random-tester/random-tester2.factor b/apps/random-tester/random-tester2.factor
index f2606ee1d3545c523e121baa85605bac81df36ad..203c090abf85a1ea6f8680a7eef1c9d88454bb95 100644 (file)
--- a/apps/random-tester/random-tester2.factor
+++ b/apps/random-tester/random-tester2.factor
@@ -97,6 +97,8 @@ SYMBOL: wordbank
 
         <continuation> continue-with
 
+        set-delegate
+
     }
     { "arrays" "errors" "generic" "graphs" "hashtables" "io"
     "kernel" "math" "namespaces"

diff --git a/apps/random-tester/type.factor b/apps/random-tester/type.factor
index 731f52cec3925b92a9cf639d952692c9c90878dd..aa35ffec2e0d5654423ed426deb3392b5a7b6f45 100644 (file)
--- a/apps/random-tester/type.factor
+++ b/apps/random-tester/type.factor
@@ -32,7 +32,7 @@ TUPLE: inert-object ;
         0
         ! -268435457
         inert
-        ! T{ inert-object f }
+            ! T{ inert-object f }
         -29/2
         -3.14
         C{ 1 -1 }
@@ -71,22 +71,10 @@ TUPLE: inert-object ;
         T{ inert-object f } ,
     ] { } make ;
 
-! : cartesian-inputs ( n -- list )
-    ! >r make-inputs >list r>
-    ! 1- [ drop make-inputs >list lcartesian-product ] each ;
-
-: cartesian-inputs ( n -- list )
-    dup 2 > [
-        drop { } >list
-    ] [
-        >r make-inputs >list r>
-        1- [ drop make-inputs >list lcartesian-product ] each
-    ] if ;
-
 
 : word-inputs ( word -- seq )
     [ stack-effect effect-in length ] [ drop 0 ] recover
-    cartesian-inputs list>array ;
+    inputs swap ;
     
 : type-error? ( exception -- ? )
     [ swap execute or ] curry
@@ -104,23 +92,30 @@ SYMBOL: params
         dup clone params set
         maybe-explode
     r>
-     "<<<<<testing" .
+     ! "<<<<<testing" .
      .s
-     "-----" . flush
+     ! "-----" . flush
+
+        ! dup [ standard-combination ] = [
+            ! >r 3dup . sheet . . r> dup .
+        ! ] when
     [ call ] [ err on ] recover
-     .s
-     ">>>>>tested" .
+     ! .s
+     ! ">>>>>tested" .
     err get [
         dup type-error? dup [
-            .s
+            ! .s
         ] unless
         type-error set
-    ] when clear type-error get
-    ;
+    ] when clear type-error get ;
 
 : test-inputs ( word -- seq )
     [ word-inputs ] keep
     unit [
         throws? not
-    ] curry map ;
+    ] curry each-permutation ;
 
+: test1
+    wordbank get [
+        [ stack-effect effect-in length ] catch [ 4 < ] unless
+    ] subset [ test-inputs ] each ;

diff --git a/apps/random-tester/utils.factor b/apps/random-tester/utils.factor
index 34b69db33e1d7cc8da273a8917b4fef27222d208..8d24036563eb84907bd7420efcd54f30a9dc1051 100644 (file)
--- a/apps/random-tester/utils.factor
+++ b/apps/random-tester/utils.factor
@@ -20,9 +20,9 @@ IN: random-tester
     [ drop 0 ] map ;
 
 TUPLE: p-list seq max count count-vec ;
-: make-p-list ( seq -- tuple )
-    dup length [ 1- ] keep
-    [ dup ^ 0 swap 2array ] keep
+: make-p-list ( seq n -- tuple )
+    >r dup length [ 1- ] keep r>
+    [ ^ 0 swap 2array ] keep
     zero-array <p-list> ;
 
 : inc-seq ( seq max -- )
@@ -54,7 +54,7 @@ TUPLE: p-list seq max count count-vec ;
 : (permutations) ( tuple -- )
     dup p-list-next [ , (permutations) ] [ drop ] if* ;
 
-: permutations ( seq -- seq )
+: permutations ( seq n -- seq )
     make-p-list
     [
         (permutations)
@@ -68,6 +68,6 @@ TUPLE: p-list seq max count count-vec ;
         2drop
     ] if* ; inline
 
-: each-permutation ( seq quot -- )
+: each-permutation ( seq n quot -- )
     >r make-p-list r> (each-permutation) ;