core/inference/transforms/transforms-tests.factor

   1 IN: inference.transforms.tests
   2 USING: sequences inference.transforms tools.test math kernel
   3 quotations inference accessors combinators words arrays
   4 classes ;
   5
   6 : compose-n-quot ( word -- quot' ) <repetition> >quotation ;
   7 : compose-n ( quot -- ) compose-n-quot call ;
   8 \ compose-n [ compose-n-quot ] 2 define-transform
   9 : compose-n-test ( a b c -- x ) 2 \ + compose-n ;
  10
  11 [ 6 ] [ 1 2 3 compose-n-test ] unit-test
  12
  13 [ 0 ] [ { } bitfield-quot call ] unit-test
  14
  15 [ 256 ] [ 1 { 8 } bitfield-quot call ] unit-test
  16
  17 [ 268 ] [ 3 1 { 8 2 } bitfield-quot call ] unit-test
  18
  19 [ 268 ] [ 1 { 8 { 3 2 } } bitfield-quot call ] unit-test
  20
  21 [ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test
  22
  23 TUPLE: color r g b ;
  24
  25 C: <color> color
  26
  27 : cleave-test ( color -- r g b )
  28     { [ r>> ] [ g>> ] [ b>> ] } cleave ;
  29
  30 { 1 3 } [ cleave-test ] must-infer-as
  31
  32 [ 1 2 3 ] [ 1 2 3 <color> cleave-test ] unit-test
  33
  34 [ 1 2 3 ] [ 1 2 3 <color> \ cleave-test word-def call ] unit-test
  35
  36 : 2cleave-test ( a b -- c d e ) { [ 2array ] [ + ] [ - ] } 2cleave ;
  37
  38 [ { 1 2 } 3 -1 ] [ 1 2 2cleave-test ] unit-test
  39
  40 [ { 1 2 } 3 -1 ] [ 1 2 \ 2cleave-test word-def call ] unit-test
  41
  42 : spread-test ( a b c -- d e f ) { [ sq ] [ neg ] [ recip ] } spread ;
  43
  44 [ 16 -3 1/6 ] [ 4 3 6 spread-test ] unit-test
  45
  46 [ 16 -3 1/6 ] [ 4 3 6 \ spread-test word-def call ] unit-test
  47
  48 [ fixnum instance? ] must-infer