core/namespaces/namespaces.factor

   1 ! Copyright (C) 2003, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel vectors sequences hashtables
   4 arrays kernel.private math strings assocs ;
   5 IN: namespaces
   6
   7 <PRIVATE
   8
   9 : namestack* ( -- namestack ) 0 getenv { vector } declare ; inline
  10 : >n ( namespace -- ) namestack* push ;
  11 : ndrop ( -- ) namestack* pop* ;
  12
  13 PRIVATE>
  14
  15 : namespace ( -- namespace ) namestack* peek ;
  16 : namestack ( -- namestack ) namestack* clone ;
  17 : set-namestack ( namestack -- ) >vector 0 setenv ;
  18 : global ( -- g ) 21 getenv { hashtable } declare ; inline
  19 : init-namespaces ( -- ) global 1array set-namestack ;
  20 : get ( variable -- value ) namestack* assoc-stack ; flushable
  21 : set ( value variable -- ) namespace set-at ;
  22 : on ( variable -- ) t swap set ; inline
  23 : off ( variable -- ) f swap set ; inline
  24 : get-global ( variable -- value ) global at ;
  25 : set-global ( value variable -- ) global set-at ;
  26 : change ( variable quot -- ) >r dup get r> rot slip set ; inline
  27 : +@ ( n variable -- ) [ 0 or + ] change ;
  28 : inc ( variable -- ) 1 swap +@ ; inline
  29 : dec ( variable -- ) -1 swap +@ ; inline
  30 : bind ( ns quot -- ) swap >n call ndrop ; inline
  31 : counter ( variable -- n ) global [ dup inc get ] bind ;
  32
  33 : make-assoc ( quot exemplar -- hash )
  34     20 swap new-assoc [ >n call ndrop ] keep ; inline
  35
  36 : with-scope ( quot -- )
  37     H{ } clone >n call ndrop ; inline
  38
  39 : with-variable ( value key quot -- )
  40     >r associate >n r> call ndrop ; inline