#! /bin/env tclsh

# # ## ### ##### ######## #############
# copyright
#
#     2018
#
#     Poor Yorick
# # ## ### ##### ######## #############

namespace ensemble create
namespace export *

proc .method {_ name args} {
	if {![llength $args]} {
		lappend args $name
	}
	set args [linsert $args[set args {}] 1 $_]
	set map [namespace ensemble configure $_ -map]
	dict set map $name $args 
	uplevel 1 [list ::namespace ensemble configure $_ -map $map]
	return
}
.method [namespace current] .method


proc $ {_ name args} {
	namespace upvar [$_ .namespace] $name var
	if {[llength $args]} {
		if {[llength $args] > 1} {
			error [list {wrong # args}]
		}
		set var [lindex $args 0]
	}
	return $var
}
.method [namespace current] $


proc .as {_ other name args} {
	set map [namespace ensemble configure $_ -map]
	set cmd [dict get $map $name]
	if {[lindex $name 1] ne $_} {
		error [list {not a method} $name]
	}
	set cmd [lreplace $cmd 1 1 $other]
	::tailcall {*}$cmd
}
.method [namespace current] .as


proc .eval {_ args} {
	::tailcall ::namespace eval [$_ .namespace] {*}$args
}
.method [namespace current] .eval 


proc .insert {_ name} {
	set unknown1 [namespace ensemble configure $_ -unknown]
	set prototype1 [namespace ensemble configure $_ -prototype]

	if {[llength $unknown1]} {
		namespace ensemble configure $name -prototype $prototype1 \
			-unknown $unknown1 
	}

	namespace enemble configure $_ -prototype [list ::lindex $name] -unknown $unknown1
	return
}


proc .name _ {
	return $_
}
.method [namespace current] .name 


proc .namespace _ {
	namespace ensemble configure $_ -namespace
}
.method [namespace current] .namespace 


proc .new {_ name args} {
	global env
	set ns [uplevel 1 [list ::namespace eval $name {
		::namespace ensemble create
		::variable configured 0
		::namespace current
	}]]
	::trace add command $ns delete [list ::apply {{ns oldname newname op} {
		if {[namespace exists $ns]} {
			namespace delete $ns
		}
	}} $ns]

	set prototype $_
	set map [namespace ensemble configure $_ -map]

	set prototypes {}
	while {[dict exists $map .prototype]} {
		set prototypes [list $map {*}$prototypes[set prototypes {}]]
		lassign [dict get $map .prototype] prototype 
		set map [namespace ensemble configure $prototype -map]
	}

	set map {}
	foreach {key val} [namespace ensemble configure $prototype -map] { 
		if {$key ne {.prototype}} {
			if {[lindex $val 1] eq $_} {
				set val [lreplace $val[set val {}] 1 1 $ns]
			}
		} else {
			error [list {how did we get to here?}]
		}
		lappend map $key $val 
	}

	namespace ensemble configure $ns -map $map

	set prototype $ns
	foreach map $prototypes {
		$ns .specialize
		dict unset map .prototype
		dict for {name cmd} $map {
			if {[lindex $cmd 1] eq $_} {
				# remove the original name from index 1 because .method is
				# going to add it back 
				$ns .method $name {*}[lreplace $cmd[set cmd {}] 1 1]
			} else {
				$ns .routine $name {*}$cmd
			}
		}
	}

	interp alias {} ${ns}::.my {} $ns 

	if {[llength $args]} {
		tailcall $ns .init {*}$args
	} else {
		return $ns
	}
}
.method [namespace current] .new 


proc .ondelete {_ trace args} {
    if {[llength $args] == 1} {
	lassign $args script
	trace remove command $_ delete $trace
	set trace {}
	if {$script ne {}} {
	    set trace [list apply {{script args} {
		try $script
	    }} $script]
	    trace add command $_ delete $trace
	}
	$_ .method .ondelete .ondelete $trace
    } elseif {[llength $args]} {
	error [list {wrong # args}]
    }
    return $trace
}
.method [namespace current] .ondelete .ondelete {}


proc .routine {_ name args} {
	if {![llength $args]} {
		lappend args $name
	}
	set map [namespace ensemble configure $_ -map]
	dict set map $name $args
	uplevel 1 [list ::namespace ensemble configure $_ -map $map]
	return
}
.method [namespace current] .routine 


proc .specialize {_ args} {
	set ns [$_ .namespace] 
	while {[namespace which [set name ${ns}::[
		info cmdcount]_prototype]] ne {}} {}
	rename $_ $name
	
	set new [namespace eval ${ns} [
		list namespace ensemble create -command $_ -map [list \
			.prototype [list $name]
		] -unknown [
			list ::apply {{_ name args} {

			set prototype [lindex [dict get [namespace ensemble configure $_ -map] .prototype] 0]
			list $prototype $name
		}}]]]

	::trace add command $new delete [list ::apply {{ns oldname newname op} {
		if {[namespace exists $ns]} {
			namespace delete $ns
		}
	}} $ns]
	return
}
.method [namespace current] .specialize 


proc .vars {_ args} {
	set vars {}
	foreach arg $args {
		lassign $arg source target
		if {[llength $arg] == 1} {
			set target $source
		}
		lappend vars $source $target
	}
	uplevel 1 [list ::namespace upvar $_ {*}$vars]
}
.method [namespace current] .vars 


proc = {_ name val} {
	set [$_ .namespace]::$name $val
}
.method [namespace current] = 



