#! /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
instead.
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 {
positional
}
}
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.
positional
}
}
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]