TCL命令解析之：switch命令解析

新爸编程

已于 2025-04-15 19:56:15 修改

阅读量848

点赞数 4

分类专栏： TCL编程文章标签：算法数据结构

于 2024-08-13 17:28:33 首次发布

本文链接：https://blog.csdn.net/inspirewang/article/details/141167599

版权

TCL编程专栏收录该内容

6 篇文章

订阅专栏

switch命令简介

switch命令是TCL中重要的逻辑控制命令，它实现了丰富的多分支条件控制逻辑。TCL的switch命令与C语言的switch语句功能稍有不同，虽然他们都实现了多条件控制逻辑，但是条件的匹配方式不同，条件执行的控制逻辑也有不同。switch命令的TCL语法如下：

switch ?options? string pattern body ?pattern body ...?

switch ?options? string {pattern body ?pattern body ...?}

它有两种形式，一种是分支逻辑被大括号括起来，一种是没有大括号括起来。这两种都是合法的，但是我们通常建议使用带大括号的语法。

switch命令的执行逻辑流程图如下所示：

TCL的switch命令支持多种条件的匹配方式：exact模式（默认，全字符串完整匹配）、glob模式（字符串的glob匹配模式）、regexp模式（正则表达式匹配模式）。在命令中你可以设置对应的选项来设置switch命令的条件匹配方式。

TCL的switch命令也是有default匹配项，而且如果想要该匹配项能起作用，必须写在最后一个匹配项的位置，否则当做正常字符串进行匹配。

TCL的switch命令分支执行逻辑语句块中不需要执行类似C语言中switch语句的break命令来实现对后续执行条件的忽略，TCL的switch命令永远只执行第一个匹配到的逻辑块，否则根据是否最后有default匹配项，来执行相应的逻辑块。

当前解释器解析switch命令的缺陷

当前官方的解释器无法正确执行以下switch命令

switch -glob $b {
    # 对单c字符进行匹配
	*c* {puts ccc}
	*cb* {puts bbb}
	default {puts ddd}
}

不能正确执行的原因是注释行影响了解释器对该命令的解析。我们通常认为这种注释方法是符合TCL规定的注释语法的。为了解决解释器的这种语法上的问题，我们可以通过编写新的switch命令来替代原switch命令来实现。

switch命令支持的特殊语法

TCL的switch命令支持一下这种语法：

switch -glob $b {
	*c* -
	*cb* {puts bbb}
	default {puts ccc}
}

其中由于匹配项“*c*”后面的逻辑块是“-”，TCL规定其实际执行的逻辑块为其后面的匹配项中第一个为非“-”的逻辑块。这样可以实现多个匹配条件与一个执行逻辑的绑定。

编写新的switch命令

为了实现新的switch命令完全兼容原switch命令的语法，我们还需要分别对原switch命令中的各种选项的组合进行解释区分。下面我们直接给出完整的实现函数供大家参考。

# 去除脚本中的注释行，这主要在switch的body部分中使用，以免注释部分影响switch的判断逻辑
proc getBodyWithoutComment {body} {
    set res {}
    foreach cmd [split $body "\n"] {
        if {[regexp {^\s*#.*} $cmd]} {
            continue
        } else {
            if {$res eq ""} {
                append res $cmd
            } else {
                append res \n$cmd
            }
            
        }
    }
    return $res
}

proc switch_new {switchBlock} {
    set codeblock [lrange $switchBlock 1 end]
    set arglist {}
    set matchstring {}
    set body {}
    set res ""

    if {"-nocase" in $codeblock} {
        # 从codeblock中删除-nocase相关数据
        set nocase_index [lsearch $codeblock "-nocase"]
        set codeblock [lreplace $codeblock $nocase_index $nocase_index]
        lappend arglist "-nocase"
    }
    if {"-exact" in $codeblock} {
        # 从codeblock中删除-exact相关数据
        set exact_index [lsearch $codeblock "-exact"]
        set codeblock [lreplace $codeblock $exact_index $exact_index]
        lappend arglist "-exact"
    }
    if {"-glob" in $codeblock} {
        # 从codeblock中删除-glob相关数据
        set glob_index [lsearch $codeblock "-glob"]
        set codeblock [lreplace $codeblock $glob_index $glob_index]
        lappend arglist "-glob"
    }
    if {"-regexp" in $codeblock} {
        # 从codeblock中删除-regexp相关数据
        set regexp_index [lsearch $codeblock "-regexp"]
        set codeblock [lreplace $codeblock $regexp_index $regexp_index]
        lappend arglist "-regexp"
    }
    if {"-matchvar" in $codeblock} {
        set matchvar_index [lsearch $codeblock "-matchvar"]
        set matchvar_name [lindex $codeblock [expr $matchvar_index + 1]]
        # 从codeblock中删除-matchvar相关数据
        set codeblock [lreplace $codeblock $matchvar_index [expr $matchvar_index + 1]]
        lappend arglist "-matchvar" "$matchvar_name"
    }
    if {"-indexvar" in $codeblock} {
        set indexvar_index [lsearch $codeblock "-indexvar"]
        set indexvar_name [lindex $codeblock [expr $indexvar_index + 1]]
        # 从codeblock中删除-indexvar相关数据
        set codeblock [lreplace $codeblock $indexvar_index [expr $indexvar_index + 1]]
        lappend arglist "-indexvar" "$indexvar_name"
    }
    if {"--" in $codeblock} {
        # 从codeblock中删除--相关数据
        set mark_index [lsearch $codeblock "--"]
        set codeblock [lreplace $codeblock $mark_index $mark_index]
    }
    # 经过上述逻辑处理后的codeblock作为列表的第一个元素是matchstring，其余的元素是body
    # 在指定作用域中取到带匹配字符串
    set matchstring [uplevel 1 "set matchstring_temp [lindex $codeblock 0]"]
    # 判断switch的两种命令形式，一种是：switch ?options? string pattern body ?pattern body ...?
    # 另一种是：switch ?options? string {pattern body ?pattern body ...?} 
    if {[llength $codeblock] eq 2} {
        set body {*}[lrange $codeblock 1 end]
    } else {
        set body "[lrange $codeblock 1 end]"
    }
    # 去除注释行
    set body [getBodyWithoutComment $body]

    # 首先设置匹配模式
    set match_model "exact"
    if {$arglist ne ""} {
        if {"-glob" in $arglist} {
            set match_model "glob"
        } elseif {"-regexp" in $arglist} {
            set match_model "regexp"
        }
    }
    
    set no_case 0
    if {"-nocase" in $arglist} {
        set no_case 1
    }
    set matchvar_name ""
    if {"-matchvar" in $arglist} {
        set matchvar_index [lsearch $arglist "-matchvar"]
        set matchvar_name [lindex $arglist [expr $matchvar_index + 1]]
    }
    set indexvar_name ""
    if {"-indexvar" in $arglist} {
        set indexvar_index [lsearch $arglist "-indexvar"]
        set indexvar_name [lindex $arglist [expr $indexvar_index + 1]]
    }

    # 根据不同的匹配模式调用不同的匹配逻辑
    set ismatch 0
    set defaultBlock {}
    switch -- $match_model {
        "glob" {
            foreach {pattern_str logic_block} $body {
                set pattern_str {*}$pattern_str
                if {$no_case} {
                    if {[string match -nocase "$pattern_str" "$matchstring"] || $ismatch eq 1} {
                        set ismatch 1
                        if {$logic_block eq "-"} {
                            continue
                        }
                        
                        set res [uplevel 1 "$logic_block"]
                        break
                    }
                } else {
                    if {[string match "$pattern_str" "$matchstring"] || $ismatch eq 1} {
                        set ismatch 1
                        if {$logic_block eq "-"} {
                            continue
                        }
                        set res [uplevel 1 "$logic_block"]
                        break
                    }
                }
                if {$pattern_str eq "default"} {
                    set defaultBlock $logic_block
                }
            }
            if {$ismatch eq 0 && $defaultBlock ne ""} {
                set res [uplevel 1 "$defaultBlock"]
            }
        }
        "regexp" {
            foreach {pattern_str logic_block} $body {
                set pattern_str {*}$pattern_str
                if {$no_case} {
                    # 先判断是否匹配，然后执行相关逻辑
                    if {[regexp -nocase "$pattern_str" $matchstring] && $ismatch eq 0} {
                        set ismatch 1
                        # 先根据是否提供了matchvar和indexvar来在环境中初始化相关变量
                        if {$matchvar_name ne ""} {
                            set res [uplevel 1 "regexp -nocase -inline \{$pattern_str\} \"$matchstring\""]
                            set res [uplevel 1 "set $matchvar_name \"$res\""]
                        }
                        if {$indexvar_name ne ""} {
                            set res [uplevel 1 "regexp -nocase -indices -inline \{$pattern_str\} \"$matchstring\""]
                            set res [uplevel 1 "set $indexvar_name \"$res\""]
                        }
                        if {$logic_block eq "-"} {
                            continue
                        }
                        set res [uplevel 1 "$logic_block"]
                        break
                    } elseif {$ismatch eq 1} {
                        if {$logic_block eq "-"} {
                            continue
                        }
                        set res [uplevel 1 "$logic_block"]
                        break
                    }
                } else {
                    # 先判断是否匹配，然后执行相关逻辑
                    if {[regexp "$pattern_str" $matchstring] && $ismatch eq 0} {
                        set ismatch 1
                        # 先根据是否提供了matchvar和indexvar来在环境中初始化相关变量
                        if {$matchvar_name ne ""} {
                            set res [uplevel 1 "regexp -inline \{$pattern_str\} \"$matchstring\""]
                            set res [uplevel 1 "set $matchvar_name \"$res\""]
                        }
                        if {$indexvar_name ne ""} {
                            set res [uplevel 1 "regexp -indices -inline \{$pattern_str\} \"$matchstring\""]
                            set res [uplevel 1 "set $indexvar_name \"$res\""]
                        }
                        if {$logic_block eq "-"} {
                            continue
                        }
                        set res [uplevel 1 "$logic_block"]
                        break
                    } elseif {$ismatch eq 1} {
                        if {$logic_block eq "-"} {
                            continue
                        }
                        set res [uplevel 1 "$logic_block"]
                        break
                    }
                }
                if {$pattern_str eq "default"} {
                    set defaultBlock $logic_block
                }
            }
            if {$ismatch eq 0 && $defaultBlock ne ""} {
                set res [uplevel 1  "$defaultBlock"]
            }
        }
        default {
            foreach {pattern_str logic_block} $body {
                set pattern_str {*}$pattern_str
                if {$no_case} {
                    if {[string equal -nocase "$pattern_str" "$matchstring"] || $ismatch eq 1} {
                        set ismatch 1
                        if {$logic_block eq "-"} {
                            continue
                        }
                        set res [uplevel 1 "$logic_block"]
                        break
                    }
                } else {
                    if {[string equal "$pattern_str" "$matchstring"] || $ismatch eq 1} {
                        set ismatch 1
                        if {$logic_block eq "-"} {
                            continue
                        }
                        set res [uplevel 1 "$logic_block"]
                        break
                    }
                }
                if {$pattern_str eq "default"} {
                    set defaultBlock $logic_block
                }
            }
            if {$ismatch eq 0 && $defaultBlock ne ""} {
                set res [uplevel 1  "$defaultBlock"]
            }
        }
    }
    return ""
}

感谢您对新爸的持续关注和支持，您的支持是我前进的动力，欢迎抖音搜索新爸。