1 !:folding=indent:collapseFolds=1:
5 ! Copyright (C) 2004 Slava Pestov.
7 ! Redistribution and use in source and binary forms, with or without
8 ! modification, are permitted provided that the following conditions are met:
10 ! 1. Redistributions of source code must retain the above copyright notice,
11 ! this list of conditions and the following disclaimer.
13 ! 2. Redistributions in binary form must reproduce the above copyright notice,
14 ! this list of conditions and the following disclaimer in the documentation
15 ! and/or other materials provided with the distribution.
17 ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
18 ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
19 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
20 ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
22 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
23 ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
24 ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
25 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
26 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
40 : namestack* ( -- ns ) 3 getenv ;
41 : set-namestack* ( ns -- ) 3 setenv ;
43 : global ( -- g ) 4 getenv ;
44 : set-global ( g -- ) 4 setenv ;
46 : init-namespaces ( -- )
47 64 <vector> set-namestack* global >n ;
49 : namespace-buckets 23 ;
51 : <namespace> ( -- n )
52 #! Create a new namespace.
53 namespace-buckets <hashtable> ;
55 : get* ( var namespace -- value ) hash ;
56 : set* ( value variable namespace -- ) set-hash ;
59 : namestack-search ( var n -- )
60 #! Internal word for searching the namestack.
64 pred 2dup >r >r namestack* vector-nth hash* dup [
65 r> drop r> drop ( [ key | value ] -- ) cdr ( found )
67 drop r> r> namestack-search ( check next entry )
71 : get ( variable -- value )
72 #! Push the value of a variable by searching the namestack
74 namestack* vector-length namestack-search ;
76 : set ( value variable -- ) namespace set* ;
77 : put ( variable value -- ) namespace put* ;
79 : vars ( -- list ) namespace hash-keys ;
80 : values ( -- list ) namespace hash-values ;
81 : vars-values ( -- list ) namespace hash>alist ;
83 ! We don't have bound objects in native Factor.
84 : namespace? hashtable? ;
87 : has-namespace? hashtable? ;