2 ! USING: kernel quotations namespaces sequences assocs.lib ;
4 USING: kernel namespaces namespaces.private quotations sequences
5 assocs.lib math.parser math generalizations locals mirrors ;
9 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
11 : save-namestack ( quot -- ) namestack >r call r> set-namestack ;
13 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ;
17 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
19 : set* ( val var -- ) namestack* set-assoc-stack ;
22 : get-building-seq ( n -- seq )
23 building-seq get nth ;
25 : n, ( obj n -- ) get-building-seq push ;
26 : n% ( seq n -- ) get-building-seq push-all ;
27 : n# ( num n -- ) >r number>string r> n% ;
29 : 0, ( obj -- ) 0 n, ;
30 : 0% ( seq -- ) 0 n% ;
31 : 0# ( num -- ) 0 n# ;
32 : 1, ( obj -- ) 1 n, ;
33 : 1% ( seq -- ) 1 n% ;
34 : 1# ( num -- ) 1 n# ;
35 : 2, ( obj -- ) 2 n, ;
36 : 2% ( seq -- ) 2 n% ;
37 : 2# ( num -- ) 2 n# ;
38 : 3, ( obj -- ) 3 n, ;
39 : 3% ( seq -- ) 3 n% ;
40 : 3# ( num -- ) 3 n# ;
41 : 4, ( obj -- ) 4 n, ;
42 : 4% ( seq -- ) 4 n% ;
43 : 4# ( num -- ) 4 n# ;
45 MACRO:: nmake ( quot exemplars -- )
46 [let | n [ exemplars length ] |
50 [ 0 swap new-resizable ] map
56 exemplars [ like ] 2map
62 : make-object ( quot class -- object )
63 new [ <mirror> swap bind ] keep ; inline
65 : with-object ( object quot -- )
66 [ <mirror> ] dip bind ; inline