Posted to tcl by bairui at Fri Nov 02 04:47:04 GMT 2018view raw
- proc parseScript {script} {
- global knownGlobals unknownCommands knownCommands syntax
- catch {unset unknownCommands}
- set unknownCommands {}
- set knownVars {}
- array set ::knownAliases {}
- array set ::namespacePaths {}
- foreach g $knownGlobals {
- knownVar knownVars $g
- dict set knownVars $g set 1
- }
- set ::Nagelfar(firstpass) 0
- set script [buildLineDb $script]
- set ::instrumenting(script) $script
- pushNamespace {}
- if {$::Nagelfar(2pass)} {
- # First do one round with proc checking
- set ::Nagelfar(firstpass) 1
- parseBody $script 0 knownVars
- #echo "Second pass"
- set ::Nagelfar(firstpass) 0
- }
- parseBody $script 0 knownVars
- popNamespace
- # Check commands that where unknown when encountered
- # FIXA: aliases
- foreach apa $unknownCommands {
- foreach {cmd cmds index} $apa break
- set found 0
- foreach cmdCandidate $cmds {
- if {[info exists syntax($cmdCandidate)] || \
- [lsearch $knownCommands $cmdCandidate] >= 0} {
- set found 1
- break
- }
- }
- if {!$found} {
- # Close brace is reported elsewhere
- if {$cmd ne "\}"} {
- # Different messages depending on name
- if {[regexp {^(?:(?:[\w',:.-]+)|(?:%W))$} $cmd]} {
- errorMsg W "Unknown command \"$cmd\"" $index
- } else {
- errorMsg E "Strange command \"$cmd\"" $index
- }
- }
- }
- }
- # Update known globals.
- foreach var [dict keys $knownVars] {
- if {[dict get $knownVars $var namespace] != ""} continue
- if {[dict get $knownVars $var local]} continue
- # Check if it has been set.
- if {[dict get $knownVars $var set]} {
- if {[lsearch $knownGlobals $var] == -1} {
- lappend knownGlobals $var
- }
- }
- }
- }