1 ! Copyright (C) 2009 Slava Pestov, Eduardo Cavazos, Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: fry tools.test math prettyprint kernel io arrays
4 sequences eval accessors ;
7 SYMBOLS: a b c d e f g h ;
9 { [ ] } [ '[ ] ] unit-test
10 { [ + ] } [ '[ + ] ] unit-test
11 { [ 1 ] } [ 1 '[ _ ] ] unit-test
12 { [ 1 ] } [ [ 1 ] '[ @ ] ] unit-test
13 { [ 1 2 ] } [ [ 1 ] [ 2 ] '[ @ @ ] ] unit-test
15 { [ 1 2 a ] } [ 1 2 '[ _ _ a ] ] unit-test
16 { [ 1 2 ] } [ 1 2 '[ _ _ ] ] unit-test
17 { [ a 1 2 ] } [ 1 2 '[ a _ _ ] ] unit-test
18 { [ 1 2 a ] } [ [ 1 ] [ 2 ] '[ @ @ a ] ] unit-test
19 { [ 1 a 2 b ] } [ 1 2 '[ _ a _ b ] ] unit-test
20 { [ 1 a 2 b ] } [ 1 [ 2 ] '[ _ a @ b ] ] unit-test
21 { [ a 1 b ] } [ 1 '[ a _ b ] ] unit-test
23 { [ a 1 b ] } [ [ 1 ] '[ a @ b ] ] unit-test
24 { [ a 1 2 ] } [ [ 1 ] [ 2 ] '[ a @ @ ] ] unit-test
26 { [ a [ 1 ] b ] } [ 1 '[ a [ _ ] b ] ] unit-test
27 { [ a 1 b [ c 2 d ] e 3 f ] } [ 1 2 3 '[ a _ b [ c _ d ] e _ f ] ] unit-test
28 { [ a 1 b [ c 2 d [ e 3 f ] ] g 4 h ] } [ 1 2 3 4 '[ a _ b [ c _ d [ e _ f ] ] g _ h ] ] unit-test
29 { [ a 1 b [ [ c 2 d ] e 3 f ] g 4 h ] } [ 1 2 3 4 '[ a _ b [ [ c _ d ] e _ f ] g _ h ] ] unit-test
31 { [ 3 + ] } [ 3 '[ _ + ] ] unit-test
33 { [ 1 3 + ] } [ 1 3 '[ _ _ + ] ] unit-test
35 { [ 1 + ] } [ 1 [ + ] '[ _ @ ] ] unit-test
37 { [ 1 + . ] } [ 1 [ + ] '[ _ @ . ] ] unit-test
39 { [ + - ] } [ [ + ] [ - ] '[ @ @ ] ] unit-test
41 { [ "a" write "b" print ] }
42 [ "a" "b" '[ _ write _ print ] ] unit-test
45 1 '[ [ _ ] dip / ] 2 swap call
48 { { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } } [
49 1 '[ [ _ ] 2dip 3array ]
50 { "a" "b" "c" } { "A" "B" "C" } rot 2map
53 { { { 1 "a" } { 1 "b" } { 1 "c" } } } [
55 { "a" "b" "c" } swap map
58 { { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } } [
59 1 2 '[ [ _ ] dip _ 3array ]
60 { "a" "b" "c" } swap map
63 : funny-dip ( obj quot -- ) '[ [ @ ] dip ] call ; inline
65 { "hi" 3 } [ "h" "i" 3 [ append ] funny-dip ] unit-test
68 3 1 '[ _ <iota> [ _ + ] map ] call
71 { { 1 { 2 { 3 } } } } [
72 1 2 3 '[ _ [ _ [ _ 1array ] call 2array ] call 2array ] call
75 { 1 1 } [ '[ [ [ _ ] ] ] ] must-infer-as
78 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
82 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
85 [ "USING: fry locals.backend ; f '[ load-local _ ]" eval( -- quot ) ]
86 [ error>> >r/r>-in-fry-error? ] must-fail-with
88 { { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } } [
89 1 2 3 4 '[ "a" _ 2array "b" _ 2array "c" _ 2array "d" _ 2array 4array ] call
92 { { 1 [ 2 { 3 4 } ] } } [ 1 2 3 4 '{ _ [ _ { _ _ } ] } ] unit-test
93 { H{ { 1 1 } { 2 2 } { 3 4 } } } [ 1 2 3 4 'H{ { 1 _ } { _ 2 } { _ _ } } ] unit-test
94 { HS{ 1 [ 2 { 3 } ] } } [ 1 2 3 'HS{ _ [ _ { _ } ] } ] unit-test