basis/stack-checker/transforms/transforms-tests.factor

   1 IN: stack-checker.transforms.tests
   2 USING: sequences stack-checker.transforms tools.test math kernel
   3 quotations stack-checker accessors combinators words arrays
   4 classes classes.tuple ;
   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 TUPLE: color r g b ;
  14
  15 C: <color> color
  16
  17 : cleave-test ( color -- r g b )
  18     { [ r>> ] [ g>> ] [ b>> ] } cleave ;
  19
  20 { 1 3 } [ cleave-test ] must-infer-as
  21
  22 [ 1 2 3 ] [ 1 2 3 <color> cleave-test ] unit-test
  23
  24 [ 1 2 3 ] [ 1 2 3 <color> \ cleave-test def>> call ] unit-test
  25
  26 : 2cleave-test ( a b -- c d e ) { [ 2array ] [ + ] [ - ] } 2cleave ;
  27
  28 [ { 1 2 } 3 -1 ] [ 1 2 2cleave-test ] unit-test
  29
  30 [ { 1 2 } 3 -1 ] [ 1 2 \ 2cleave-test def>> call ] unit-test
  31
  32 : spread-test ( a b c -- d e f ) { [ sq ] [ neg ] [ recip ] } spread ;
  33
  34 [ 16 -3 1/6 ] [ 4 3 6 spread-test ] unit-test
  35
  36 [ 16 -3 1/6 ] [ 4 3 6 \ spread-test def>> call ] unit-test
  37
  38 [ fixnum instance? ] must-infer
  39
  40 : bad-new-test ( -- obj ) V{ } new ;
  41
  42 [ bad-new-test ] must-infer
  43
  44 [ bad-new-test ] must-fail
  45
  46 ! Corner case if macro expansion calls 'infer', found by Doug
  47 DEFER: smart-combo ( quot -- )
  48
  49 \ smart-combo [ infer [ ] curry ] 1 define-transform
  50
  51 [ [ "a" "b" "c" ] smart-combo ] must-infer
  52
  53 [ [ [ "a" "b" ] smart-combo "c" ] smart-combo ] must-infer
  54
  55 : very-smart-combo ( quot -- ) smart-combo ; inline
  56
  57 [ [ "a" "b" "c" ] very-smart-combo ] must-infer
  58
  59 [ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer
  60
  61 ! Caveat found by Doug
  62 DEFER: curry-folding-test ( quot -- )
  63
  64 \ curry-folding-test [ length \ drop <repetition> >quotation ] 1 define-transform
  65
  66 { 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as
  67 { 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as
  68 { 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
  69
  70 [ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
  71 [ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
  72 [ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
  73 [ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test