# scope.tcl --
#
#       Provides simple nested command scopes that have a limited lifespan.
#       These scopes are simply dictionaries of command aliases (much like an
#       ensemble -map) that exist only for the scope of the executing code
#       block.
#

package require Tcl     8.5
package provide scope   1.0

namespace eval scope {
    namespace export {[a-z]*}
    namespace ensemble create

    # Install an unknown handler that does the real lookup of commands in the
    # scope.
    namespace unknown resolve

    # with scope body --
    #
    #       Execute body within the scope defined by the dictionary $scope. Each
    #       element in the dictionary defines a mapping from a command name to a
    #       command prefix as if they were individually interp aliased. However,
    #       these command names are only visible within this scope during its
    #       execution. Note: two variables will be visible: $scope (the current
    #       scope dictionary) and $block (the currently executing code block).
    #
    proc with {scope block} {
        dict with scope $block
    }

    # resolve cmd args ... --
    #
    #       Resolves a command name in the currently active scope. This command
    #       assumes that there is a variable "scope" in the caller's scope that
    #       contains the current command dictionary. This command can be used
    #       with [namespace unknown].
    #
    proc resolve {cmd args} {
        upvar 1 scope scope
        if {[dict exists $scope $cmd]} {
            uplevel 1 [dict get $scope $cmd] $args
        } else {
            return -code error "no such command: \"$cmd\""
        }
    }

    # let name = args... --
    #
    #       Binds a name within the current scope. Also does auto-expand of the
    #       leading word.
    #
    proc let {name = cmd args} {
        upvar 1 scope scope
        dict set scope $name [list {*}$cmd {*}$args]
    }

    # apply scope params body args... -
    #
    #       A version of ::apply that takes an extra scope dict which it
    #       restores before evaluating the procedure.
    #
    proc apply {scope params body args} {
        if {[llength $args] != [llength $params]} {
            error "wrong # args: should be \"$params\""
        } else {
            set scope [dict merge [ZipDict $params $args] $scope]
            with $scope $body
        }
    }

    # lambda params body --
    #
    #       Constructor for lambda expressions (anonymous procedures) that
    #       captures the current scope dictionary, allowing for lexical scoping.
    #
    proc lambda {params body} {
        upvar 1 scope scope
        if {![info exists scope]} { set scope [dict create] }
        list ::scope::apply $scope $params $body
    }

    # func name params body --
    #
    #       Just as you'd expect, only different :)
    #
    proc func {name params body} {
        upvar 1 scope scope
        if {![info exists scope]} { set scope [dict create] }
        dict set scope $name [lambda $params $body]
    }

    # block body --
    #
    #       Evaluates $body in a fresh lexical scope.
    #
    proc block body {
        upvar 1 scope scope
        if {![info exists scope]} { set scope [dict create] } ;# naughty!
        with $scope $body
    }

    # helper
    proc ZipDict {as bs} {
        set ds [dict create]
        foreach a $as b $bs { dict set ds $a $b }
        return $ds
    }
}

# Create some TOOT-style command dispatchers for existing ensembles:
proc chan: {self method args} { uplevel 1 [linsert $args 0 chan $method $self] }
proc dict: {self method args} { uplevel 1 [linsert $args 0 dict $method $self] }

# Execute everything in a "global" scope, to bring the scope commands into scope
# themselves:
scope block {

    # A simple command that records when it is evaluated
    let do = [lambda {log body} {
        log puts "EXECUTING [list $body]"
        uplevel 1 $body
        log puts "DONE"
    }]
    do {chan: stderr} { puts {This is a test...} }

    let neil = dict: {
        name        {Neil Madden}
        age         27
    }
    func print p {
        puts [list Name [p get name]]
        puts [list Age [p get age]]
    }
    print neil ;# Magic!

    # Note - lexical scoping!
    block {
        do {chan: stdout} { puts Hello! }
    }

    proc const val { return $val }

    func person {name age} {
        let name = const $name
        let age  = const $name
        lambda method { method }
    }

    let neil = [person {Neil Madden} 27]
    puts [list Name [neil name]]
    puts [list Age [neil age]]
}