Tcl array関係のお役立ち関数2つ

Cでは定数を定義するのに#defineを使うことが多いようですが、
Tclではプリプロセッサがないので、同じ方法は使えません。

グローバル変数を使うというのが最初に思い浮かぶと思うんですが、
switch文の分岐に変数を使うには特殊な方法が必要なことなどを考えるといろいろと
不都合なことが多いんですよ(すごくやっつけな説明です)。

いろいろ試した結果、双方向に参照できるディクショナリ用意する方法が一番しっくりきました。

以下のプロシージャを使うと、順方向のarrayを定義した後、一発で逆方向のarrayを定義することができるので便利です。

# usage: invert_array ARY ARY_INV
# ARY's values should be unique.
proc invert_array {_in _out} {
	upvar $_in in
	upvar $_out out
 
	array set out {}
	array unset out *
 
	foreach {key val} [array get in] {
		set out($val) $key
	}
}

おまけですが、Tclには標準でparrayというプロシージャあって、array全体を見やすく表示してくれるんですが、
標準出力にしか出してくれません。parrayは組み込みコマンドではなく、プロシージャなので、中身を見れば簡単に拡張できます。

  1. parray ARY; # オリジナルのparray互換
  2. parray stdout ARY; # 標準出力を明示
  3. parray $ch ARY; # 任意のチャネルを指定

以下、2,3のような拡張を施したparrayです。

# usage: parray ARY
# Equivalent to original parray except that you can optionally specify output channel as a first argument.
proc parray {args} {
	switch [llength $args] {
	1 {
		set ch stdout
		set a [lindex $args 0]
		set pattern *
	}
	2 {
		set ch [lindex $args 0]
		if {[file channels $ch] ne $ch} {
			set ch stdout
			foreach {a pattern} $args break
		} else {
			foreach {ch a} $args break
			set pattern *
		}
	}
	3 {
		foreach {ch a pattern} $args break
	}
	default {
		error "wrong # args: should be \"parray ?channelId? a ?pattern?\""
	}
	}
	upvar 1 $a array
	if {![array exists array]} {
		error "\"$a\" isn't an array"
	}
	set maxl 0
	foreach name [array names array $pattern] {
		if {[string length $name] > $maxl} {
			set maxl [string length $name]
		}
	}
	set maxl [expr {$maxl + [string length $a] + 2}]
	foreach name [lsort -dictionary [array names array $pattern]] {
		set nameString [format %s(%s) $a $name]
		puts $ch [format "%-*s = %s" $maxl $nameString $array($name)]
	}
}

コメントを残す