namespaces: rework so a singleton isn't necessary

Make global foldable, and make the underlying global object a hashtable wrapper. Also, use a tuple instead of a generic array for the global box type.

basis/bootstrap/image/image.factor

@@ -11,7 +11,7 @@ definitions debugger quotations.private combinators
 combinators.short-circuit math.order math.private accessors
 slots.private generic.single.private compiler.units
 compiler.constants compiler.codegen.relocation fry locals
-bootstrap.image.syntax parser.notes ;
+bootstrap.image.syntax parser.notes namespaces.private ;
 IN: bootstrap.image
 
 : arch ( os cpu -- arch )
@@ -503,11 +503,12 @@ M: quotation '
     {
         dictionary source-files builtins
         update-map implementors-map
-    } [ [ bootstrap-word ] [ get 1array ] bi ] H{ } map>assoc
+    } [ [ bootstrap-word ] [ get global-box boa ] bi ] H{ } map>assoc
     {
         class<=-cache class-not-cache classes-intersect-cache
         class-and-cache class-or-cache next-method-quot-cache
-    } [ H{ } clone 1array ] H{ } map>assoc assoc-union
+    } [ H{ } clone global-box boa ] H{ } map>assoc assoc-union
+    global-hashtable boa
     bootstrap-global set ;
 
 : emit-jit-data ( -- )

basis/tools/deploy/shaker/shaker.factor

@@ -401,11 +401,9 @@ IN: tools.deploy.shaker
 : strip-globals ( stripped-globals -- )
     strip-globals? [
         "Stripping globals" show
-        global swap
+        global boxes>> swap
-        '[ drop _ member? not ] assoc-filter
+        '[ drop _ member? not ] assoc-filter!
-        [ drop string? not ] assoc-filter ! strip CLI args
+        [ drop string? not ] assoc-filter! drop ! strip CLI args
-        sift-assoc
-        OBJ-GLOBAL set-special-object
     ] [ drop ] if ;
 
 : strip-c-io ( -- )

core/namespaces/namespaces.factor

@@ -2,46 +2,46 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel vectors sequences sequences.private hashtables
 arrays kernel.private math strings assocs ;
+SLOT: boxes
+SLOT: value
+FROM: accessors => boxes>> value>> value<< ;
 IN: namespaces
 
 <PRIVATE
 
+TUPLE: global-hashtable
+    { boxes hashtable read-only } ;
+TUPLE: global-box value ;
+
+: (box-at) ( key globals -- box )
+    boxes>> 2dup at
+    [ 2nip ] [ [ f global-box boa ] 2dip [ set-at ] 2curry keep ] if* ; foldable
+
+: box-at ( key globals -- box )
+    (box-at) { global-box } declare ; inline
+
+M: global-hashtable at*
+    box-at value>> dup ; inline
+
+M: global-hashtable set-at
+    box-at value<< ; inline
+
+M: global-hashtable delete-at
+    box-at f swap value<< ; inline
+
 : namestack* ( -- namestack )
     CONTEXT-OBJ-NAMESTACK context-object { vector } declare ; inline
 : >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>
 
+: global ( -- g ) OBJ-GLOBAL special-object { global-hashtable } declare ; foldable
+
 : namespace ( -- namespace ) namestack* last ; inline
 : namestack ( -- namestack ) namestack* clone ;
 : set-namestack ( namestack -- )
     >vector CONTEXT-OBJ-NAMESTACK set-context-object ;
-: global ( -- g ) +globals+ ; inline
 : init-namespaces ( -- ) global 1array set-namestack ;
 : get ( variable -- value ) namestack* assoc-stack ; inline
 : set ( value variable -- ) namespace set-at ;