namespaces: rename namestack* to (get-namestack) for consistency.
parent
bee46baecb
commit
0216f9f6d1
|
@ -60,7 +60,7 @@ gc
|
||||||
|
|
||||||
wrap probe
|
wrap probe
|
||||||
|
|
||||||
namestack*
|
(get-namestack)
|
||||||
|
|
||||||
layout-of
|
layout-of
|
||||||
} compile-unoptimized
|
} compile-unoptimized
|
||||||
|
|
|
@ -358,9 +358,9 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y )
|
||||||
|
|
||||||
{ t 3 5 } [
|
{ t 3 5 } [
|
||||||
[
|
[
|
||||||
namestack*
|
(get-namestack)
|
||||||
3 "x" set callback-3 [ callback_test_1 ] with-callback
|
3 "x" set callback-3 [ callback_test_1 ] with-callback
|
||||||
namestack* eq?
|
(get-namestack) eq?
|
||||||
"x" get "x" get-global
|
"x" get "x" get-global
|
||||||
] with-scope
|
] with-scope
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -66,11 +66,11 @@ ABOUT: "namespaces"
|
||||||
|
|
||||||
HELP: get
|
HELP: get
|
||||||
{ $values { "variable" "a variable, by convention a symbol" } { "value" { $maybe "the value" } } }
|
{ $values { "variable" "a variable, by convention a symbol" } { "value" { $maybe "the value" } } }
|
||||||
{ $description "Searches the name stack for a namespace containing the variable, and outputs the associated value. If no such namespace is found, outputs " { $link f } "." } ;
|
{ $description "Searches the namestack for a namespace containing the variable, and outputs the associated value. If no such namespace is found, outputs " { $link f } "." } ;
|
||||||
|
|
||||||
HELP: set
|
HELP: set
|
||||||
{ $values { "value" "the new value" } { "variable" "a variable, by convention a symbol" } }
|
{ $values { "value" "the new value" } { "variable" "a variable, by convention a symbol" } }
|
||||||
{ $description "Assigns a value to the variable in the namespace at the top of the name stack." }
|
{ $description "Assigns a value to the variable in the namespace at the top of the namestack." }
|
||||||
{ $side-effects "variable" } ;
|
{ $side-effects "variable" } ;
|
||||||
|
|
||||||
HELP: off
|
HELP: off
|
||||||
|
@ -165,27 +165,27 @@ HELP: set-global
|
||||||
{ $description "Assigns a value to the variable in the global namespace." }
|
{ $description "Assigns a value to the variable in the global namespace." }
|
||||||
{ $side-effects "variable" } ;
|
{ $side-effects "variable" } ;
|
||||||
|
|
||||||
HELP: namestack*
|
HELP: (get-namestack)
|
||||||
{ $values { "namestack" "a vector of assocs" } }
|
{ $values { "namestack" "a vector of assocs" } }
|
||||||
{ $description "Outputs the current name stack." } ;
|
{ $description "Outputs the current namestack." } ;
|
||||||
|
|
||||||
HELP: get-namestack
|
HELP: get-namestack
|
||||||
{ $values { "namestack" "a vector of assocs" } }
|
{ $values { "namestack" "a vector of assocs" } }
|
||||||
{ $description "Outputs a copy of the current name stack." } ;
|
{ $description "Outputs a copy of the current namestack." } ;
|
||||||
|
|
||||||
HELP: set-namestack
|
HELP: set-namestack
|
||||||
{ $values { "namestack" "a vector of assocs" } }
|
{ $values { "namestack" "a vector of assocs" } }
|
||||||
{ $description "Replaces the name stack with a copy of the given vector." } ;
|
{ $description "Replaces the namestack with a copy of the given vector." } ;
|
||||||
|
|
||||||
HELP: >n
|
HELP: >n
|
||||||
{ $values { "namespace" assoc } }
|
{ $values { "namespace" assoc } }
|
||||||
{ $description "Pushes a namespace on the name stack." } ;
|
{ $description "Pushes a namespace on the namestack." } ;
|
||||||
|
|
||||||
HELP: ndrop
|
HELP: ndrop
|
||||||
{ $description "Pops a namespace from the name stack." } ;
|
{ $description "Pops a namespace from the namestack." } ;
|
||||||
|
|
||||||
HELP: init-namespaces
|
HELP: init-namespaces
|
||||||
{ $description "Resets the name stack to its initial state, holding a single copy of the global namespace." }
|
{ $description "Resets the namestack to its initial state, holding a single copy of the global namespace." }
|
||||||
$low-level-note ;
|
$low-level-note ;
|
||||||
|
|
||||||
HELP: initialize
|
HELP: initialize
|
||||||
|
|
|
@ -31,39 +31,44 @@ M: global-hashtable set-at
|
||||||
M: global-hashtable delete-at
|
M: global-hashtable delete-at
|
||||||
box-at f swap value<< ; inline
|
box-at f swap value<< ; inline
|
||||||
|
|
||||||
: namestack* ( -- namestack )
|
: (get-namestack) ( -- namestack )
|
||||||
CONTEXT-OBJ-NAMESTACK context-object { vector } declare ; inline
|
CONTEXT-OBJ-NAMESTACK context-object { vector } declare ; inline
|
||||||
|
|
||||||
: >n ( namespace -- ) namestack* push ;
|
: (set-namestack) ( namestack -- )
|
||||||
|
CONTEXT-OBJ-NAMESTACK set-context-object ; inline
|
||||||
|
|
||||||
: ndrop ( -- ) namestack* pop* ;
|
: >n ( namespace -- ) (get-namestack) push ;
|
||||||
|
|
||||||
|
: ndrop ( -- ) (get-namestack) pop* ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: global ( -- g )
|
: global ( -- g )
|
||||||
OBJ-GLOBAL special-object { global-hashtable } declare ; foldable
|
OBJ-GLOBAL special-object { global-hashtable } declare ; foldable
|
||||||
|
|
||||||
: namespace ( -- namespace ) namestack* last ; inline
|
: namespace ( -- namespace ) (get-namestack) last ; inline
|
||||||
: get-namestack ( -- namestack ) namestack* clone ;
|
: get-namestack ( -- namestack ) (get-namestack) clone ;
|
||||||
: set-namestack ( namestack -- )
|
: set-namestack ( namestack -- ) >vector (set-namestack) ;
|
||||||
>vector CONTEXT-OBJ-NAMESTACK set-context-object ;
|
|
||||||
: init-namespaces ( -- ) global 1array set-namestack ;
|
: init-namespaces ( -- ) global 1array set-namestack ;
|
||||||
: get ( variable -- value ) namestack* assoc-stack ; inline
|
|
||||||
: set ( value variable -- ) namespace set-at ;
|
|
||||||
: change ( variable quot -- ) [ [ get ] keep ] dip dip set ; inline
|
|
||||||
: on ( variable -- ) t swap set ; inline
|
|
||||||
: off ( variable -- ) f swap set ; inline
|
|
||||||
: get-global ( variable -- value ) global box-at value>> ; inline
|
: get-global ( variable -- value ) global box-at value>> ; inline
|
||||||
: set-global ( value variable -- ) global set-at ; inline
|
: set-global ( value variable -- ) global set-at ; inline
|
||||||
: change-global ( variable quot -- )
|
: change-global ( variable quot -- )
|
||||||
[ [ get-global ] keep ] dip dip set-global ; inline
|
[ [ 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
|
||||||
|
|
||||||
|
: get ( variable -- value ) (get-namestack) assoc-stack ; inline
|
||||||
|
: set ( value variable -- ) namespace set-at ;
|
||||||
|
: change ( variable quot -- ) [ [ get ] keep ] dip dip set ; inline
|
||||||
|
: on ( variable -- ) t swap set ; inline
|
||||||
|
: off ( variable -- ) f swap set ; inline
|
||||||
: toggle ( variable -- ) [ not ] change ; inline
|
: toggle ( variable -- ) [ not ] change ; inline
|
||||||
: +@ ( n variable -- ) [ 0 or + ] change ; inline
|
: +@ ( n variable -- ) [ 0 or + ] change ; inline
|
||||||
: inc ( variable -- ) 1 swap +@ ; inline
|
: inc ( variable -- ) 1 swap +@ ; inline
|
||||||
: dec ( variable -- ) -1 swap +@ ; inline
|
: dec ( variable -- ) -1 swap +@ ; inline
|
||||||
|
|
||||||
: with-variables ( ns quot -- ) swap >n call ndrop ; inline
|
: with-variables ( ns quot -- ) swap >n call ndrop ; inline
|
||||||
: counter ( variable -- n ) [ 0 or 1 + dup ] change-global ; inline
|
|
||||||
: with-scope ( quot -- ) 5 <hashtable> swap with-variables ; inline
|
: with-scope ( quot -- ) 5 <hashtable> swap with-variables ; inline
|
||||||
: with-variable ( value key quot -- ) [ associate ] dip with-variables ; inline
|
: with-variable ( value key quot -- ) [ associate ] dip with-variables ; inline
|
||||||
: with-global ( quot -- ) [ global ] dip with-variables ; inline
|
: with-global ( quot -- ) [ global ] dip with-variables ; inline
|
||||||
: initialize ( variable quot -- ) [ unless* ] curry change-global ; inline
|
|
||||||
|
|
Loading…
Reference in New Issue