Paste: dynamic-variables

! Copyright (C) 2014 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs continuations fry hashtables kernel math sequences
sequences.private variables vectors ;
IN: dynamic-variables

TYPED-GLOBAL: new-namestack hashtable
! new-namestack [ H{ } clone ] initialize

<PRIVATE

: push-new-var ( value key hash -- )
    [ 1vector ] 2dip set-at ;

: push-var ( value key -- )
    new-namestack
    2dup ?at [
        2nip push
    ] [
        drop push-new-var
    ] if ;

: push-vars ( assoc -- )
    [ swap push-var ] assoc-each ;

: get-last ( seq -- elt/f ? )
    [ length 1 - ] keep over 0 <
    [ 2drop f f ] [ nth-unsafe t ] if ; inline

ERROR: variable-undefined name ;

: get-var-vector ( name -- vector )
    new-namestack ?at [ variable-undefined ] unless ;

: pop-var ( name -- )
    get-var-vector pop* ;
    ! dup get-var-vector
    ! dup length 1 >
    ! [ pop* drop ]
    ! [ drop new-namestack delete-at ] if ;

: pop-vars ( assoc -- )
    [ drop pop-var ] assoc-each ;

PRIVATE>

: get-var ( name -- value )
    get-var-vector last ;

: set-var ( value name -- )
    get-var-vector set-last ;

: with-vars ( assoc quot -- )
    over dup '[ [ _ push-vars @ _ pop-vars ] [ _ pop-vars rethrow ] recover ] call ; inline

! : with-var ( value key quot -- )
    ! over dup '[ [ _ _ push-var @ _ pop-var ] [ _ pop-var rethrow ] recover ] call ; inline

: with-var ( value key quot -- )
    over '[ _ _ push-var @ _ pop-var ] call ; inline