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

update random-tester

db4
Doug Coleman 2008-07-30 15:08:04 -05:00
parent a202812ba0
commit d3e4070bb3
2 changed files with 25 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
unmaintained/random-tester/random-tester.factor
View File

@ -8,7 +8,7 @@ SYMBOL: errored
SYMBOL: before SYMBOL: before
SYMBOL: after SYMBOL: after
SYMBOL: quot SYMBOL: quot
TUPLE: random-tester-error ; ERROR: random-tester-error ;
: setup-test ( #data #code -- data... quot ) : setup-test ( #data #code -- data... quot )
#! Variable stack effect #! Variable stack effect
@ -35,7 +35,7 @@ TUPLE: random-tester-error ;
"--" print "--" print
[ . ] each [ . ] each
quot get . quot get .
random-tester-error construct-empty throw random-tester-error
] if ] if
] unless clear ; ] unless clear ;

34
unmaintained/random-tester/safe-words/safe-words.factor
View File

@ -1,5 +1,7 @@
USING: kernel namespaces sequences sorting vocabs ; USING: kernel namespaces sequences sets sorting vocabs ;
USING: arrays assocs generic hashtables math math.intervals math.parser math.functions refs shuffle vectors words ; USING: arrays assocs generic hashtables
math math.intervals math.parser math.order math.functions
refs shuffle vectors words ;
IN: random-tester.safe-words IN: random-tester.safe-words
: ?-words : ?-words
@ -16,7 +18,11 @@ IN: random-tester.safe-words
array? integer? complex? value-ref? ref? key-ref? array? integer? complex? value-ref? ref? key-ref?
interval? number? interval? number?
wrapper? tuple? wrapper? tuple?
[-1,1]? between? bignum? both? either? eq? equal? even? fixnum? float? fp-nan? hashtable? interval-contains? interval-subset? interval? key-ref? key? number? odd? pair? power-of-2? ratio? rational? real? subassoc? zero? assoc? curry? vector? callstack? ! clear 3.14 [ <vector> assoc? ] compile-1 [-1,1]? between? bignum? both? either? eq? equal? even? fixnum?
float? fp-nan? hashtable? interval-contains? interval-subset?
interval? key-ref? key? number? odd? pair? power-of-2?
ratio? rational? real? zero? assoc? curry? vector? callstack?
2^ not 2^ not
! arrays ! arrays
resize-array <array> resize-array <array>
@ -64,6 +70,9 @@ IN: random-tester.safe-words
retainstack callstack retainstack callstack
datastack datastack
callstack>array callstack>array
curry 2curry 3curry compose 3compose
(assoc-each)
} ; } ;
: exit-words : exit-words
@ -83,28 +92,31 @@ IN: random-tester.safe-words
] { } make ; ] { } make ;
: safe-words ( -- array ) : safe-words ( -- array )
bad-words { {
"alists" "arrays" "assocs" ! "bit-arrays" "byte-arrays" ! "accessors"
"alists" "arrays" "assocs" "bit-arrays" "byte-arrays"
! "classes" "combinators" "compiler" "continuations" ! "classes" "combinators" "compiler" "continuations"
! "core-foundation" "definitions" "documents" ! "core-foundation" "definitions" "documents"
! "float-arrays" "generic" "graphs" "growable" ! "float-arrays" "generic" "graphs" "growable"
"hashtables" ! io.* "hashtables" ! io.*
"kernel" "math" "kernel" "math"
"math.bitfields" "math.complex" "math.constants" "math.floats" "math.bitfields" "math.complex" "math.constants" "math.floats"
"math.functions" "math.integers" "math.intervals" "math.libm" "math.functions" "math.integers" "math.intervals" "math.libm"
"math.parser" "math.ratios" "math.vectors" "math.parser" "math.order" "math.ratios" "math.vectors"
! "namespaces" "quotations" "sbufs" ! "namespaces"
"quotations" "sbufs"
! "queues" "strings" "sequences" ! "queues" "strings" "sequences"
"sets"
"vectors" "vectors"
! "words" ! "words"
} [ words ] map concat seq-diff natural-sort ; } [ words ] map concat bad-words diff natural-sort ;
safe-words \ safe-words set-global safe-words \ safe-words set-global
! foo dup (clone) = . ! foo dup (clone) = .
! foo dup clone = . ! foo dup clone = .
! f [ byte-array>bignum assoc-clone-like ] compile-1 ! f [ byte-array>bignum assoc-clone-like ] compile-1
! 2 3.14 [ construct-empty number= ] compile-1 ! 2 3.14 [ number= ] compile-1
! 3.14 [ <vector> assoc? ] compile-1 ! 3.14 [ <vector> assoc? ] compile-1
! -3 [ ] 2 [ byte-array>bignum denominator ] compile-1 ! -3 [ ] 2 [ byte-array>bignum denominator ] compile-1
! : foo ( x -- y ) euler bitand ; { foo } compile 20 foo