extra/namespaces/lib/lib.factor

   1
   2 ! USING: kernel quotations namespaces sequences assocs.lib ;
   3
   4 USING: kernel namespaces namespaces.private quotations sequences
   5        assocs.lib math.parser math sequences.lib locals mirrors ;
   6
   7 IN: namespaces.lib
   8
   9 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  10
  11 : save-namestack ( quot -- ) namestack >r call r> set-namestack ;
  12
  13 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  14
  15 : make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ;
  16
  17 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  18
  19 : set* ( val var -- ) namestack* set-assoc-stack ;
  20
  21 SYMBOL: building-seq
  22 : get-building-seq ( n -- seq )
  23     building-seq get nth ;
  24
  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% ;
  28
  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# ;
  44
  45 MACRO:: nmake ( quot exemplars -- )
  46     [let | n [ exemplars length ] |
  47         [
  48             [
  49                 exemplars
  50                 [ 0 swap new-resizable ] map
  51                 building-seq set
  52
  53                 quot call
  54
  55                 building-seq get
  56                 exemplars [ like ] 2map
  57                 n firstn
  58             ] with-scope
  59         ]
  60     ] ;
  61
  62 : make-object ( quot class -- object )
  63     new [ <mirror> swap bind ] keep ; inline
  64
  65 : with-object ( object quot -- )
  66     [ <mirror> ] dip bind ; inline