#  (C) Copyright David Abrahams 2001. Permission to copy, use, modify, sell and
#  distribute this software is granted provided this copyright notice appears in
#  all copies. This software is provided "as is" without express or implied
#  warranty, and with no claim as to its suitability for any purpose.

rule ungrist ( names * )
{
    local result ;
    for local name in $(names)
    {
        local stripped = [ SUBST $(name) ^<(.*)>$ $1 ] ;
        if ! $(stripped)
        {
            ECHO *** error: in ungrist $(names) ;
            EXIT *** $(name) is not of the form <.*> ;
        }
        result += $(stripped) ;
    }
    return $(result) ;
}

# Return the file of the caller of the rule that called caller-file.
rule caller-file ( )
{
    local bt = [ BACKTRACE ] ;
    return $(bt[9]) ;
}

# Returns the module-local value of a variable.  This is the most
# reliable way to examine a module-local variable in a different
# module; it eliminates issues of name shadowing due to dynamic
# scoping.
rule peek ( module-name variable )
{
    module $(module-name)
    {
        module local $(<[2]) ;
        return $($(<[2])) ;
    }
}

# Sets the module-local value of a variable.  This is the most
# reliable way to set a module-local variable in a different module;
# it eliminates issues of name shadowing due to dynamic scoping.
rule poke ( module-name variable : value * )
{
    module $(module-name)
    {
        module local $($(<[2])) = $(2) ;
    }
}

local rule __test__ ( )
{
    import assert ;
    assert.result foo bar : ungrist <foo> <bar> ;

    module utility.__test__
    {
        module local foo = bar ;
    }
    assert.result bar :  peek utility.__test__ foo ;
    poke utility.__test__ foo : bar baz ;
    assert.result bar baz :  peek utility.__test__ foo ;
}