basis/compiler/tests/curry.factor

   1 USING: tools.test quotations math kernel sequences
   2 assocs namespaces make compiler.units ;
   3 IN: compiler.tests
   4
   5 [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
   6 [ 3 ] [ [ 5 [ 2 - ] curry call ] compile-call ] unit-test
   7 [ 3 ] [ [ 5 2 [ - ] 2curry call ] compile-call ] unit-test
   8 [ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-call ] unit-test
   9 [ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-call ] unit-test
  10 [ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test
  11 [ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test
  12
  13 [ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test
  14
  15 [ [ 5 2 - ] ] [ 5 [ [ 2 - ] curry ] compile-call >quotation ] unit-test
  16 [ [ 5 2 - ] ] [ [ 5 [ 2 - ] curry ] compile-call >quotation ] unit-test
  17 [ [ 5 2 - ] ] [ [ 5 2 [ - ] 2curry ] compile-call >quotation ] unit-test
  18 [ [ 5 2 - ] ] [ 5 [ 2 [ - ] 2curry ] compile-call >quotation ] unit-test
  19 [ [ 5 2 - ] ] [ 5 2 [ [ - ] 2curry ] compile-call >quotation ] unit-test
  20
  21 [ [ 6 2 + ] ]
  22 [
  23     2 5
  24     [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry ]
  25     compile-call >quotation
  26 ] unit-test
  27
  28 [ 8 ]
  29 [
  30     2 5
  31     [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry call ]
  32     compile-call
  33 ] unit-test
  34
  35 : foobar ( quot -- )
  36     dup slip swap [ foobar ] [ drop ] if ; inline
  37
  38 [ ] [ [ [ f ] foobar ] compile-call ] unit-test
  39
  40 [ { 6 7 8 } ] [ { 1 2 3 } 5 [ [ + ] curry map ] compile-call ] unit-test
  41 [ { 6 7 8 } ] [ { 1 2 3 } [ 5 [ + ] curry map ] compile-call ] unit-test
  42
  43 : funky-assoc>map
  44     [
  45         [ call f ] curry assoc-find 3drop
  46     ] { } make ; inline
  47
  48 [ t ] [
  49     global [ [ drop , ] funky-assoc>map ] compile-call
  50     global keys =
  51 ] unit-test
  52
  53 [ 3 ] [ 1 [ 2 ] [ curry [ 3 ] [ 4 ] if ] compile-call ] unit-test
  54
  55 [ 3 ] [ t [ 3 [ ] curry 4 [ ] curry if ] compile-call ] unit-test
  56
  57 [ 3 ] [ t [ 3 [ ] curry [ 4 ] if ] compile-call ] unit-test
  58
  59 [ 4 ] [ f [ 3 [ ] curry 4 [ ] curry if ] compile-call ] unit-test
  60
  61 [ 4 ] [ f [ [ 3 ] 4 [ ] curry if ] compile-call ] unit-test