#!/usr/bin/tclsh set currSystem "" proc System {name args} { # Instead of pushing the new system on the 'stack' of current systems, # we remember it in a local variable, which ends up on TCL's # function call stack. global currSystem set oldSystem $currSystem set currSystem $name ; # Thanks to this, all sub-structures called by # 'uplevel' will know what the name of their # immediate parent System is # Store the system in an internal data structure # (details not shown here) puts "Storing system '$currSystem'" # Execute the parsing procedures for the sub-systems uplevel 1 [lindex $args end] # Pop the system off the 'stack' again. Restore the old system as if nothing happened. set currSystem $oldSystem } proc Object {name} { global currSystem # Store the object in the internal data structure of the current # system (details not shown here) puts "System '$currSystem' contains object '$name'" } source "datafile.dat"