unmaintained/random-tester/safe-words/safe-words.factor

   1 USING: kernel namespaces sequences sets sorting vocabs ;
   2 USING: arrays assocs generic hashtables
   3 math math.intervals math.parser math.order math.functions
   4 refs shuffle vectors words ;
   5 IN: random-tester.safe-words
   6
   7 : ?-words
   8     {
   9         /f
  10
  11         bits>float bits>double
  12         float>bits double>bits
  13
  14         >bignum >boolean >fixnum >float
  15
  16         array? integer? complex? value-ref? ref? key-ref?
  17         interval? number?
  18         wrapper? tuple?
  19         [-1,1]? between? bignum? both? either? eq? equal? even? fixnum?
  20         float? fp-nan? hashtable? interval-contains? interval-subset?
  21         interval? key-ref? key? number? odd? pair? power-of-2?
  22         ratio? rational? real? zero? assoc? curry? vector? callstack?
  23
  24         2^ not
  25         ! arrays
  26         resize-array <array>
  27         ! assocs
  28         (assoc-stack)
  29         new-assoc
  30         assoc-like
  31         <hashtable>
  32         all-integers? (all-integers?) ! hangs?
  33         assoc-push-if
  34
  35         (clone) assoc-clone-like ! SYMBOL: foo foo dup (clone) =
  36     } ;
  37
  38 : bignum-words
  39     {
  40         next-power-of-2 (next-power-of-2)
  41         times
  42         hashcode hashcode*
  43     } ;
  44
  45 : initialization-words
  46     {
  47         init-namespaces
  48     } ;
  49
  50 : stack-words
  51     {
  52         dup
  53         drop 2drop 3drop
  54         roll -roll 2swap
  55
  56         >r r>
  57     } ;
  58
  59 : stateful-words
  60     {
  61         counter
  62         gensym
  63     } ;
  64
  65 : foo-words
  66     {
  67         set-retainstack
  68         retainstack callstack
  69         datastack
  70         callstack>array
  71
  72         curry 2curry 3curry compose 3compose
  73         (assoc-each)
  74     } ;
  75
  76 : exit-words
  77     {
  78         call-clear die
  79     } ;
  80
  81 : bad-words ( -- array )
  82     [
  83         ?-words %
  84         bignum-words %
  85         initialization-words %
  86         stack-words %
  87         stateful-words %
  88         exit-words %
  89         foo-words %
  90     ] { } make ;
  91
  92 : safe-words ( -- array )
  93     {
  94         ! "accessors"
  95         "alists" "arrays" "assocs" "bit-arrays" "byte-arrays"
  96         ! "classes" "combinators" "compiler" "continuations"
  97         ! "core-foundation" "definitions" "documents"
  98         ! "float-arrays" "generic" "graphs" "growable"
  99         "hashtables"  ! io.*
 100         "kernel" "math"
 101         "math.bitfields" "math.complex" "math.constants" "math.floats"
 102         "math.functions" "math.integers" "math.intervals" "math.libm"
 103         "math.parser" "math.order" "math.ratios" "math.vectors"
 104         ! "namespaces"
 105         "quotations" "sbufs"
 106         ! "queues" "strings" "sequences"
 107         "sets"
 108         "vectors"
 109         ! "words"
 110     } [ words ] map concat bad-words diff natural-sort ;
 111
 112 safe-words \ safe-words set-global
 113
 114 ! foo dup (clone) = .
 115 ! foo dup clone = .
 116 ! f [ byte-array>bignum assoc-clone-like ] compile-1
 117 ! 2 3.14 [ number= ] compile-1
 118 ! 3.14 [ <vector> assoc? ] compile-1
 119 ! -3 [ ] 2 [ byte-array>bignum denominator ] compile-1
 120 ! : foo ( x -- y ) euler bitand ; { foo } compile 20 foo