I often run into syntactic prejudice when I am writing software to spec. This often seems to preclude using Tcl, which, of course, tends to bloat the amount of work and the time and money needed to accomplish it. Eventually, however, I came up with the "run" command - it's a replacement for "source" but it does some extensive preprocessing before running the code, allowing some really radical language changes without any run-time overhead.
run.tcl:
proc run { filename { macrolist "" } } {
if { "$macrolist" != "" } {
upvar $macrolist macros
}
if [catch { set f [ open $filename r ] } err ] { return -code $err }
set src [ read $f ]
foreach key [array names macros] {
regsub -all $key $src $macros($key) src
}
set exp ""
while 1 {
if [regexp "(.*)(<<<.*>>>)(.*)" $src -> head exp tail] {
regsub <<< $exp "" exp
regsub >>> $exp "" exp
set result [ uplevel eval $exp ]
set src "$head$result$tail"
} else {
break
}
}
# puts $src ;# uncomment to see translation
uplevel eval $src}
Now, suppose we wish to add some syntactic sugar to expr, and to have an input language looking like Oberon or Modula. We code this:
source run.tcl # source deref.tcl
proc compute { args } {
set exp ""
set id ""
regsub "''" [ string trim $args ] "@@@" args
while 1 {
regexp "(\[^a-zA-Z_'\]*)(\[a-zA-Z0-9_'\]*)(.*)" $args -> head id tail
if ![ string length $id ] {
set exp "$exp$head"
break
}
set dollar ""
if ![ string equal [ string index $id 0 ] "'" ] {
if ![ string equal [info commands $id] "" ] {
set id "\[ $id"
regexp {[^\(]*\(([^\)]*)\)(.*)} $tail -> params tail
set tail " $params \]$tail"
} else { set dollar "\$" }
}
append exp "$head$dollar$id"
set args $tail
}
regsub -all "'" $exp "\"" exp
set map "@@@ ' and && or || not ! <> != true 1 false 0 on 1 off 0 yes 1 no 0 pi 3.1415926535"
foreach { from to } $map {
regsub $from $exp $to exp
}
set exp [ uplevel subst -novariable \{$exp\} ]
return "\{ $exp \}"}
set xlate(IF) "if <<< compute " set xlate(THEN) ">>> \{"" set xlate(ELSE) "\} else \{" set xlate(ELSIF) "\} elseif \[ compute " set xlate(END) "\}" set xlate(WHILE) "while \{ \[ compute " set xlate(DO) "\] \} \{"
"compute" is a macro that handles the translation of "expr", and "xlate" is a simple textual substitution table. Now we can take the file "foo.tcl":
# basic tcl syntax is still there: set x 1
# So is new modula-style IF x <> 1 THEN
puts "x is NOT 1"
ELSE
puts "x IS 1"
END
and run it from a tcl script:
run foo.tcl xlate
and what is actually sourced is:
set x 1
if { $x != 1 } {
puts "x is NOT 1"
} else {
puts "x IS 1"
}
> !v vi temp > cat temp
I often run into syntactic prejudice when I am writing software to spec. This often seems to preclude using Tcl, which, of course, tends to bloat the amount of work and the time and money needed to accomplish it. Eventually, however, I came up with the "run" command - it's a replacement for "source" but it does some extensive preprocessing before running the code, allowing some really radical language changes without any run-time overhead.
run.tcl:
proc run { filename { macrolist "" } } {
if { "$macrolist" != "" } {
upvar $macrolist macros
}
if [catch { set f [ open $filename r ] } err ] { return -code $err }
set src [ read $f ]
foreach key [array names macros] {
regsub -all $key $src $macros($key) src
}
set exp ""
while 1 {
if [regexp "(.*)(<<<.*>>>)(.*)" $src -> head exp tail] {
regsub <<< $exp "" exp
regsub >>> $exp "" exp
set result [ uplevel eval $exp ]
set src "$head$result$tail"
} else {
break
}
}
# puts $src ;# uncomment to see translation
uplevel eval $src}
Now, suppose we wish to add some syntactic sugar to expr, and to have an input language looking like Oberon or Modula. We code this:
source run.tcl # source deref.tcl
proc compute { args } {
set exp ""
set id ""
regsub "''" [ string trim $args ] "@@@" args
while 1 {
regexp "(\[^a-zA-Z_'\]*)(\[a-zA-Z0-9_'\]*)(.*)" $args -> head id tail
if ![ string length $id ] {
set exp "$exp$head"
break
}
set dollar ""
if ![ string equal [ string index $id 0 ] "'" ] {
if ![ string equal [info commands $id] "" ] {
set id "\[ $id"
regexp {[^\(]*\(([^\)]*)\)(.*)} $tail -> params tail
set tail " $params \]$tail"
} else { set dollar "\$" }
}
append exp "$head$dollar$id"
set args $tail
}
regsub -all "'" $exp "\"" exp
set map "@@@ ' and && or || not ! <> != true 1 false 0 on 1 off 0 yes 1 no 0 pi 3.1415926535"
foreach { from to } $map {
regsub $from $exp $to exp
}
set exp [ uplevel subst -novariable \{$exp\} ]
return "\{ $exp \}"}
set xlate(IF) "if <<< compute " set xlate(THEN) ">>> \{"" set xlate(ELSE) "\} else \{" set xlate(ELSIF) "\} elseif \[ compute " set xlate(END) "\}" set xlate(WHILE) "while \{ \[ compute " set xlate(DO) "\] \} \{"
"compute" is a macro that handles the translation of "expr", and "xlate" is a simple textual substitution table. Now we can take the file "foo.tcl":
# basic tcl syntax is still there: set x 1
# So is new modula-style IF x <> 1 THEN
puts "x is NOT 1"
ELSE
puts "x IS 1"
END
and run it from a tcl script:
run foo.tcl xlate
and what is actually sourced is:
set x 1
if { $x != 1 } {
puts "x is NOT 1"
} else {
puts "x IS 1"
}