namespaces: make set-global/get-global foldable

Store the globals hashtable as an array of boxes so that the key-to-reference mapping is constant. Use a singleton and an unfoldable "box-at" word so that get-global and set-global optimize to direct operations on the associated box when the variable name is a compile-time constant. Fixes #200.
db4
Joe Groff 2011-11-26 20:20:55 -08:00
parent 8b18af0335
commit a1b730e867
3 changed files with 32 additions and 5 deletions

View File

@ -503,11 +503,11 @@ M: quotation '
{ {
dictionary source-files builtins dictionary source-files builtins
update-map implementors-map 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<=-cache class-not-cache classes-intersect-cache
class-and-cache class-or-cache next-method-quot-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 ; bootstrap-global set ;
: emit-jit-data ( -- ) : emit-jit-data ( -- )

View File

@ -1,4 +1,5 @@
USING: kernel namespaces tools.test words ; USING: assocs compiler.tree.debugger kernel namespaces
tools.test words ;
IN: namespaces.tests IN: namespaces.tests
H{ } clone "test-namespace" set H{ } clone "test-namespace" set
@ -35,3 +36,5 @@ SYMBOL: toggle-test
[ t ] [ toggle-test [ on ] [ get ] bi ] unit-test [ t ] [ toggle-test [ on ] [ get ] bi ] unit-test
[ f ] [ toggle-test [ off ] [ 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

View File

@ -1,6 +1,6 @@
! Copyright (C) 2003, 2010 Slava Pestov. ! Copyright (C) 2003, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 ; arrays kernel.private math strings assocs ;
IN: namespaces IN: namespaces
@ -11,13 +11,37 @@ IN: namespaces
: >n ( namespace -- ) namestack* push ; : >n ( namespace -- ) namestack* push ;
: ndrop ( -- ) namestack* pop* ; : 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> PRIVATE>
: namespace ( -- namespace ) namestack* last ; inline : namespace ( -- namespace ) namestack* last ; inline
: namestack ( -- namestack ) namestack* clone ; : namestack ( -- namestack ) namestack* clone ;
: set-namestack ( namestack -- ) : set-namestack ( namestack -- )
>vector CONTEXT-OBJ-NAMESTACK set-context-object ; >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 ; : init-namespaces ( -- ) global 1array set-namestack ;
: get ( variable -- value ) namestack* assoc-stack ; inline : get ( variable -- value ) namestack* assoc-stack ; inline
: set ( value variable -- ) namespace set-at ; : set ( value variable -- ) namespace set-at ;