Artifact [a7830a4032]

Artifact a7830a4032ea503f14cd115fc377255795221b13:

#! /bin/env tclsh

package require ycl::proc
namespace import [yclprefix]::proc::checkargs

package require ycl::ns
namespace import [yclprefix]::ns::dupensemble
namespace import [yclprefix]::ns::normalize
namespace import [yclprefix]::ns::unique

package require ycl::var::methods

namespace import [yclprefix]::proc::checkargs

proc ~ {self args} {

variable doc::new {
	description {
		transform a namespace into a shelf, i.e., an object with the behaviours
		described here.

		This is another attempt at an object system, initiated 2015-01

		The goal is to create an object system closely-aligned with the
		capabilities of [namespace], and hopefully in harmony with the
		intention of its design.  The namespace path is used for command
		resolution, and the namespace ensemble map specifies the public
		programming interface of the object.  A method is simply a procedure
		that is called through the public interface, and doesn't necessariily
		even take the name of the object as its first argument.  Where it does,
		that is defined in the namespace ensemble map.

		This object system gives up on the idea of methods being procedures
		that look up one level to find their object, and instead uses the
		namespace map to make the object's interface explicit.  There is no
		mechanism for private methods, so a naming convention might be used

		As of 2015-01-31 I currently like this object system better than
		ns::object, but haven't explored it too much yet.  I think it boils
		down the essence of what I've been chasing, first with ycl::context,
		then ns::object, and now this.

	args {
		self {
			description {
		name {
			description {
				the namespace backing the new object. It is created if it does not
				exist.  If this argument is not provided, a namespace will be
				automatically determined.

		cmd {
			description {
				the name of the ensemble command to be created for the object.
			default {}
		extra {
			default {lindex {}}
	extra extra

proc new {self name args} {
	checkargs doc::new
	if {$name eq {}} {
		set name [unique prefix [uplevel {namespace current}]]
	} elseif {![string match ::* $name]} {
		set name [uplevel [yclprefix]::ns::normalize $name]
	if {![info exists cmd]} {
		set cmd $name
	set path [namespace eval $name namespace path]
	if {$self ni $path} {
		lappend path $self 
		namespace eval $name [list namespace path $path] 
	#name already exists, so dupensemble won't duplicate the namespace
	set ensemble [dupensemble $self $cmd tons $name]
	$cmd ondeath [list eval [list $cmd ~]]
	$ensemble init {*}$extra
	return $ensemble

proc init {_ args} {
	#override in clones

#warning:  any specified instance variables get linked to the variable by the
#same name in the instance namespace.  Therefore, higher shelfs won't be
#searched for their value. 
proc asmethod {self spec {selfvar _}} {
	lassign $spec[set spec {}] pargs objvars nsvars body
	set pargs [linsert $pargs[set pargs {}] 0 $selfvar]
	set script {}
	foreach varname $nsvars {
		append script [list variable $varname]\n
	foreach varname $objvars {
		if {[llength $varname] == 2} {
			lassign $varname[set varname {}] othername localname
		} else {
			lassign $varname[set varname {}] othername localname
			set localname $othername
		append script [string map [
			list {{{selfvar}}} [list $selfvar] {{{localname}}} [
				list $localname] {{{othername}}} [list $othername]] {
			namespace upvar [namespace ensemble configure [
				set {{selfvar}}] -namespace] {{othername}} {{localname}}
	return [list $pargs $script\n$body]

proc subcmd {self cmd args} {
	if {[llength $args]} {
		set target [lindex $args 0]
	} else {
		set target $cmd 
		set cmd [namespace tail $target]
	set map [namespace ensemble configure $self -map]

	#the purpose of this complexity is to allow $target to be resolved in 
	#the namespace of the ensemble when it is not qualified.
	#If there's a more simple way to accomplish this, I'd like to hear about it

	#Thanks to tailcall semantics, $target is resolved in the scope of $myns,
	#but invoked in the scope of the caller of the ensemble.
	dict set map $cmd [list ::apply [list {myns target args} {
		::tailcall ::apply [list args {
			::tailcall {*}$args
		} $myns] $target {*}$args
	}] [namespace ensemble configure $self -namespace] $target]
	namespace ensemble configure $self -map $map

proc method {self name args} {
	set map [namespace ensemble configure $self -map]
	if {[llength $args] == 0} {
		set target $name
	} elseif {[llength $args] == 1} {
		lassign $args[set args {}] target
	} else {
		error [list {wrong # args} {should be} {0 or 1} not $args]
	set target [lassign $target[set target {}] target0]
	#qualify target os it isn't interpreted relative to the curent namespace
	set target0 [uplevel [list [namespace which normalize] $target0]]
	dict set map $name [list $target0 {*}$target $self {*}$args]
	namespace ensemble configure $self -map $map

proc ns {_ args} {
	namespace ensemble configure $_ -namespace

apply [list {} {
	dict set map $    [list $ [namespace current]]
	dict set map $.exists   [list $.exists [namespace current]]
	dict set map $.locate   [list $.locate [namespace current]]
	dict set map ~   [list ~ [namespace current]]
	dict set map asmethod  [list asmethod [namespace current]]
	dict set map eval [list ::namespace eval [namespace current]]
	dict set map init  [list init [namespace current]]
	dict set map method  [list method [namespace current]]
	dict set map ns  [list ns [namespace current]]
	dict set map ondeath [list ondeath [namespace current]]
	dict set map new  [list new [namespace current]]
	dict set map subcmd  [list subcmd [namespace current]]
	namespace ensemble configure [namespace current] -map $map

	set methoddata [[yclprefix]::var::$ {{varname args} {} {}} {[$_ $.locate $varname]} \
		{set ${_}::$varname $val} {[set ${_}::$varname]}]
	proc $ {*}[[namespace current] asmethod $methoddata]

	set methoddata [[yclprefix]::var::$.exists {{varname args} {} {}} \
		{[list $_ $ $varname]} {$_ $ $varname}]
	proc $.exists {*}[[namespace current] asmethod $methoddata]

	set methoddata [[yclprefix]::var::$.locate {varname {} {}} {${_}::$varname} \
		{$path $.locate $varname}]
	proc $.locate {*}[[namespace current] asmethod $methoddata]

	set methoddata [set [yclprefix]::ns::ondeath]
	proc ondeath {*}[[namespace current] asmethod $methoddata]

} [namespace current]]

variable doc::glass {
	description {
		glass is a shelf configured such that any command in the shelf's
		namespace is available as a method.
[namespace current] new glass

apply [list {} {
	namespace ensemble configure [namespace current] -unknown [list apply {{mycmd args} {
		list namespace eval [namespace ensemble configure $mycmd -namespace] [
			lindex $args 0]
} [namespace current]::glass]