diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index f162cd71fe..a9d79cbef6 100755 --- 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 be759da524..dd65d6fac9 100755 --- 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 dc2b34a21b..467086abc6 100644 --- 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 > 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 ;