# constjump.tcl --
#
#	Code to simplify conditional jumps that depend on values that
#	are constant in the predecessor block.
#
# Copyright (c) 2015 by Kevin B. Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-----------------------------------------------------------------------------

# quadcode::transformer method constJumpPeephole --
#
#	Peephole optimization for conditional jumps that depend only on
#	constants in earlier blocks.
#
# Preconditions:
#	This method must run after critical edges in the flow graph are split,
#	but before conversion to SSA form. (It reroutes edges in the flow
#	graph in a way that makes SSA structure difficult to preserve.)
#
# Results:
#	None.
#
# Side effects:
#	Conditional jumps that depend on a constant in the
#	immediate predecessor are handled by splitting the node.
#
# Notes:
#	This pass is exceedingly likely to leave dead code behind, and
#	it is important to clean up after it. It is sensible to defer the
#	cleanup until after SSA generation. It is also sensible to wait to
#	insert data type and variable existence assertions until after this
#	pass has untangled the control flow.
#
# This method is designed to rationalize code that the Tcl bytecode
# compiler generates for && and || operations. Both of these operations
# generate code where there is a basic block containing a single jumpTrue
# or jumpFalse, and predecessor blocks that assign a literal 0 or 1 to the
# condition. This structure gets in the way of type inference, because it
# artificially causes control flows to converge, even though they will
# immediately separate again. A check like
#	if {[string is double $x] && $x >= 0.0} { ... }
# will be unable to deduce in the body of the 'if' that $x is double
# without this transformation.
#
# TODO : An equivalent, and perhaps more powerful, transformation would
#        be to defer the node splitting until after the code is in SSA
#        form, and then test for 'jumpTrue' and 'jumpFalse' operations
#	 whose conditions depend on a phi that has at least one argument
#	 being a literal. The phi operations can then be split, at least
#	 moving the problem. Continued splitting should 'unzip' the code
#	 path all the way down to the conditional.

oo::define quadcode::transformer method constJumpPeephole {} {

    my variable bbcontent
    my variable bbpred

    my debug-constJumpPeephole {
	puts "before node splitting of conditional branches:"
	my dump-bb
    }

    # Search for blocks that end in a conditional jump.
    set b -1
    foreach content $bbcontent {
	incr b

	# This optimization applies only to two-exit blocks. Work out
	# what are the 'true' and 'false' branches
	if {[lindex $content end 0] ne "jump"} continue
	switch -exact [lindex $content end-1 0] {
	    "jumpTrue" {
		set trueBranch [lindex $content end-1 1 1]
		set falseBranch [lindex $content end 1 1]
	    }
	    "jumpFalse" {
		set falseBranch [lindex $content end-1 1 1]
		set trueBranch [lindex $content end 1 1]
	    }
	    default {
		# Single-exit blocks are not suitable for this
		# transformation
		continue
	    }
	}

	# Determine whether the jump condition flows in from a
	# predecessor block.

	set assignedAt {}
	set peephole 0
	set pc -1
	foreach q $content {
	    incr pc
	    switch -exact -- [lindex $q 0 0] {
		"copy" {

		    # It's ok if the condition is copied before being tested
		    set src [lindex $q 2]
		    set tgt [lindex $q 1]
		    if {[dict exists $assignedAt $src]} {
			set whence [dict get $assignedAt $src]
		    } else {
			set whence $src
			lappend whence -1
			dict set assignedAt $src $whence
		    }
		    dict set assignedAt $tgt $whence
		}

		"jumpTrue" -
		"jumpFalse" {
		    
		    # Does the jump condition originate before the block?
		    set src [lindex $q 2]
		    if {![dict exists $assignedAt $src]} {
			set whence $src
			lappend whence -1
			set peephole 1
		    } else {
			set whence [dict get $assignedAt $src]
			if {[lindex $whence 0] in {"temp" "var"}
			    && [lindex $whence 2] == -1} {
			    set peephole 1
			}
		    }
		    break
		}

		default {

		    # Assignment to a variable kills it for this optimization
		    if {[lindex $q 1 0] in {temp var}} {
			set tgt [lindex $q 1]
			set newtgt $tgt
			lappend newtgt $pc
			dict set assignedAt $tgt $newtgt
		    }
		}
	    }
	}

	# If we find a condition that flows in from a predecessor, check
	# all predecessors to find out if the condition is constant.

	if {$peephole} {
	    set whence [lreplace $whence end end]
	    dict for {pb -} [lindex $bbpred $b] {

		set pc -1
		set assignedAt {}
		set pbcontent [lindex $bbcontent $pb]
		foreach q $pbcontent {
		    incr pc
		    switch -exact -- [lindex $q 0 0] {
			"copy" {
			    
			    # Copies of constants still might be constant
			    set src [lindex $q 2]
			    set tgt [lindex $q 1]
			    if {[dict exists $assignedAt $src]} {
				set ultsrc [dict get $assignedAt $src]
			    } else {
				set ultsrc $src
				lappend ultsrc -1
				dict set assignedAt $src $ultsrc
			    }
			    dict set assignedAt $tgt $ultsrc
			}

			default {
			    
			    # Assignment to a variable from anything but a
			    # copy kills it for this optimization
			    if {[lindex $q 1 0] in {temp var}} {
				set tgt [lindex $q 1]
				set newtgt $tgt
				lappend newtgt $pc
				dict set assignedAt $tgt $newtgt
			    }
			}
		    }
		}

		if {[dict exists $assignedAt $whence]} {
		    set ultsrc [dict get $assignedAt $whence]
		    if {[lindex $ultsrc 0] eq "literal"} {
			set value [lindex $ultsrc 1]

			# If testing the constant raises an error, simply
			# leave the tangled code in place.
		        if {![catch {
			    if {$value} {
				set exit $trueBranch
			    } else {
				set exit $falseBranch
			    }
			}]} {

			    # Rewrite the predecessor block to avoid the
			    # confluence.
			    lset bbcontent $pb {}
			    set pbcontent \
				[lreplace $pbcontent[set pbcontent ""] \
				     end end \
				     {*}[lrange $content 0 end-2] \
				     [list jump [list bb $exit]]]
			    my removePred $b $pb
			    my bblink $pb $exit
			    lset bbcontent $pb $pbcontent
			}
		    }
		}
	    }
	}
    }

    my debug-constJumpPeephole {
	puts "after node splitting of conditional branches:"
	my dump-bb
    }
    
    return
}
