Namespaces -- using interp and package
Neil Winton
be to explore an idea I had a little time ago. When I first saw the
interp command in Tcl 7.5 I thought it would provide a reasonable
basis for implementing a name-space mechanism ... so here is an attempt
to do so.
The file import.tcl contains a new procedure -- import -- which takes
a package and version (like package require) and installs it in its own
interpreter. It then provides the means to execute commands in this name-
space or to import procedures/variables into the current name-space. So
if Foo is a package providing procedures foo and bar and global variables
foobie and barbie you can do:
% import Foo
% Foo foo foo-args
% import -proc bar Foo
% bar bar-args
% import -prefix Foo:: -procs * Foo
% Foo::foo foo-args
% Foo::bar bar-args
% Foo set foobie 42
% import -prefix Foo:: -vars * Foo
% Foo set foobie
42
% set Foo::foobie 69
% Foo set foobie
69
% Foo set barbie(dolls)
house
% set Foo::barbie(dolls) mansion
% Foo set barbie(dolls)
mansion
You can have hierarchical name-spaces too, so if package Zoo imports
package Foo you can do
% import Zoo
% Zoo Foo foo foo-args
and so on. Files are shared between all name-spaces by default.
There's a couple of examples in (surprise) foo.tcl and zoo.tcl. You also
get commands installed which allow you to access your parent's name-space
and the root name-space from any package.
Any feedback gratefully received. I haven't used this in earnest so consider
it a proof-of-concept. If it works for you, great -- if not, fix the code :-)
Oh, one more thing -- in order to build pkgIndex.tcl files for packages
which themselves import other packages you need a slightly modified version
of pkg_mkIndex. You'll find that in mkpkg.tcl
Have fun,
Neil
* Neil Winton Post Point P5 When their numbers had *
* N.Wi...@axion.bt.co.uk BT Laboratories dwindled from 25 to 8, *
* Tel +44 1473 646079 Martlesham Heath the other dwarfs began *
* Fax +44 1473 643306 IPSWICH IP5 7RE, UK to suspect Hungry ... *
------ Cut Here ------
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: import.tcl mkpkg.tcl foo.tcl zoo.tcl
# Wrapped by nwinton@newton on Fri Mar 29 15:55:47 1996
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f import.tcl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"import.tcl\"
else
echo shar: Extracting \"import.tcl\" \(11564 characters\)
sed "s/^X//" >import.tcl <<'END_OF_import.tcl'
X# import - Name-spaces for Tcl7.5
X#
X# Usage: import ?options? package ?version?
X#
X# This command implements a name-space mechanism for Tcl using the interp
X# and package commands introduced in Tcl 7.5. Any package can be imported
X# and gets its own interpreter and, hence, name-space. By default, all
X# commands in the package are available underneath their own name-space
X# command. The import command can handle an optional version number (and
X# -exact) option, in precisely the same manner as the package require command.
X#
X# Take, for example, a small package as follows:
X#
X# package provide Foo 1.0
X#
X# set foobie 42
X# set barbie(dolls) house
X#
X# proc foo {a b} {
X# global foobie
X# puts "foo -> $a $b"
X# set foobie $a
X# return
X# }
X#
X# proc bar {args} {
X# global barbie
X# puts "bar -> $args"
X# array set barbie $args
X# return
X# }
X#
X# If you import it you can invoke things like this:
X#
X# % import Foo
X# 1.0
X# % Foo foo alpha bravo
X# foo -> alpha bravo
X# % Foo bar Once upon a time in {a land far away}
X# bar -> Once upon a time in a land far away
X#
X
X# In fact, the Foo command will allow you to execute an arbitrary command
X# in the context of the imported package, so "Foo set foobie 123" will set
X# the variable foobie in the package name-space. This also means that nested
X# packages works right (for some definition of the word "right" :-). So if
X# Foo itself imported Bar which had a command "baz" then
X#
X# % Foo Bar baz
X#
X# would invoke the baz command in the Bar package. The name of the package
X# command itself can be specified using the -as option. For example:
X#
X# % import -as Plurgle Foo
X#
X# give the ability to invoke "Plurgle foo a b"
X#
X# By default, all I/O is shared with the parent. Files already opened are
X# accessible and new files opened in the imported package will be accessible
X# to its parent. You can suppress this and have the new package use private
X# I/O channels by specifying the -noshareio option.
X#
X# There are various options which allow you to import all or selected
X# commands and global variables into your name-space directly. The -procs
X# and -vars options allow you to specify lists of procedures and variables.
X# In fact they take a list of patterns to match against procedure/variable
X# names so "*" imports all of them. Global variables must be defined by the
X# time the package has been load in order to be picked up. If the -prefix
X# option is specified then this will be preprended to the names in your
X# name-space. So
X#
X# % import -procs * -vars * -prefix Foo:: Foo
X#
X# will define procedures called Foo::foo and Foo::bar and will also
X# create global variables Foo::foobie and Foo::barbie which can be used
X# as normal. So, assuming the above import command has been given, you
X# would see the following behaviour:
X#
X# % set Foo::foobie
X# 42
X# % Foo::foo alpha bravo
X# foo -> alpha bravo
X# % set Foo::foobie
X# alpha
X# % Foo set foobie
X# alpha
X# % set Foo::foobie xyzzy
X# xyzzy
X# % Foo set foobie
X# xyzzy
X# % array get Foo::barbie
X# dolls house
X# % Foo::bar Once upon a time in {a land far away}
X# bar -> Once upon a time in {a land far away}
X# % array get Foo::barbie
X# dolls house a time Once upon in {a land far away}
X# % set Foo::barbie(in) limbo
X# limbo
X# % Foo array get barbie
X# dolls house a time Once upon in limbo
X#
X# You can import the same package multiple times and either share the
X# same name-space or create a new one (with -as). This could be used,
X# for example, to import procedures and variables with different names
X# as follows:
X#
X# % import -proc * -prefix Foo:: Foo
X# 1.0
X# % import -var * -prefix Foo_ Foo
X# 1.0
X# % Foo::foo alpha bravo
X# foo -> alpha bravo
X# % set Foo_foobie
X# alpha
X#
X#
X# That's about it!
X#
X#
X# Neil Winton (N.Wi...@axion.bt.co.uk)
X#
X# SCCS ID @(#)import.tcl 1.1 96/03/29
X
Xproc import {args} {
X global auto_path
X
X set args [import:getopts {-noshareio -exact {-prefix 1} {-vars 1} {-procs 1} {-as 1}} $args]
X
X if {[llength $args] > 2} {
X error "wrong # of args, should be: import ?-as name? ?-prefix cmd-prefix? ?-noshareio? ?-vars var-list? ?-procs proc-list? package ?version?"
X }
X set pkg [lindex $args 0]
X set version [lindex $args 1]
X
X # Look for exact flag
X
X if [info exists opts(-exact)] {
X set exact -exact
X } {
X set exact {}
X }
X
X # Define names of module and interpreter
X
X if [info exists opts(-as)] {
X set asname $opts(-as)
X upvar #0 $asname Package
X set iname $asname-interp
X } {
X set asname $pkg
X upvar #0 $asname Package
X set iname $pkg-interp
X }
X
X # Create new interpreter if necessary
X
X if [info exists Package(interp)] {
X set icmd $Package(interp)
X } {
X set icmd [interp create $iname]
X set Package(interp) $icmd
X
X # By default we share all I/O commands with our parent,
X # which effectively undoes the usual "safe" interp concept.
X # The -noshareio option suppresses this.
X
X if ![info exists opts(-noshareio)] {
X $icmd alias open open
X $icmd alias close close
X $icmd alias read read
X $icmd alias puts puts
X $icmd alias gets gets
X $icmd alias fileevent fileevent
X $icmd alias fconfigure fconfigure
X }
X
X # Create command in child (called "parent") to allow execution in
X # parent context
X
X $icmd alias parent import:parentEval
X
X # We also create a command "root" to allow execution in the
X # top-level context. Nested imports will forward this back
X # up the chain.
X
X $icmd alias root root
X
X if {[info commands root] == {}} {
X
X # We are at the root of all imports so we define the
X # real root procedure
X
X proc root args { uplevel #0 $args }
X }
X
X # Create command to execute in child context. This is the same
X # as the package name unless the -as option was specified.
X
X proc $asname {args} "$icmd eval \$args"
X
X # Get list of global variables in the interpreter before loading
X # the package ...
X
X set prevar [$icmd eval info globals]
X
X # Load the package.
X #
X # We also want to force the functions provided by the package
X # really to be loaded. The auto_load of unknown should pull in
X # the standard Tcl library files. We then reset the auto_index array
X # and the package require should then add just the commands
X # provided by the package. Finally we explicitly auto_load each
X # of these commands to bring in all of the required definitions.
X
X $icmd eval auto_load unknown
X $icmd eval auto_reset
X #
X # Pass down parent auto_path variable
X #
X $icmd eval "set auto_path {$auto_path}"
X
X set Package(version) [$icmd eval package require $exact $pkg $version]
X
X set Package(procs) [$icmd eval array names auto_index]
X foreach cmd $Package(procs) {
X $icmd eval auto_load $cmd
X }
X
X # Get list of variables after
X
X set postvar [$icmd eval info globals]
X
X # Now figure out which ones have been added by the package
X # (the new elements of the list minus auto_index)
X
X set Package(vars) {}
X foreach var $postvar {
X if {$var == "auto_index"} {continue}
X if {[lsearch -exact $prevar $var] == -1} {
X lappend Package(vars) $var
X }
X }
X }
X
X # For each procedure in the specified list, import it into our
X # namespace prefixed with the supplied -prefix value, if any
X
X if [info exists opts(-prefix)] {
X set prefix $opts(-prefix)
X } {
X set prefix {}
X }
X
X if [info exists opts(-procs)] {
X foreach cmd $Package(procs) {
X # See if the procedure matches any of the supplied patterns
X foreach pat $opts(-procs) {
X if [string match $pat $cmd] {
X proc $prefix$cmd {args} "$icmd eval $cmd \$args"
X break
X }
X }
X }
X }
X
X # Now for the global variables (note that they must be defined in
X # the package in question at this point). We use variable traces
X # to keep parent and child values in step.
X
X if [info exists opts(-vars)] {
X foreach var $Package(vars) {
X foreach pat $opts(-vars) {
X if [string match $pat $var] {
X
X # Define a matching variable in our context.
X # We set traces on it so that all read/write/unset
X # operations are forwarded to the child.
X
X global $prefix$var
X
X if [$icmd eval array exists $var] {
X array set $prefix$var [$icmd eval array get $var]
X
X # Array variables are tricky because we need to
X # detect new elements that appear in the child.
X # So we neede traces in the child that reflect
X # back into the parent.
X
X $icmd alias import:childArraySet import:parentArraySet $icmd $prefix$var
X $icmd eval trace variable $var w import:childArraySet
X } {
X set $prefix$var [$icmd eval set $var]
X }
X trace variable $prefix$var rwu "import:reflectToChild $icmd $var"
X
X # An unset in the child also needs to be reflected
X # up to the parent
X
X $icmd alias import:childVarUnset import:parentVarUnset $icmd $prefix$var
X }
X }
X }
X }
X
X # Return the version loaded
X
X return $Package(version)
X}
X
X# Eval in parent context
X
Xproc import:parentEval {args} {
X uplevel #0 $args
X}
X
X# Procedure called when a linked variable is read/written/unset in
X# the parent to reflect the matching operation into the child.
X#
X# The import:inTrace variable is used to avoid mutual recursion between
X# parent and child when some child traces trigger.
X
Xset import:inTrace 0
X
Xproc import:reflectToChild {icmd ivar name1 name2 op} {
X global $name1
X global import:inTrace
X
X if {!${import:inTrace}} {
X set import:inTrace 1
X
X switch -exact -- $op {
X r {
X if {$name2 != ""} {
X array set $name1 [$icmd eval array get $ivar]
X } {
X set $name1 [$icmd eval set $ivar]
X }
X }
X w {
X if {$name2 != ""} {
X $icmd eval "array set $ivar {[array get $name1]}"
X } {
X $icmd eval set $ivar [set $name1]
X }
X }
X u {
X if {$name2 != ""} {
X $icmd eval unset $ivar\($name2)
X } {
X $icmd eval unset $ivar
X }
X }
X }
X
X set import:inTrace 0
X }
X}
X
X# Variable trace called from child
X
Xproc import:parentArraySet {icmd var name1 name2 op} {
X global $var
X global import:inTrace
X
X if {!${import:inTrace}} {
X set import:inTrace 1
X
X array set $var [$icmd eval array get $name1]
X
X set import:inTrace 0
X }
X}
X
X# Variable trace called from child
X
Xproc import:parentVarUnset {icmd var name1 name2 op} {
X global $var
X global import:inTrace
X
X if {!${import:inTrace}} {
X set import:inTrace 1
X
X if {$name2 != ""} {
X eval "unset $var\($name2)"
X } {
X unset $var
X }
X
X set import:inTrace 0
X }
X}
X
X# import:getopts
X#
X# Option parsing routine.
X
Xproc import:getopts {options arglist {resultvar opts}} {
X upvar $resultvar result
X catch {unset result}
X
X foreach opt $options {
X if {[llength $opt] > 1} {
X set option([lindex $opt 0]) 1
X } {
X set option([lindex $opt 0]) 0
X }
X }
X
X for {set i 0} {$i < [llength $arglist]} {incr i} {
X set arg [lindex $arglist $i]
X switch -glob -- $arg {
X - {error "Invalid option -, valid options are: [lsort [array names option]]"
X -- {incr i; break}
X -* {
X set match [array names option $arg*]
X switch -exact -- [llength $match] {
X 0 {error "Invalid option $arg, valid options are: [lsort [array names option]]"
X 1 {
X if $option($match) {
X incr i
X if {$i >= [llength $arglist]} {
X error "Missing argument for $match"
X } {
X set result($match) [lindex $arglist $i]
X }
X } {
X set result($match) 1
X }
X }
X default {error "Ambiguous option $arg: matches [lsort $match]"
X }
X }
X default {break}
X }
X }
X
X return [lrange $arglist $i end]
X}
X
END_OF_import.tcl
if test 11564 -ne `wc -c <import.tcl`; then
echo shar: \"import.tcl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f mkpkg.tcl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"mkpkg.tcl\"
else
echo shar: Extracting \"mkpkg.tcl\" \(3217 characters\)
sed "s/^X//" >mkpkg.tcl <<'END_OF_mkpkg.tcl'
X# Modified version of pkg_mkIndex to cope with the use of the
X# import procedure. Basically it installs a dummy import command
X# in the sub-interpreter so that it does not appear to be provided
X# by the package itself.
X#
X# pkg_mkIndex --
X# This procedure creates a package index in a given directory. The
X# package index consists of a "pkgIndex.tcl" file whose contents are
X# a Tcl script that sets up package information with "package require"
X# commands. The commands describe all of the packages defined by the
X# files given as arguments.
X#
X# Arguments:
X# dir - Name of the directory in which to create the index.
X# args - Any number of additional arguments, each giving
X# a glob pattern that matches the names of one or
X# more shared libraries or Tcl script files in
X# dir.
X
Xproc pkg_mkIndex {dir args} {
X global errorCode errorInfo
X append index "# Tcl package index file, version 1.0\n"
X append index "# This file is generated by the \"pkg_mkIndex\" command\n"
X append index "# and sourced either when an application starts up or\n"
X append index "# by a \"package unknown\" script. It invokes the\n"
X append index "# \"package ifneeded\" command to set up package-related\n"
X append index "# information so that packages will be loaded automatically\n"
X append index "# in response to \"package require\" commands. When this\n"
X append index "# script is sourced, the variable \$dir must contain the\n"
X append index "# full path name of this file's directory.\n"
X set oldDir [pwd]
X cd $dir
X foreach file [eval glob $args] {
X # For each file, figure out what commands and packages it provides.
X # To do this, create a child interpreter, load the file into the
X # interpreter, and get a list of the new commands and packages
X # that are defined. Define an empty "package unknown" script so
X # that there are no recursive package inclusions.
X
X set file [file networkname $file]
X set c [interp create]
X $c eval {proc import args {}} ;#### MODIFIED HERE ####
X $c eval [list set file $file]
X if [catch {
X $c eval {
X proc dummy args {}
X package unknown dummy
X set origCmds [info commands]
X set dir "" ;# in case file is pkgIndex.tcl
X set pkgs ""
X if [catch {load ./$file}] {
X if [catch {source $file}] {
X puts $errorInfo
X error "can't either load or source $file"
X } else {
X set type source
X }
X } else {
X set type load
X }
X foreach i [info commands] {
X set cmds($i) 1
X }
X foreach i $origCmds {
X catch {unset cmds($i)}
X }
X foreach i [package names] {
X if {([string compare [package provide $i] ""] != 0)
X && ([string compare $i Tcl] != 0)} {
X lappend pkgs [list $i [package provide $i]]
X }
X }
X }
X } msg] {
X interp delete $c
X error $msg $errorInfo $errorCode
X }
X foreach pkg [$c eval set pkgs] {
X lappend files($pkg) [list $file [$c eval set type] \
X [lsort [$c eval array names cmds]]]
X }
X interp delete $c
X }
X foreach pkg [lsort [array names files]] {
X append index "\npackage ifneeded $pkg\
X \"tclPkgSetup \$dir [lrange $pkg 0 0] [lrange $pkg 1 1]\
X [list $files($pkg)]\""
X }
X set f [open pkgIndex.tcl w]
X puts $f $index
X close $f
X cd $oldDir
X}
X
END_OF_mkpkg.tcl
if test 3217 -ne `wc -c <mkpkg.tcl`; then
echo shar: \"mkpkg.tcl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f foo.tcl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"foo.tcl\"
else
echo shar: Extracting \"foo.tcl\" \(256 characters\)
sed "s/^X//" >foo.tcl <<'END_OF_foo.tcl'
Xpackage provide Foo 1.0
X
Xset foobie 42
Xset barbie(dolls) house
X
Xproc foo {a b} {
X global foobie
X puts "foo -> $a $b"
X set foobie $a
X return
X}
X
Xproc bar {args} {
X global barbie
X puts "bar -> $args"
X array set barbie $args
X return
X}
X
END_OF_foo.tcl
if test 256 -ne `wc -c <foo.tcl`; then
echo shar: \"foo.tcl\" unpacked with wrong size!
fi
chmod +x foo.tcl
# end of overwriting check
fi
if test -f zoo.tcl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"zoo.tcl\"
else
echo shar: Extracting \"zoo.tcl\" \(173 characters\)
sed "s/^X//" >zoo.tcl <<'END_OF_zoo.tcl'
Xpackage provide Zoo 1.0
X
Ximport -proc foo Foo
X
X# Deliberate clash!
X
Xset foobie 42
X
Xproc zoo {a b} {
X foo $a $b
X global foobie
X set foobie [list $a $b]
X return
X}
END_OF_zoo.tcl
if test 173 -ne `wc -c <zoo.tcl`; then
echo shar: \"zoo.tcl\" unpacked with wrong size!
fi
chmod +x zoo.tcl
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0
Patrik Floding
To the SUN team:
It would be very useful if the `interp' command could set up
aliases between variables in different interpreters (similar to using
upvar)!
As it is now tracking variable changes between interpreters is costly.
I believe there is a certain lack of ortogonality in Tcl today:
* Commands can be aliased between interpreters, and within the same
interpreter.
* Variables can be aliased in the local interpreter (using upvar) - but
_not_ between interpreters.
Providing variable aliasing between interpreters would enable
many nice all-Tcl tricks!
Regards,
/Patrik
Mark Roseman
>It would be very useful if the `interp' command could set up
>aliases between variables in different interpreters (similar to using
>upvar)!
>As it is now tracking variable changes between interpreters is costly.
>I believe there is a certain lack of ortogonality in Tcl today:
its do-able today, just setup variable traces on both sides.
mark
--
Mark Roseman, Research Associate phone: (403) 220-3532 / 220-7259
Dept. of Computer Science fax: (403) 284-4707
University of Calgary email: ros...@cpsc.ucalgary.ca
Calgary, Alta CANADA T2N 1N4 http://www.cpsc.ucalgary.ca/~roseman