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.

diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index f162cd71fe9f3eceecbf034d0bca7adc166b64ee..a9d79cbef6a2273f93e0e49ac0858dad3ea07ce8 100755 (executable)
--- a/basis/bootstrap/image/image.factor
+++ b/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 ( -- )

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index be759da524e1b25c34721644294e4c12b6d7315a..dd65d6fac9b14cc79ac52481268ce03aa9b60b15 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/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
-        '[ drop _ member? not ] assoc-filter
-        [ drop string? not ] assoc-filter ! strip CLI args
-        sift-assoc
-        OBJ-GLOBAL set-special-object
+        global boxes>> swap
+        '[ drop _ member? not ] assoc-filter!
+        [ drop string? not ] assoc-filter! drop ! strip CLI args
     ] [ drop ] if ;
 
 : strip-c-io ( -- )

diff --git a/core/namespaces/namespaces.factor b/core/namespaces/namespaces.factor
index dc2b34a21b9ec143ac2055b5b8325576c0d3abf8..467086abc6cb47f9e21fbc1c02abbf023ef5a99d 100644 (file)
--- a/core/namespaces/namespaces.factor
+++ b/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
 
-: 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
+TUPLE: global-hashtable
+    { boxes hashtable read-only } ;
+TUPLE: global-box value ;
 
-: box-at ( key -- box )
-    get-global-hashtable
-    2dup at [ 2nip ] [ [ f 1array ] 2dip [ set-at ] 2curry keep ] if* ; foldable
+: (box-at) ( key globals -- box )
+    boxes>> 2dup at
+    [ 2nip ] [ [ f global-box boa ] 2dip [ set-at ] 2curry keep ] if* ; foldable
 
-: box> ( box -- value )
-    0 swap nth-unsafe ; inline
+: box-at ( key globals -- box )
+    (box-at) { global-box } declare ; inline
 
-: >box ( value box -- )
-    0 swap set-nth-unsafe ; inline
+M: global-hashtable at*
+    box-at value>> dup ; inline
 
-M: +globals+ at*
-    drop box-at box> dup ; inline
+M: global-hashtable set-at
+    box-at value<< ; inline
 
-M: +globals+ set-at
-    drop box-at >box ; inline
+M: global-hashtable delete-at
+    box-at f swap value<< ; inline
 
-M: +globals+ delete-at
-    drop box-at f swap >box ; inline
+: namestack* ( -- namestack )
+    CONTEXT-OBJ-NAMESTACK context-object { vector } declare ; inline
+: >n ( namespace -- ) namestack* push ;
+: ndrop ( -- ) namestack* pop* ;
 
 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 ;