# preprocessor.tcl --
# 
# This file provides preprocessing directives and a limited macro facility.
# 
# Copyright (c) 2016-2017, Christopher M. Stephan <[email protected]>
# Free to use, no warranty implied, use at your own risk.

namespace eval ::preprocessor {

  namespace export eval
  namespace ensemble create -command ::preprocessor -subcommands eval

  variable DEFINES
  array set DEFINES {}

  proc eval {body} {
    variable DEFINES

    set result     {}
    set defname    {}
    set defval     {}
    set breadcrumb {}
    set linenum    0
    set includecontent true
    set exprFilter {[^ @_A-Za-z0-9=<>()&|/%*^+-]*}
    set defFilter  {@[_A-Za-z0-9]+}

    foreach line [split $body "\n"] {
    
      incr linenum
      puts "#### line $linenum : $line      (bc:$breadcrumb)"
      switch -exact -- [lindex $line 0] {

        \#DEFINE {
          # process line
          set line [lassign $line instruction defname defval]

          # validate arguments
          if {[string length $line]>0} {
            error [format {preprocessor-define: too many arguments in %s on line %s: "%s"} $instruction $linenum $line]
          }
          if {[string equal $defval {}]} {
            error [format {preprocessor-define: define value not specified for "%s" on line %s:%s "%s"} $instruction $linenum "\n       " $line]
          }

          set DEFINES(@$defname) $defval

          unset defname
          unset defval
        }

        \#IFNDEF -
        \#IFDEF {
          #### PROCESS FOR @IFDEF AND @IFNDEF
          # single function checks for undefined and defined variables
          # by using setting invert variable to ! if this is IFNDEF 
          
          # make sure we're not already processing an IF or IFDEF
          if {![string equal $breadcrumb {}]} {
            set errmsg    {preprocessor-ifdef: recursive preprocessor scripts unsupported, currently processing:} 
            foreach stack_frame $breadcrumb {
              append errmsg "\n   --> $stack_frame"
            }
            error $errmsg
          }
          # process line...
          set line [lassign $line instruction defname]
          if {[string length $line]>0} {
            error [format {preprocessor-ifdef: too many arguments in %s on line %s: "%s"} $instruction $linenum $line]
          }
          # set breadcrumb
          lappend breadcrumb "${instruction}(${defname}) linenum:$linenum"
          # deal with inversion... (NDEF)
          set INVERT [expr {[string equal $instruction IFNDEF] ? {!} : {}}]
          if {[expr ${INVERT} [info exist DEFINES($defname)]]} {
            # passes condition... all lines unil else or elif are kept.
            set includecontent true
          } else { 
            # failes condition... all lines until else or elif are dropped.
            set includecontent false
          }
          
          unset instruction
          unset defname
        }

        \#IF {
          #### PROCESSES @IF

          # make sure we're not already processing an IF or IFDEF
          if {![string equal $breadcrumb {}]} {
            set errmsg    {preprocessor-if: recursive preprocessor scripts unsupported, currently processing:} 
            foreach stack_frame $breadcrumb {
              append errmsg "\n   --> $stack_frame"
            }
            error $errmsg
          }

          # process line
          set line [lassign $line instruction expression]
          if {[string length $line]>0} {
            error [format {preprocessor-if: too many arguments in @%s on line %s: "%s"} $instruction $linenum $line]
          }

          # check expression character use for invalid characters
          if {[regsub -all -- $exprFilter $expression {} filteredExpression] > 0} {
            set errmsg     {preproceossor: expression in \"%s\" on line $linenum contains illegal symbols.}
            lappend errmsg "\n        submitted"
            lappend errmsg "\n   [string map [list \n {} \r {}] [string trim $expression]]\n"
            lappend errmsg "\n        passed through filter:"
            lappend errmsg "\n   $filteredExpression\n"
          } 

          set ppexpr {}
          # substitute @defines
          foreach {full_match expr var} [regexp -inline -all -- {([^@]*)(@[_A-Za-z0-9]+)} $expression] {
            append ppexpr ${expr}$DEFINES($var)
          }

          # attempt evaluation
          if {[catch {expr $ppexpr} res]} {
            error [format {preprocessor: expression evaluation failure: "%s" on line %s} $expression $linenum]
          }
          # set breadcrumb
          lappend breadcrumb "${instruction}(${expression}) linenum:$linenum"
          # handle result
          if {$res} {
            # passes condition... all lines unil else or elif are kept.
            set includecontent true
          } else { 
            # failes condition... all lines until else or elif are dropped.
            set includecontent false
          }

          unset ppexpr
          unset instruction
          unset expression
          unset full_match
          unset expr
          unset var
          unset res
        }

        \#ELSE {
          #### PROCESSES @ELSE

          # make sure we're already processing an IF/IFDEF/IFNDEF
          if {[string equal $breadcrumb {}]} {
            error [format {preprocessor-else: ELSE before IF, IFDEF, or IFNDEF on line %s} $linenum]
          }

          # process line
          set line [lassign $line instruction expression]

          # invert current action as we're now operating on the ELSE
          set includecontent [expr {$includecontent ? false : true }]            
        }

        \#ENDIF {
          #### PROCESSES @ENDIF

          # make sure we're already processing an IF/IFDEF/IFNDEF
          if {[string equal $breadcrumb {}]} {
            error [format {preprocessor-endif: ENDIF before IF, IFDEF, or IFNDEF on line %s} $linenum]
          }

          set breadcrumb {}
          set includecontent true
        }

        default {
          #### CONTROLLED CONTENT

          if {$includecontent} {
            append result $line\n
          }
        }
      }
    }

    return [uplevel $result]
  }
}