# This code converts Infix notation to RPN using the "shunting-yard" algorithm
# There are several things one can do with this in terms of types of expressions
# and operators handled.  In particular there are mods here to handle a simple
# boolean expression with functions that are on the incoming stack as list 
# elements of length 2 (the first is the function, the second the argument)
# Also this a simple left to right no precedence version. 

# An attempt has been made to leave more complex structures in place as comments
# in case they might be needed at some later date.
#
package require Tcl 8.5
 
# Helpers
proc tokenize {str} {
  # regexp -all -inline {[\d.]+|[-*^+/()]} $str
  return $str
}

# proc precedence op {
#   dict get {^ 4 * 3 / 3 + 2 - 2} $op
# }
proc precedence op {expr {$op == "!" ? 1 : 0}}
# proc associativity op {
#   if {$op eq "^"} {return "right"} else {return "left"}
# }

if {0} {
  proc putsDbug {mess} {puts $mess}
} else {
  proc putsDbug {m} {}
}

proc shuntingYard {expression} {
  set stack {}
  set output {}
  foreach token [tokenize $expression] {
    # This seems like a more general test and allows functions etc.  
    # Numbers might be represented as {key number} where key 
    # is some available (non function name) string.
    if { [llength $token] > 1} {
      putsDbug "add to output: $token"
      lappend output $token
    } elseif {$token eq "("} {
      putsDbug "push parenthesis"
      lappend stack $token
    } elseif {$token eq ")"} {
      putsDbug "popping to parenthesis"
      while {[lindex $stack end] ne "("} {
	lappend output [lindex $stack end]
	set stack [lreplace $stack end end]
	putsDbug "...popped [lindex $output end] to output"
      }
      set stack [lreplace $stack end end]
      putsDbug "...found parenthesis"
    } else {
      putsDbug "adding operator: $token"
      set p [precedence $token]
      # set a [associativity $token]
      # The following assumes that 'stack' never contains a null entry
      while {[set o2 [lindex $stack end]] != {}} {
        # if {
	#     $o2 ne "(" &&
	#     (($a eq "left" && $p <= [precedence $o2]) ||
	#      ($a eq "right" && $p < [precedence $o2]))
	#   } then {
	#   putsDbug "...popped operator $o2 to output"
	#   lappend output $o2
	#   set stack [lreplace $stack end end]
	# } else {
	#   break
	# }

	# This if statement is for no associativity 
	  
	if {$o2 ne "(" && $p <= [precedence $o2]} {
	  putsDbug "....popped operator $o2 to output"
	  lappend output $o2
	  set stack [lreplace $stack end end]
	} else {
	  break
	}
      }
      lappend stack $token
    }
    putsDbug "\t\tOutput:\t$output\n\t\tStack:\t$stack"
  }
  putsDbug "transferring tokens from stack to output"
  lappend output {*}[lreverse $stack]
}

putsDbug [shuntingYard "{no 3} + {no 4} * {no 2} / ( {no 1} - {no 5} ) ^ {no 2} ^ {no 3}"]
