{
dictionary source-files builtins
update-map implementors-map
- } [ [ bootstrap-word ] [ get ] bi ] H{ } map>assoc
+ } [ [ bootstrap-word ] [ get 1array ] bi ] H{ } map>assoc
{
class<=-cache class-not-cache classes-intersect-cache
class-and-cache class-or-cache next-method-quot-cache
- } [ H{ } clone ] H{ } map>assoc assoc-union
+ } [ H{ } clone 1array ] H{ } map>assoc assoc-union
bootstrap-global set ;
: emit-jit-data ( -- )
-USING: kernel namespaces tools.test words ;
+USING: assocs compiler.tree.debugger kernel namespaces
+tools.test words ;
IN: namespaces.tests
H{ } clone "test-namespace" set
[ t ] [ toggle-test [ on ] [ get ] bi ] unit-test
[ f ] [ toggle-test [ off ] [ get ] bi ] unit-test
+[ t ] [ [ test-initialize get-global ] { at* set-at } inlined? ] unit-test
+[ t ] [ [ test-initialize set-global ] { at* set-at } inlined? ] unit-test
! Copyright (C) 2003, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel vectors sequences hashtables
+USING: kernel vectors sequences sequences.private hashtables
arrays kernel.private math strings assocs ;
IN: namespaces
: >n ( namespace -- ) namestack* push ;
: ndrop ( -- ) namestack* pop* ;
+SINGLETON: +globals+
+
+: get-global-hashtable ( -- table )
+ OBJ-GLOBAL special-object { hashtable } declare ; inline
+
+: box-at ( key -- box )
+ get-global-hashtable
+ 2dup at [ 2nip ] [ [ f 1array ] 2dip [ set-at ] 2curry keep ] if* ; foldable
+
+: box> ( box -- value )
+ 0 swap nth-unsafe ; inline
+
+: >box ( value box -- )
+ 0 swap set-nth-unsafe ; inline
+
+M: +globals+ at*
+ drop box-at box> dup ; inline
+
+M: +globals+ set-at
+ drop box-at >box ; inline
+
+M: +globals+ delete-at
+ drop box-at f swap >box ; inline
+
PRIVATE>
: namespace ( -- namespace ) namestack* last ; inline
: namestack ( -- namestack ) namestack* clone ;
: set-namestack ( namestack -- )
>vector CONTEXT-OBJ-NAMESTACK set-context-object ;
-: global ( -- g ) OBJ-GLOBAL special-object { hashtable } declare ; inline
+: global ( -- g ) +globals+ ; inline
: init-namespaces ( -- ) global 1array set-namestack ;
: get ( variable -- value ) namestack* assoc-stack ; inline
: set ( value variable -- ) namespace set-at ;