#! /bin/sh
#
# This file is part of TiPi (a Toolkit for Inverse Problems and Imaging)
# developed by the MitiV project.
#
# Copyright (c) 2014 the MiTiV project, http://mitiv.univ-lyon1.fr/
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
# DEALINGS IN THE SOFTWARE.
#
#------------------------------------------------------------------------------
# The next line restarts using tclsh (do not remove backspace ->) \
    exec tclsh "$0" "$@"

#===============================================================================
# PRE-PROCESSOR CODE AND NAMESPACE

namespace eval ::tpp {
  # Changing the two variables below can be done to customize the preprocessor.
  variable COMMENT "//";  # String to mark a comment.
  variable MARKER "#";    # String to mark a directive.

  # Regular expression to match a variable name:
  variable VARNAME "\[A-Za-z_\]\[0-9A-Za-z_\]*"

  variable READONLY; # An array with the special macro names.
  variable MACRO;    # Currently defined macros.
  variable OUTPUT;   # Output channel.
  variable BUFFER;   # Output buffer

  # usage: start INPUT OUTPUT [NAME1 VALUE1 [NAME2 VALUE2 ...]]
  #
  # This command starts the processing of a file.  INPUT is the input file; if
  # it is a single dash (i.e., "-"), the standard input is used; otherwise it
  # is the name of the file to process.  OUTPUT is the output file; if it is
  # empty (i.e., ""), a text buffer is produced and returned as the result of
  # the command; if it is a single dash (i.e., "-"), the standard output is
  # used; otherwise it is the name of the file to produce.  The remaining
  # arguments are pair of names and values to predefine macros.
  proc start {input output args} {
    # Register the names of read-only macros and predefine them.
    variable READONLY
    variable MACRO
    variable COMMENT
    array unset MACRO
    foreach {name value} {
      __FILE__      ""
      __LINE__      0
      __NEWLINE__   "\n"
      __SPACE__     " "
      __COMMENT__   $COMMENT
    } {
      set READONLY($name) true
      set MACRO($name) $value
    }

    # Define other macros (witout any substitution).
    foreach {name value} $args {
      assertWritable $name
      set MACRO($name) $value
    }

    # Install filter?
    global DOCFILTER
    variable FILTER ""
    if {$DOCFILTER && [info exists MACRO(rank)] && $MACRO(rank) < 9} {
      set n [expr {$MACRO(rank) + 1}]
      set FILTER "^\[ \t\]*(\\*|${COMMENT})\[ \t\]@param\[ \t\]+(i|dim|stride)\[$n-9\]"
    }

    # Prepare for processing.
    variable BUFFER ""
    variable OUTPUT ""
    if {$output eq ""} {
      proc emit line {
        variable BUFFER
        append BUFFER $line "\n"
      }
    } elseif {$output eq "-"} {
      set OUTPUT stdout
      proc emit line {
        puts $line
      }
    } else {
      set OUTPUT [open $output "w"]
      proc emit line {
        variable OUTPUT
        puts $OUTPUT $line
      }
    }
    include $input
    if {$OUTPUT ne "" && $OUTPUT ne "stdout" && $OUTPUT ne "stderr"} {
      close $OUTPUT
    }
  }

  # Include a file, parse it (see includeParser) and process it (see
  # includeProcessor).
  proc include {input} {
    # Open the input file.
    if {$input eq "-"} {
      set channel stdin
    } else {
      set channel [open $input]
    }

    # Remember previous file name and line number, then set current input name
    # and line number.
    variable MACRO
    set prevFile $MACRO(__FILE__)
    set prevLine $MACRO(__LINE__)
    set MACRO(__FILE__) $input
    set MACRO(__LINE__) 0

    # Parse the file contents (make sure to close the channel in case of
    # errors).
    set status [catch {includeParser code $channel} result options]
    close $channel
    if {$status} {
      return -options $options $result
    }

    # Process the file contents.
    includeProcessor code

    # Restore previous file name and line number.
    set MACRO(__FILE__) $prevFile
    set MACRO(__LINE__) $prevLine
  }

  # Compile code read from input channel.
  proc includeParser {varName channel} {
    global PROGRAM DEBUG
    variable COMMENT
    variable MARKER
    variable VARNAME
    variable MACRO
    upvar $varName code

    if {$DEBUG} {
      parray MACRO
    }

    # Each nested '#if ... #elif ... #else ... #end', '#for ... #end' or
    # '#while ... #end' increase the depth.  At a given depth, the context is
    # defined by the 'state' and the 'prevIndex' variables.  The 'prevIndex'
    # variable stores the line number of the previous branch and the value of
    # the 'state' variable is one of:
    #
    #   0 = at the top level
    #   1 = inside the '#if' block of the current level
    #   2 = inside an '#elif' block of the current level
    #   3 = inside the '#else' block of the current level
    #   4 = inside a '#while' block of the current level
    #   5 = inside a '#for' block of the current level
    #
    set depth 0
    set state 0
    set prevIndex -1

    # Make an alias so that the 'index' variable is also the current line
    # number.
    upvar 0 MACRO(__LINE__) index

    # Process the file contents line by line.
    while {[gets $channel line] >= 0} {
      # Figure out whether new input line is a simple text line or a
      # preprocessor directive.
      incr index
      if {! [regexp -- "^\[ \t\]*${COMMENT}\[ \t\]*${MARKER}\[ \t\]*(.*)" $line - tail]} {
        # We have a simple text line.  (FIXME: A possible optimization for
        # further processing is to pre-detect whether or not macro expansion
        # will be needed.)
        set code($index,command) "text"
        set code($index,data) $line
        continue
      }

      # Get rid of the comment part, if any, and of trailing spaces.
      set i [string first $COMMENT $tail]
      if {$i >= 0} {
        set tail [string range $tail 0 [expr {$i - 1}]]
      } else {
        set tail [trim $tail]
      }
      if {$tail eq ""} {
        set code($index,command) "none"
        set code($index,data) $line
        continue
      }

      # Get the command of the directive.
      if {! [regexp -- "^(${VARNAME})\[ \t\]*(.*)" $tail - command tail]} {
        failure
      }
      set tail [trim $tail]; # FIXME: trimright is sufficient

      # Parse preprocessor directive.
      set code($index,command) $command
      set code($index,data) $line
      switch -exact -- $command {
        "def" {
          if {! [regexp -- "^(${VARNAME})\[ \t\]*(=|:=)\[ \t\]*(.*)" \
                     $tail - name operator value]} {
            failure
          }
          assertWritable $name
          set code($index,name) $name
          set code($index,operator) $operator
          set code($index,value) [trim $value]
        }
        "eval" {
          if {! [regexp -- "^(${VARNAME})\[ \t\]*((|\[-+*/%\]|<<|>>)=)\[ \t\]*(.*)" \
                     $tail - name operator - expression]} {
            failure
          }
          assertWritable $name
          set code($index,name) $name
          set code($index,operator) $operator
          set code($index,expression) [assertNonEmpty $expression]
        }
        "undef" -
        "suspend" -
        "resume" {
          set names -
          while {[regexp -- "^(${VARNAME})\[ \t\]*(.*)" $tail - name tail]} {
            assertWritable $name "unset"
            lappend names $name
          }
          assertEmpty $tail
          if {[llength $names] < 1} {
            failure "no macro names after '#${command}' directive"
          }
          set code($index,names) $names
        }
        "if" {
          pushContext 1; # also set state
          set code($index,expression) [assertNonEmpty $tail]
          set prevIndex $index
        }
        "elif" {
          if {$state < 1 || $state > 2} {
            failure "directive '#${command}' incorrectly nested"
          }
          set state 2
          set code($index,expression) [assertNonEmpty $tail]
          set code($prevIndex,jump) $index
          set prevIndex $index
        }
        "else" {
          if {$state < 1 || $state > 2} {
            failure "directive '#${command}' incorrectly nested"
          }
          set state 3
          assertEmpty $tail
          set code($prevIndex,jump) $index
          set prevIndex $index
        }
        "while" {
          pushContext 4; # also set state
          if {$tail eq ""} {
            failure "missing expression in '#${command}' directive"
          }
          set code($index,expression) [assertNonEmpty $tail]
          set prevIndex $index
        }
        "for" {
          pushContext 5; # also set state
          if {! [regexp -- "^(${VARNAME})\[ \t\]+in\[ \t\]+(.*)\$" \
                     $tail - name data]} {
            failure
          }
          assertWritable $name
          set code($index,name) $name
          set code($index,data) $data
          set prevIndex $index
        }
        "end" {
          if {$state < 1 || $state > 5} {
            failure "directive '#${command}' incorrectly nested"
          }
          assertEmpty $tail
          set code($index,state) $state
          set code($prevIndex,jump) $index
          if {$state >= 4} {
            # Was inside '#while" or '#for' block.
            set code($index,jump) $prevIndex
          }
          popContext
        }
        "emit" -
        "echo" -
        "warn" -
        "error" -
        "debug" {
          set code($index,value) $tail
        }
        "include" {
          set code($index,value) [assertNonEmpty $tail]
        }
        default {
          failure "unknown preprocessor directive"
        }
      }
    }

    if {$depth != 0} {
      failure "there are unclosed '#if', '#for' or '#while' directives"
    }

    set code(length) $MACRO(__LINE__)

    if {$DEBUG} {
      for {set index 1} {$index <= $code(length)} {incr index} {
        puts stderr [format "%4d: %s" $index $code($index,data)]
        set str ""
        foreach item [list command name value expression jump] {
          if {[info exists code($index,$item)]} {
            append str "      $item = $code($index,$item)\n"
          }
        }
        puts -nonewline stderr $str
      }
    }
  }

  # Save current context, then increase depth and update context.
  proc pushContext {newState} {
    upvar depth depth state state prevIndex prevIndex ctx ctx
    set ctx($depth,state) $state
    set ctx($depth,prevIndex) $prevIndex
    set state $newState
    set prevIndex -1
    incr depth
  }

  # Restore previous context.
  proc popContext {} {
    upvar depth depth state state prevIndex prevIndex ctx ctx
    incr depth -1
    if {$depth < 0} {
      failure "bug in parser"
    }
    set state     $ctx($depth,state)
    set prevIndex $ctx($depth,prevIndex)
    array unset ctx($depth,*)
  }

  proc assertEmpty {text} {
    if {$text ne ""} {
      upvar command command
      failure "non-commentary garbage after '#${command}' directive"
    }
  }

  proc assertNonEmpty {expression} {
    if {$expression eq ""} {
      upvar command command
      failure "missing expression in '#${command}' directive"
    }
    return $expression
  }

  # Remove leading and trailing spaces.
  proc trim arg {string trim $arg " \t"}

  proc stripComment {line} {
    variable COMMENT
    set i [string first $COMMENT $line]
    if {$i >= 0} {
      trim [string range $line 0 [expr {$i-1}]]
    } else {
      trim $line
    }
  }

  # Throw an error with line and file name information.
  proc failure {{reason "syntax error"}} {
    variable MACRO
    if {$MACRO(__FILE__) ne ""} {
      append reason " at line $MACRO(__LINE__) of \"$MACRO(__FILE__)\""
    }
    uplevel [list error $reason]
  }

  proc assertWritable {name {operation "set"}} {
    variable READONLY
    if {[info exists READONLY($name)]} {
      failure "attempt to $operation read-only macro \"$name\""
    }
  }

  # Execute the code "compiled" by "includeParser".  This is the second
  # stage of preocessing an input file.
  proc includeProcessor {varName} {
    global PROGRAM DEBUG DOCFILTER
    variable PREFIX
    variable VARNAME
    variable MACRO
    variable BUFFER
    variable FILTER
    upvar $varName code

    # Make an alias so that the 'index' variable is also the current line
    # number.
    upvar 0 MACRO(__LINE__) index

    # Process the pre-compiled code.
    for {set index 1} {$index <= $code(length)} {incr index} {
      set command $code($index,command)
      switch -exact -- $command {
        "text" {
          set line [expandMacros $code($index,data) 2]
          if {$FILTER eq "" || ! [regexp -- $FILTER $line]} {
            emit $line
          }
        }
        "def" {
          set name $code($index,name)
          if {$code($index,operator) eq "="} {
            set MACRO($name) [expandMacros $code($index,value) 2]
          } else {
            set MACRO($name) [expandSingle $code($index,value) $name]
          }
          unset -nocomplain MACRO(-$name)
        }
        "eval" {
          set name $code($index,name)
          set operator $code($index,operator)
          set expression $code($index,expression)
          if {$operator ne "="} {
            set expression "\${$name} [string range $operator 0 end-1] ($expression)"
          }
          set MACRO($name) [evalExpr $expression]
          unset -nocomplain MACRO(-$name)
        }
        "undef" {
          foreach name $code($index,names) {
            unset -nocomplain MACRO($name) MACRO(-$name)
          }
        }
        "suspend" {
          foreach name $code($index,names) {
            if {[info exists MACRO($name)]} {
              set MACRO(-$name) $MACRO($name)
              unset MACRO($name)
            } else {
              set MACRO(-$name) ""
            }
          }
        }
        "resume" {
          foreach name $code($index,names) {
            if {[info exists MACRO(-$name)]} {
              set MACRO($name) $MACRO(-$name)
              unset MACRO(-$name)
            } else {
              set MACRO($name) ""
            }
          }
        }
        "if" {
          while {! [evalTest $code($index,expression)]} {
            set index $code($index,jump)
            set command $code($index,command)
            if {$command ne "elif"} {
              if {$command ne "else" && $command ne "end"} {
                failure "ouch!"
              }
              break
            }
          }
        }
        "elif" -
        "else" {
          while {$command ne "end"} {
            set index $code($index,jump)
            set command $code($index,command)
          }
        }
        "while" {
          if {! [evalTest $code($index,expression)]} {
            set index $code($index,jump)
            set command $code($index,command)
            if {$command ne "end"} {
              failure "ouch!"
            }
          }
        }
        "for" {
          # Extract argument list.
          set argument [expandMacros $code($index,data) 2]
          set iteratorCommand "iterateList"
          if {[string first ":" $argument] > 0} {
            if {[scan $argument "%d : %d : %d %\[^\n\]" first last step -] == 3} {
              if {$step == 0} {
                failure "invalid 0-step in range"
              }
              set iteratorCommand "iterateRange"
            } elseif {[scan $argument "%d : %d %\[^\n\]" first last -] == 2} {
              set step 1
              set iteratorCommand "iterateRange"
            }
          }

          # Initialize iterator.
          array unset code $index,iterator,*
          if {$iteratorCommand eq "iterateRange"} {
            set code($index,iterator,first) $first
            set code($index,iterator,last) $last
            set code($index,iterator,step) $step
          } else {
            set code($index,iterator,length) [llength $argument]
            set code($index,iterator,values) $argument
          }
          set code($index,iterator,index) 0
          set code($index,iterator,command) $iteratorCommand

          # Evaluate iterator a first time.
          if {! [$iteratorCommand code $index]} {
            set index $code($index,jump)
            set command $code($index,command)
            if {$command ne "end"} {
              failure "ouch!"
            }
          }
        }
        "end" {
          switch -exact -- $code($index,state) {
            4 {
              # At the end of a '#while' loop.
              set prevIndex $code($index,jump)
              if {[evalTest $code($prevIndex,expression)]} {
                set index $prevIndex
                set command $code($index,command)
                if {$command ne "while"} {
                  failure "ouch!"
                }
              }
            }
            5 {
              # At the end of a '#for' loop.
              set prevIndex $code($index,jump)
              if {[$code($prevIndex,iterator,command) code $prevIndex]} {
                set index $prevIndex
                set command $code($index,command)
                if {$command ne "for"} {
                  failure "ouch!"
                }
              }
            }
          }
        }
        "emit" {
          # Recursively expand remaining text and print it on the output.
          emit [expandMacros $code($index,value) 2]
        }
        "echo" {
          # Recursively expand remaining text and print it on the standard
          # output.
          puts stdout [expandMacros $code($index,value) 2]
        }
        "warn" {
          # Recursively expand remaining text and print it on the standard
          # output.
          puts stderr [expandMacros $code($index,value) 2]
        }
        "error" {
          # Recursively expand remaining text and throw an error.
          failure [expandMacros $code($index,value) 2]
        }
        "debug" {
          # '#debug' directive is similar to the '#echo' directive, except
          # that the standard error output is used and that a single round of
          # macro expansion is performed.
          puts stderr [expandMacros $code($index,value) 0]
        }
        "include" {
          set name [expandMacros $code($index,value) 2]
          if {[string match "<*>" $name] || [string match "\"*\"" $name]} {
            set name [string range $name 1 end-1]
          } else {
            failure "missing or ill-formed file name in '#include' directive"
          }
          if {$name eq "" || ! [file readable $name]} {
            failure "unreadale file \"$name\" in '#include' directive"
          }
          include $name
        }
        "none" {
          # Nothing to do.
        }
        default {
          failure "unknown preprocessor directive"
        }
      }
    }
  }

  proc iterateRange {varName index} {
    upvar $varName code
    set i $code($index,iterator,index)
    set first $code($index,iterator,first)
    set last  $code($index,iterator,last)
    set step  $code($index,iterator,step)
    set value [expr {$first + $step*$i}]
    if {$step > 0} {
      if {$value > $last} {
        return false
      }
    } else {
      if {$value < $last} {
        return false
      }
    }
    set name $code($index,name)
    incr code($index,iterator,index)

    variable MACRO
    set MACRO($name) $value
    unset -nocomplain MACRO(-$name)
    return true
  }

  proc iterateList {varName index} {
    upvar $varName code
    set i $code($index,iterator,index)
    if {$i >= $code($index,iterator,length)} {
      return false
    }
    set value [lindex $code($index,iterator,values) $i]
    set name $code($index,name)
    incr code($index,iterator,index)

    variable MACRO
    set MACRO($name) $value
    unset -nocomplain MACRO(-$name)
    return true
  }

  proc expandExpression {expression} {
    # Recursively expand expression.
    set expression [expandMacros $expression 3]

    # Replace 'defined(name)' by true/false value.
    variable MACRO
    set start 0
    while {[regexp -indices -start $start -- \
                "(^|\[^A-Za-z0-9_\])defined\[ \t\]*\\(\[ \t\]*(\[A-Za-z_\]\[A-Za-z0-9_\]*)\[ \t\]*\\)" \
                $expression all begin name]} {
      set name [string range $expression [lindex $name 0] [lindex $name 1]]
      if {[info exists MACRO($name)]} {
        set value " true "
      } else {
        set value " false "
      }
      set a [lindex $begin 1]
      set b [lindex $all 1]
      set c [string length $value]
      set expression [string replace $expression $a+1 $b $value]
      set start [expr {$a + $c + 1}]
    }
    return $expression
  }

  proc evalTest {expression} {
    # Expand and evaluate expression.
    set code [format "(%s) ? 1 : 0" [expandExpression $expression]]
    if {[catch {expr $code} result]} {
      global DEBUG
      if {$DEBUG} {
        puts stderr "$code --------> $result"
      }
      failure "syntax error in test expression"
    }
    return $result
  }

  proc evalExpr {expression} {
    # Expand and evaluate expression.
    if {[catch {expr [expandExpression $expression]} result]} {
      global DEBUG
      if {$DEBUG} {
        puts stderr "$expression --------> $result"
      }
      failure "syntax error in numerical expression"
    }
    return $result
  }

  #===========================================================================
  # usage: expandMacros TEXT [MODE]
  #
  # Replace all macros in TEXT by their value.  The following patterns are
  # substituted:
  #
  #   ${}     becomes a literal $
  #
  #   ${name} is replaced by the contents of the macro with the corresponding
  #           name (a macro name is an alphabetical character or an underscore
  #           "_" followed by any number of alphabetical characters,
  #           underscores or digits.
  #
  # Anything else is left unchanged (including partial or invalid ${...}
  # constructs).
  #
  # If the 1st bit of MODE is set, undefined macros are replaced by
  # unknown("name") where "name" is the quoted name of the macro.  Otherwise,
  # an error is thrown when an undefined macro is encountered.
  #
  # If the 2nd bit of MODE is set, macros are recursively expanded.
  #
  # Timings: about 1.2µs for lines of text with no macros, about 17µs for a
  # single substitution, about 30-40µs with recursive substutions.
  proc expandMacros {text {mode 0}} {
    variable MACRO
    set start 0
    while {true} {
      set index [string first "\$\{" $text $start]
      if {$index < 0} {
        return $text
      }
      if {[regexp -start $index -- "\\A\\$\{(\[A-Za-z_\]\[0-9A-Za-z_\]*)\}" \
               $text token name]} {
        # The string "${name}" is replaced by the contents of the macro.
        set tokenLength [string length $token]
        if {[info exists MACRO($name)]} {
          if {($mode & 2) != 0} {
            # Recursively expand the macro.
            set value [expandMacros $MACRO($name) $mode]
          } else {
            set value $MACRO($name)
          }
        } elseif {($mode & 1) == 0} {
          if {[info exists MACRO(-$name)]} {
            # Just skip "suspended" macro.
            set start [expr {$index + $tokenLength}]
            continue
          } else {
            failure "undefined macro \"$name\""
          }
        } else {
          set value " unknown(\"$name\")"
        }
        set valueLength [string length $value]
        set text [string replace $text $index \
                      [expr {$index + $tokenLength - 1}] $value]
        set start [expr {$index + $valueLength}]
      } elseif {[string index $text $index+2] eq "\}"} {
        # The string "\${}" is replaced by a "\$".
        set text [string replace $text $index+1 $index+2 ""]
        set start [expr {$index + 1}]
      } else {
        # Just skip the anchor string.
        set start [expr {$index + 2}]
      }
    }
  }

  #=============================================================================
  # Expand a given macro.
  proc expandSingle {text name} {
    set token "\${$name}"
    set index [string first $token $text]
    if {$index >= 0} {
      variable MACRO
      if {[info exists MACRO($name)]} {
        set value $MACRO($name)
        set valueLength [string length $value]
        set tokenLength [string length $token]
        while {$index >= 0} {
          set text [string replace $text $index \
                        [expr {$index + $tokenLength - 1}] $value]
          set index [string first $token $text [expr {$index + $valueLength}]]
        }
      } else {
        failure "undefined macro \"$name\""
      }
    }
    return $text
  }

  proc loadText {fileName} {
    set file [open $fileName "r"]
    fconfigure $file -translation "auto"
    set buffer [read $file]
    close $file
    return $buffer
  }

  proc saveText {text fileName} {
    set file [open $fileName "w"]
    fconfigure $file -translation "auto"
    puts -nonewline $file $text
    close $file
  }

}


# This is a hack to have Tcl expression parser behave correctly
# with undefined variables.
proc tcl::mathfunc::unknown {name} {
  ::tpp::failure "macro \"$name\" is undefined"
}

if {! $tcl_interactive} {
  set PROGRAM [file tail $argv0]
  set DEBUG "off"
  set USAGE "$PROGRAM \[OPTIONS\] \[INPUT \[OUTPUT\]\]"
  set VERSION "0.0.0"

  rename error originalErrorCommand
  proc error {reason {errInfo ""} {errCode NONE}} {
    global PROGRAM
    puts stderr "$PROGRAM: $reason"
    exit 1
  }

  proc die {reason} {
    global PROGRAM
    puts stderr "$PROGRAM: $reason"
    exit 1
  }

  proc main {} {
    global PROGRAM DEBUG VERSION USAGE DOCFILTER
    global argv0 argv

    # Parse arguments.
    set macros {}
    set DOCFILTER "no"
    set autopkg "no"
    set argc [llength $argv]
    for {set j 0} {$j < $argc} {incr j} {
      set arg [lindex $argv $j]
      if {! [string match "-*" $arg]} {
        break
      }
      if {[string match "-D*" $arg]} {
        if {[regexp -- "^-D(\[A-Za-z_\]\[0-9A-Za-z_\]*)=(.*)$" $arg \
                 - name value]} {
          lappend macros $name $value
        } else {
          die "ill formed option -Dname=value"
        }
      } elseif {$arg eq "--"} {
        incr j
        break
      } elseif {$arg eq "-a" || $arg eq "--autopkg"} {
        set autopkg "yes"
      } elseif {$arg eq "-f" || $arg eq "--docfilter"} {
        set DOCFILTER "yes"
      } elseif {$arg eq "-h" || $arg eq "-?" || $arg eq "--help"} {
        puts stdout "Syntax: $USAGE
Apply preprocessing to the source file INPUT to produce the destination file
OUTPUT.  If omitted or set to \"-\", the source (resp. the destination) file is
the standard input (resp.the standard output).
Options are:
  -Dname=value     Define a macro (there may be many options of this kind).
  -a, --autopkg    Guess the Java package from the name of the output file and
                   Define a macro \"package\" with it.
  -f, --docfilter  Filter JavaDoc comments for unused parameters.
  --debug          Turn debug mode on.
  -h, -?, --help   Print this help and exit.
  -v, --version    Print version number and exit.
  --               Indicate the end of the options."
        exit 0
      } elseif {$arg eq "-v" || $arg eq "--version"} {
        puts stdout $VERSION
        exit 0
      } elseif {$arg eq "--debug"} {
        set DEBUG "on"
      } else {
        die "unknown option \"$arg\""
      }
    }
    set n [expr {$argc - $j}]
    if {$n > 2} {
      puts stderr "$PROGRAM: too many arguments"
      puts stderr "usage: $USAGE"
      exit 1
    }
    if {$n >= 1} {
      set input [lindex $argv $j]
    } else {
      set input "-"
    }
    if {$n >= 2} {
      set output [lindex $argv $j+1]
    } else {
      set output "-"
    }

    if {$autopkg} {
      # Figure out the package name from the destination file.
      if {$output eq "-"} {
        die "cannot guess package name for standard output"
      }
      set path [file dirname [file normalize $output]]
      regsub -- "^.*/src/" $path "" path
      regsub -- "/\$" $path "" path
      regsub -all -- "/" $path "." pkg
      lappend macros package $pkg
    }

    if {$DEBUG} {
      puts stderr "input ------> $input"
      puts stderr "output -----> $output"
      puts stderr "macros -----> $macros"
    }
    eval [list tpp::start $input $output] $macros
  }

  main
}

# Local Variables:
# mode: Tcl
# tab-width: 8
# indent-tabs-mode: nil
# tcl-basic-offset: 2
# fill-column: 78
# coding: utf-8
# ispell-local-dictionary: "american"
# End:
