# exists.tcl --
#
#	Methods that optimize checks for variable existence in quadcode.
#
# 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.
#
#------------------------------------------------------------------------------

# This file contains several passes over the quadcode to optimize checks
# for variable existence. The bytecode translator emits an existence check
# for every reference to a named variable, and the methods in this file
# are responsible for removing the checks when it can be proven that the
# variable in question always exists or never exists.
#
# The first pass in this file, 'existsPeephole', is a simple peephole
# check for a conditional jump that depends on the result of an 'exists'
# test in the same basic block. 'extractExists' and 'unset' are inserted
# on the 'true' and 'false' paths of the conditional jump, so that
# downstream code will see the already-determined facts of variable existence.
#
# There are two more complex passes in this file, both of which require that
# the program be in SSA form, with the basic blocks ordered in depth
# first numbering, and with ud- and du-chains on the variables.
#
# bbVarsExist - Operates on the basic blocks and sets the 'varExists'
#               variable to a dictionary whose keys are variable names
#	        and whose values are numeric codes. The interpretation
#	        of the codes is:
#		0 - The existence of the variable has not been evaluated
#		    because its uses are unreachable.
#		1 - The variable exists
#		2 - The variable does not exist
#		3 - The variable exists on at least one code path and
#		    does not exist on another code path.
# doExists - Using the information from 'bbVarsExist', this pass simplifies
#	     the code. The following instructions are operated on:
#	     exists - If the variable is known to exist, the instruction
#		      is removed and its result replaced with the literal 1.
#		      If the variable is known not to exist, the instruction
#		      is removed and its result replaced with the literal 1.
#	     extractExists - The instruction is removed if the variable
#		             is known to exist, and its result is replaced
#			     with the literal 1. If the variable is known
#			     not to exist, a placeholder is inserted.
#			     (In this case, if there are no bugs in the
#			     earlier passes, an earlier simplification has
#			     made this code unreachable.
#	     initIfNotExists - The instruction is removed if the variable
#			       is known to exist, and its output is replaced
#			       by the value of the variable being checked.
#	                       If the variable is known not to exist, the
#			       instruction is removed and the output replaced
#			       by the default value.
#
# This optimization may leave conditional jumps that depend on literals,
# unreachable code or unused variables, which will be cleaned up in later
# passes.

oo::define quadcode::transformer {
     
    # existsPeephole --
    #
    #	Simple peephole optimization for code guarded by [info exists],
    #
    # Preconditions:
    #	This method must run after critical edges in the flow graph are split,
    #	but before conversion to SSA form. (It can't run after conversion,
    #	because in SSA form it would have to split variables.)
    #
    # Results:
    #	None.
    #
    # Side effects:
    #	Inserts 'extractExists' and 'unset' on the true and false branches
    #	of 'exists' checks.
    #
    # This pass runs before the conversion of quadcode to SSA form. It
    # inspects basic blocks to find ones ending with a conditional that depends
    # directly on 'exists' within the block. It inserts 'extractExists' and
    # 'unset' on the two exits of the block. This has the effect, once
    # the SSA representation is formed, of allowing all 'exists,'
    # 'initIfNotExists,' and so on to be optimized away in code that depends
    # on the condition.

    method existsPeephole {} {
	my debug-existsPeephole {
	    puts "before 'exists' peephole:"
	    my dump-bb
	}

	# Walk all the basic blocks looking for a 'jumpTrue' or 'jumpFalse'
	# that depends on 'exists'
	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 resultVar [lindex $content end-1 2]
		    set falseBranch [lindex $content end 1 1]
		}
		"jumpFalse" {
		    set falseBranch [lindex $content end-1 1 1]
		    set resultVar [lindex $content end-1 2]
		    set trueBranch [lindex $content end 1 1]
		}
		default {
		    # Single-exit blocks are not suitable for this
		    # transformation
		    continue
		}
	    }

	    # Look to see if "exists" flows into the conditional branch
	    set peephole 0
	    set pc -1
	    foreach q $content {
		incr pc
		if {[lindex $q 0] eq "exists" && [lindex $q 1] eq $resultVar} {

		    # This instruction makes the jump a possible candidate
		    # for [info exists] optimization
		    set peephole 1
		    set testedVar [lindex $q 2]

		} elseif {$peephole} {

		    # Spoil the peephole optimization if either of the
		    # two variables is reassigned on the way to the
		    # conditional jump.
		    set v [lindex $q 1]
		    if {$v eq $resultVar || $v eq $testedVar} {
			set peephole 0
		    }

		}
	    }
	    if {$peephole} {
		set trueBlock [lindex $bbcontent $trueBranch]
		lset bbcontent $trueBranch \
		    [linsert $trueBlock 0 \
			 [list extractExists $testedVar $testedVar]]
		set falseBlock [lindex $bbcontent $falseBranch]
		lset bbcontent $falseBranch \
		    [linsert $falseBlock 0 [list unset $testedVar]]
	    }
	}
	my debug-existsPeephole {
	    puts "after 'exists' peephole:"
	    my dump-bb
	}
    }
     
    # bbVarsExist --
    #
    #	Determines what variables exist in the program, given a basic
    #	block representation in SSA form
    #
    # Results:
    #	None
    #
    # Side effects:
    #	Sets varExists to a dictionary whose keys are variable names and
    #	whose values are 1, 2 if it does not exist, 3 if it is unknown.

    method bbVarsExist {} {
	dict set varExists Nothing 2

	# Process the basic blocks in depth-first numbering so that
	# assignments tend to happen before uses.
	set changed 1
	while {$changed} {
	    set changed 0
	    set b -1
	    foreach content $bbcontent {
		incr b

		# Walk through all the quads and adjust what they assign

		foreach q $content {
		    switch -exact -- [lindex $q 0] {
			"phi" {

			    # A phi inherits "exists" and "does not exist"
			    # flags from all its sources
			    set val 0
			    foreach {from source} [lrange $q 2 end] {
				switch -exact -- [lindex $source 0] {
				    "var" - "temp" {
					if {[dict exists $varExists $source]} {
					    set sourceExists \
						[dict get $varExists $source]
					} else {
					    set sourceExists 0
					}
				    }
				    "literal" {
					set sourceExists 1
				    }
				    "Nothing" {
					set sourceExists 2
				    }
				    "default" {
					error "Why is there $source on a phi?"
				    }
				}
				set val [expr {$val | $sourceExists}]
			    }
			}
			"unset" {

			    # The result of an "unset" does not exist
			    # Note that the SSA transformation should have
			    # removed all 'unset' operations, but it's
			    # still safe to look for them here.
			    set val 2
			}
			default {

			    # The result of anything else does exist
			    set val 1
			}
		    }

		    # Update the destination variable
		    set v [lindex $q 1]
		    if {[lindex $v 0] in {"var" "temp"}
			&& (![dict exists $varExists $v]
			    || $val != [dict get $varExists $v])} {
			set changed 1
			dict set varExists $v $val
		    }
		}
	    }
	}

	return
    }
     
    # doExists --
    #
    #	Improves quadcode by simplifying instructions that depend on
    #	variable existence when the fact of variable existence is known
    #	statically.
    #
    # Preconditions:
    #	Quadcode must be in SSA form and free of critical edges.
    #   ud- and du-chains must exist, and 'bbVarsExist' must have been
    #   run to determine variable existence.
    #
    # Results:
    #	None.
    #
    # Side effects:
    #	Simplifies quadcode.
    #	Updates bbcontent, bbpred, udchain, and duchain to reflect the
    #	modifications.

    method doExists {} {

	my debug-doExists {
	    puts "before doExists:"
	    my dump-bb
	}

	# Walk through all the instructions. It is tempting to do this all
	# with [foreach] loops, but we need to see changes as they are made.

	for {set b 0} {$b < [llength $bbcontent]} {incr b} {
	    set j 0
	    for {set i 0} {$i < [llength [lindex $bbcontent $b]]} {incr i} {
		set q [lindex $bbcontent $b $i]

		# Identify the destination and source operands, and
		# determine whether the source exists.

		set dest [lindex $q 1]
		set source [lindex $q 2]
		switch -exact -- [lindex $source 0] {
		    "var" - "temp" {
			set ex [dict get $varExists $source]
		    }
		    "literal" {
			set ex 1; # Literals always exist
		    }
		    "Nothing" {
			set ex 2; # Nothing never exists
		    }
		    default {
			set ex 0; # Everything else is unexamined
		    }
		}
		# Other instructions that manage non-existent variables:
		# unset - Removed by the SSA processing before we get here
		switch -exact [lindex $q 0] {
		    "exists" {

			# [info exists] turns into literal 1 if the
			# variable always exists, or literal 0 if it never
			# exists.

			if {$ex == 1} {
			    my removeUse $source $b
			    my replaceUses $dest {literal 1}
			    # delete the quad
			} elseif {$ex == 2} {
			    my removeUse $source $b
			    my replaceUses $dest {literal 0}
			    # delete the quad
			} else {
			    lset bbcontent $b $j $q
			    incr j
			}
		    }
		    "extractExists" {

			# 'extractExists' can be removed if the variable
			# always exists, and is misplaced if it never exists

			if {$ex == 1} {
			    my removeUse $source $b
			    my replaceUses $dest $source
			    # delete the quad
			} else {
			    lset bbcontent $b $j $q
			    incr j
			}
		    }
		    "initIfNotExists" {

			# 'initIfNotExists' has a value equal to the
			# variable if the variable always exists, or
			# to the default if it never exists

			if {$ex == 1} {
			    my removeUse $source $b
			    my removeUse [lindex $q 3] $b
			    my replaceUses $dest $source
			    # delete the quad
			} elseif {$ex == 2} {
			    my removeUse $source $b
			    my removeUse [lindex $q 3] $b
			    my replaceUses $dest [lindex $q 3]
			    # delete the quad
			} else {
			    lset bbcontent $b $j $q
			    incr j
			}
		    }
		    default {

			# Other instructions are not changed by
			# [info exists] information

			lset bbcontent $b $j $q
			incr j
		    }
		}
	    }

	    if {$j < $i} {
		set content [lindex $bbcontent $b]
		lset bbcontent $b {}
		lset bbcontent $b [lreplace $content[set content {}] $j end]
	    }
	}

	my debug-doExists {
	    puts "After removing redundant existence checks:"
	    my dump-bb
	}

	return
    }
}

source [file join $quadcode::libdir pre.tcl]
source [file join $quadcode::libdir ssa.tcl]
source [file join $quadcode::libdir translate.tcl]
source [file join $quadcode::libdir typecheck.tcl]
source [file join $quadcode::libdir upvar.tcl]
source [file join $quadcode::libdir varargs.tcl]
source [file join $quadcode::libdir widen.tcl]

#source [file join $quadcode::libdir exists.tcl]
#source [file join $quadcode::libdir interval.tcl]

source [file join $quadcode::libdir pre.tcl]
source [file join $quadcode::libdir ssa.tcl]
source [file join $quadcode::libdir translate.tcl]
source [file join $quadcode::libdir typecheck.tcl]
source [file join $quadcode::libdir upvar.tcl]
source [file join $quadcode::libdir varargs.tcl]
source [file join $quadcode::libdir widen.tcl]