USING: accessors arrays assocs hashtables kernel kernel.private math sequences vectors ; IN: namespaces2 > [ drop f global-box boa ] cache ; foldable : box-at ( key globals -- box ) (box-at) { global-box } declare ; inline M: global-hashtable at* boxes>> at* [ { global-box } declare value>> t ] [ drop f f ] if ; inline M: global-hashtable set-at box-at value<< ; inline M: global-hashtable delete-at box-at f swap value<< ; inline : (get-namestack) ( -- namestack ) CONTEXT-OBJ-NAMESTACK context-object { vector } declare ; inline : (set-namestack) ( namestack -- ) CONTEXT-OBJ-NAMESTACK set-context-object ; inline : >n ( namespace -- ) (get-namestack) push ; : ndrop ( -- ) (get-namestack) pop* ; PRIVATE> : global ( -- g ) OBJ-GLOBAL special-object { global-hashtable } declare ; foldable : namespace ( -- namespace ) (get-namestack) last ; inline : get-namestack ( -- namestack ) (get-namestack) clone ; : set-namestack ( namestack -- ) >vector (set-namestack) ; : init-namespaces ( -- ) global 1array set-namestack ; : get-global ( variable -- value ) global box-at value>> ; inline : set-global ( value variable -- ) global set-at ; inline : change-global ( variable quot -- ) [ [ get-global ] keep ] dip dip set-global ; inline : counter ( variable -- n ) [ 0 or 1 + dup ] change-global ; inline : initialize ( variable quot -- ) [ unless* ] curry change-global ; inline ERROR: get-failed variable hashtable ; ERROR: set-failed obj variable hashtable ; ERROR: change-failed variable hashtable ; : ensure-get-at ( variable hashtable -- variable hashtable ) 2dup last key? [ get-failed ] unless ; : ensure-set-at ( obj variable hashtable -- obj variable hashtable ) 2dup key? [ set-failed ] unless ; : ensure-change's-get-at ( variable hashtable -- variable hashtable ) 2dup last key? [ change-failed ] unless ; : get ( variable -- value ) (get-namestack) ensure-get-at assoc-stack ; inline : change's-get ( variable -- value ) (get-namestack) ensure-change's-get-at assoc-stack ; inline : set ( value variable -- ) namespace ensure-set-at set-at ; : change ( variable quot -- ) [ [ change's-get ] keep ] dip dip set ; inline : on ( variable -- ) t swap set ; inline : off ( variable -- ) f swap set ; inline : toggle ( variable -- ) [ not ] change ; inline : +@ ( n variable -- ) [ 0 or + ] change ; inline : inc ( variable -- ) 1 swap +@ ; inline : dec ( variable -- ) -1 swap +@ ; inline : with-variables ( ns quot -- ) swap >n call ndrop ; inline : with-scope ( quot -- ) 5 swap with-variables ; inline : with-variable ( value key quot -- ) [ associate ] dip with-variables ; inline : with-global ( quot -- ) [ global ] dip with-variables ; inline /* erg@erglinux:~/factor/basis/compiler$ find . -type f -print0 | xargs -0 sed -i 's/namespaces/namespaces2/g' erg@erglinux:~/factor/basis/compiler$ find . -type f -print0 | xargs -0 sed -i 's/namespaces2/namespaces/g' disable-optimizer f2 erg@erglinux:~/factor/basis/compiler$ find . -type f -print0 | xargs -0 sed -i 's/insn-classes get/insn-classes get-global/g' */