Version 2 of Preprocessing and Radical Language Modification

Updated 2002-04-23 21:54:51

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

 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"
 }