# Copyright (c) 2014-2017 by Kevin B. Kenny
# Copyright (c) 2014-2017 by Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

interp recursionlimit {} 4000


#############################################################################
#
# Test code definitions. These are all procedures; that's all we can currently
# compile.

proc cos {x {n 16}} {

    for {set i 0} {$i < 100} {incr i} {
	incr x $adder
	incr y $adder
	incr y $adder
    }
    list $x $y
}

namespace eval ::inlinetwice {

    proc carry limb { 
        list [expr {$limb & 0x0FFFFFFF}] [expr {$limb >> 28}] 
    }

    proc test {a b} {
	set a [expr {int($a)}]
	set b [expr {int($b)}]
	lassign [carry $a] a0 a1
	lassign [carry $b] b0 b1
	list $a1 [expr {$a0 + $b1}] $b0

    }
}

namespace eval ::regexptest {

    proc matchvar-1 {needle haystack} {
	regexp -indices -- $needle $haystack where
	return $where
    }

    upvartest0::check2
    upvartest1::check1
    upvartest1::check2
    upvartest2::test1
    upvartest2::test2
    upvartest2::test3
    upvartest2::test4

    {wideimpure 3.0}

    {hash::H9fast ultraantidisestablishmentarianistically}
    {hash::H9mid ultraantidisestablishmentarianistically}
    {hash::H9slow ultraantidisestablishmentarianistically}

    {toHex [poly1305 compute $key $msg]}
    {poly1305 verify $key $msg $tag}

    {wideimpure 3.0}

    {cse-caller}
    {licm1 100}
    {licm2 100}
    {redundant-purify 2}
    {inlinetwice::test 0x10000003 0x50000007}

    {hash::H9fast ultraantidisestablishmentarianistically}
    {hash::H9mid ultraantidisestablishmentarianistically}
    {hash::H9slow ultraantidisestablishmentarianistically}

    {toHex [poly1305 compute $key $msg]}
    {poly1305 verify $key $msg $tag}

    upvar0a
    upvartest0::*
    upvartest1::*
    upvartest2::*
    flightawarebench::*
    hash::*
    redundant-purify
    inlinetwice::*
    licm1 licm2
    cse cse-caller
    wideimpure
    poly1305::*
    poly1305::tcl::mathfunc::*
}
set toCompile'slow' {

                                      $replacement and remove the instruction"
			    }
			    my removeUse $source $b
			    dict unset udchain $result
			    my replaceUses $result $replacement
			    set changed 1
			    continue; # delete the quad
			}
			lset newbb [incr newpc] $q; # don't delete the quad
		    }

		    "extractScalar" {
			my debug-constfold {
			    puts "$b:$pc: examine $q"
			}

			set source [lindex $argl 0]
			set have [typeOfLiteral $source]

			# Can I say sommething definitive?
			unset -nocomplain replacement
			if {[quadcode::dataType::isa $have $want]} {
			    set replacement {literal 1}
			} else {
			    set replacement {literal 0}
			}

			my debug-constfold {
			    puts "$b:$pc: can replace $result with\
                            	  $replacement and remove the instruction"	
			}
			lset bbcontent $b $pc [list nop {}]
			my removeUse $source $b
			dict unset udchain $result
			my replaceUses $result $replacement
			set changed 1
			continue; # delete the quad
		    }
		    

		    "le" {
			lassign $argl x y
			set res [list literal [expr {$x <= $y}]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}

			set changed 1
			continue; # delete the quad
		    }

		    "listRange" {
			set res [list literal [lrange {*}$argl]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }

		    "lshift" {
			lassign $argl x y
			set res [list literal [expr {$x << $y}]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad

			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }			

		    "rshift" {
			lassign $argl x y
			set res [list literal [expr {$x >> $y}]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }

		    "strcat" {
			set res [list literal [join $argl ""]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}

    namespace upvar ::quadcode::dataType FAIL FAIL

    my debug-inline {
	puts "Before attempting to expand inlines:"
	my dump-bb
    }
    my debug-audit {
	my audit-duchain "entry to expandInlines"
	my audit-phis "entry to expandInlines"
    }

    set didSomething 0

    # Walk through all quadcodes, looking for 'invoke' of a literal.
    # 'bs' is a queue of basic block numbers to analyze. If a block
    # has potential calls following an inlined procedure, it will be
    # split, and the index of the new block that must be analyzed will

	    }

	    # Ready to inline, let's go!

	    my diagnostic note $b $pc "Inlining %s into %s" \
		[$toInline full-name] [my full-name]
	    my expandOneInline $b $bb $pc $q $toInline
	    my debug-audit {
		my audit-duchain "after expandOneInline [$toInline full-name]"
		my audit-phis "after expandOneInline"
	    }
	    set didSomething 1

	    # FIXME:
	    # We've just moved the rest of the code out of the basic block, but
	    # there might be another call in the same bb that this will miss.
	    # For that reason, this procedure needs refactoring to be able
	    # to continue with the rewritten continuation of the block.

	    break
	}
    }
    
    my debug-audit {
	my audit-duchain "exit from expandInlines"
	my audit-phis "exit from expandInlines"
    }

    return $didSomething
    
}

# quadcode::transformer method expandOneInline --
#
#	Expands an inline procedure invocation.

    lappend bbpred {*}[lrepeat [llength $xbbcontent] {}]
    my debug-inline {
	puts "inline: [llength $xbbcontent] blocks added with inlined code"
    }
    
    # Unlink variables used in the 'invoke'

    foreach v [lrange $q 2 end] {
	if {[lindex $v 0] in {"var" "temp"}} {
	    my removeUse $v $b
	}
    }
    my debug-inline {
	puts "inline: variables in 'invoke' unlinked from du-chains"
    }

	    if {[my ns_splittable $splitb]} {
		# Split a single basic block
		my ns_cloneBB $splitb
		my debug-nodesplit {
		    puts "After splitting:"
		    my dump-bb
		}
		my debug-audit {
		    my audit-duchain "nodesplit"
		    my audit-phis "nodesplit"
		}
		return 1
	    }
	}
    }

    # Found nothing to split

	my dump-bb
    }

    # 0. Initialize the global variable numbering tables.

    my pre_init









    # 1. Perform a top-down traversal of the basic blocks (which has the
    #    effect that any block's dominators will have been processed before
    #    the block itself). Compute the global value numbering that maps
    #	 expressions to their values. Compute the expression generation
    #	 sets (EXP_GEN, PHI_GEN, TMP_GEN) and analyze available expressions
    #	 (AVAIL_OUT).

    variable ::quadcode::gvn_eliminable

    # Walk through basic blocks in the forward direction
    set b -1
    foreach bb $bbcontent {
	incr b

	my debug-pre-detail {
	    puts "bb $b:"
	}

	# Clear the 'gen' sets and inherit the 'avail_out' set from
	# the basic block's immediate dominator (which must have been
	# visited already!)
	set exp_gen_b {}

	    set op [lindex $opcode 0]

	    # Ignore instructions that don't produce values
	    if {[lindex $result 0] ni {"temp" "var"}} {
		continue
	    }

	    my debug-pre-detail {
		puts "  $pc: $q"
	    }

	    # Break down remaining  instructions into four types: phis,
	    # copies, instructions that might be processed by PRE, and
	    # others.
	    if {$op eq "phi"} {

	    if {![dict exists $avail_out_b $v]} {
		dict set avail_out_b $v $result
	    }
		
	}

	my debug-pre-detail {
	    puts "generated:"
	    dict for {v expr} $exp_gen_b {
		puts "    value $v: $expr"
	    }
	    puts "phis:"
	    dict for {v srcs} $phi_gen_b {
		puts "    $v <- $srcs"

	# A block with a single predecessor has a trivial AVAIL_IN set
	dict for {p -} $preds break
	return [lindex $pre_avail_out $p]

    }

    my debug-pre-detail {
	puts "  Compute available exprs at merge point $b"
    }

    # A merge point may need to have phi's inserted. Start with the values
    # that are available from the dominator.

    set avail_in [lindex $pre_avail_out [lindex $bbidom $b]]
    my debug-pre-detail {
	puts "Available from dominator [lindex $bbidom $b]:\
              [dict keys $avail_in]"
    }
    
    # Merge in any values that arrive from all predecessors but
    # do not originate in the dominator
    set firsttime 1
    set newphis {}
    dict for {p -} $preds {
	set avout_p [lindex $pre_avail_out $p]
	my debug-pre-detail {
	    puts "    Available from $p: [dict keys $avout_p]"
	}
	if {$firsttime} {
	    dict for {v e} $avout_p {
		if {![dict exists $avail_in $v]} {
		    dict set newphis $v [list bb $p] $e
		}

	    lappend newbb $insn
	    my pre_gvn_add [list {} $var] $v
	    dict set avail_in $v $var
	}
	set bb [linsert $bb[set bb ""] 0 {*}$newbb]
    }
	
    my debug-pre-detail {
	puts "  Available on entry to $b: [dict keys $avail_in]"
    }
    return $avail_in
    
}



    # Calculate the retrograde order in which blocks are to be visited
    set bs [my bbrorder]

    # Iterate to convergence
    set changed 1
    while {$changed} {

	my debug-pre-detail {
	    puts "Do one pass of anticipability analysis"
	} 

	set changed 0

	# Visit blocks in retrograde sequence
	foreach b $bs {

	    my debug-pre-detail {
		puts "  bb $b:"
	    }
	    
	    set old [lindex $pre_antic_in $b]

	    # Calculate ANTIC_OUT by processing the block's successors
	    set succs [my bbsucc $b]
	    if {[llength $succs] == 0} {
	
		my debug-pre-detail {
		    puts "    is an exit block"
		}
		# Exit block
		set antic_out {}
	    } elseif {[llength $succs] == 1} {

		# Single-successor block. The values anticipable
		# on entry to the successor must be translated through
		# phi's to the ones anticipated on exit from
		# this block. Note that there is a typo in [VanD04]
		# Figure 4.5 at this step: ANTIC_IN[b] should be
		# ANTIC_IN[succ(b)].
		set f [lindex $succs 0]

		my debug-pre-detail {
		    puts "    has a single follower, $f"
		}
		set antic_in_f [lindex $pre_antic_in $f]
		my debug-pre-detail {
		    puts "      which has anticipable values:"
		    dict for {vvv eee} $antic_in_f {
			puts "        value $vvv = $eee"
		    }
		}
		my debug-pre-detail {
		    puts "      giving anticipable values on output of $b:"
		}
		set antic_out {}
		dict for {olde pair} [my pre_phi_translate $antic_in_f $b $f] {
		    lassign $pair newv newe
		    dict set antic_out $newv $newe
		    my debug-pre-detail {
			puts "        value $newv: $newe"
		    }
		}
		
	    } else {

		my debug-pre-detail {
		    puts "      has multiple successors: $succs"
		}		    

		# This block has fanout. Calculate the intersection of
		# ANTIC_IN from all successors
		lassign $succs first rest
		set antic_out [lindex $pre_antic_in $first]
		foreach bprime $rest {
		    set antic_in_bprime [lindex $pre_antic_in $bprime]
		    dict for {v e} $antic_out {
			if {![dict exists $antic_in_bprime $v]} {
			    dict unset antic_out $v
			}
		    }
		}

		my debug-pre-detail {
		    puts "      intersection of successors' anticipable exprs:"
		    dict for {vvv eee} $antic_out {
			puts "        value $vvv = $eee"
		    }
		}
	    }

	    set exp_gen_b [lindex $pre_exp_gen $b]
	    set tmp_gen_b [lindex $pre_tmp_gen $b]

	    # Remove anything from ANTIC_OUT that is a temporary
	    # computed in the block.
	    foreach x $tmp_gen_b {
		set e [list {} $x]
		set v [my pre_gvn_lookup $e]
		if {[dict exists $antic_out $v]} {
		    my debug-pre-detail {
			puts "    remove value $v = $e because\
                                  it is computed here"
		    }
		    dict unset antic_out $v
		}
	    }

	    # Start with ANTIC_IN of this block being
	    # EXP_GEN - TMP_GEN - PHI_GEN
	    set antic_in_b $exp_gen_b
	    foreach x $tmp_gen_b {
		set e [list {} $x]
		set v [my pre_gvn_lookup $e]
		if {[dict exists $antic_in_b $v]
		    && [dict get $antic_in_b $v] eq [list {} $x]} {
		    my debug-pre-detail {
			puts "    remove value $v = $e because\
			          it is computed here"
		    }
		    dict unset antic_in_b $v
		}
	    }
	    my debug-pre-detail {
		puts "    locally anticipable in block $b:"
		dict for {vvv eee} $antic_in_b {
		    puts "        value $vvv = $eee"
		}
	    }

	    # Add the antileaders from ANTIC_OUT to ANTIC_IN
	    my debug-pre-detail {
		puts "    anticipable in block $b from downstream:"
	    }
	    dict for {v e} $antic_out {
		if {(![dict exists $tmp_gen_b $v]
		     || [dict get $tmp_gen_b $v] ne $e)
		    && ![dict exists $antic_in_b $v]} {
		    my debug-pre-detail {
			puts "      value $v = $e is anticipable"
		    }
		    dict set antic_in_b $v $e
		} else {
		    my debug-pre-detail {
			puts "      value $v = $e is killed here"
		    }
		}
	    }

	    # Clean any expressions from ANTIC_IN that depend on
	    # killed values
	    set antic_in_b [my pre_clean $antic_in_b]

	    # Test if anything has changed
	    if {$old ne $antic_in_b} {
		my debug-pre-detail {
		    puts "  anticipable set has changed, need another pass."
		}
		lset pre_antic_in $b $antic_in_b
		set changed 1
	    }
	}
    }

	set changed 0

	# Iterate through the basic blocks
	set b -1
	foreach antin $pre_antic_in preds $bbpred dom $bbidom {
	    incr b

	    my debug-pre-detail {
		puts "  bb $b:"
	    }

	    # Inherit the set of created phi's from the block's
	    # dominator, and make them available on the block's output
	    if {[llength $new_sets] == $b} {
		if {$b > 0} {

	    lset pre_avail_out $b $avail_out_b

	    # If the block has more than one predecessor, it's a potential
	    # place for a phi to be inserted

	    if {[dict size $preds] > 1} {

		my debug-pre-detail {
		    puts "    bb $b is a merge point"
		}

		# What expressions are available from the block's dominator?
		set avail_out_d [lindex $pre_avail_out $dom]

		# Find the translations for the anticipable values
		set translated_p {}
		dict for {p -} $preds {
		    dict set translated_p $p [my pre_phi_translate $antin $p $b]
		}

		# Potential phis correspond to all anticipable
		# expressions in the block. (We will downselect to
		# those that are partially available - that is,
		# complex expressions that are available in at least
		# one predecessor but not in all.)
		dict for {v e} $antin {

		    my debug-pre-detail {
			puts "    examine anticipated value $v: $e"
		    }
		    lassign $e opcode argl

		    # A simple variable must be fully available
		    if {$opcode == {}} {
			my debug-pre-detail {
			    puts "      it's a simple value, can't need a phi"
			}
			continue
		    }

		    # A value that is available from the dominator is
		    # fully available
		    if {[dict exists $avail_out_d $v]} {
			my debug-pre-detail {
			    puts "      it's available in the dominator already\
                                        as [dict get $avail_out_b $v]"
			}
			continue
		    }

		    # A value that we made a phi for already is fully available
		   
		    if {[dict exists [lindex $new_sets $b] $v]} {
			my debug-pre-detail {
			    puts "      it's already been processed as\
                                        [dict get [lindex $new_sets $b] $v]"
			}
			continue
		    }

		    # Go through the predecessors and find the leaders

		    set all_same 1
		    unset -nocomplain first_s
		    dict for {p trans} $translated_p {
			lassign [dict get $trans $v] v1 e1
			set avail_out_p [lindex $pre_avail_out $p]
			if {![dict exists $avail_out_p $v1]} {

			    my debug-pre-detail {
				puts "      it's unavailable in predecessor $p"
			    }
			    # The value is unavailable in the predecessor
			    dict set avail $p [list $v1 $e1]

			    set all_same 0
			} else {

			    # The value is available as e2 in the predecessor
			    set var2 [dict get $avail_out_p $v1]
			    set e2 [list {} $var2]
			    my debug-pre-detail {
				puts "      it's available as $var2 in\
                                            predecessor $p"
			    }
			    set e2 [list {} $var2]
			    dict set avail $p [list $v1 $e2]
			    set by_some 1
			    if {![info exists first_s]} {
				set first_s $e2
			    } elseif {$first_s ne $e2} {
				set all_same 0
			    }
			}
		    }

		    # If the value is fully available or not available,
		    # there's nothing to do
		    if {$all_same} {
			my debug-pre-detail {
			    puts "    it's fully available in block $b"
			}
			continue
		    }
		    if {!$by_some} {
			my debug-pre-detail {
			    puts "    it's unavailable in block $b"
			}
			continue
		    }

		    my debug-pre-detail {
			puts "    it's partially available in block $b"
		    }

		    # Rewrite the code to make the value available
		    dict for {p pair} $avail {

			# Examine a predecessor block to see if the value is
			# available
			lassign $pair v1 e1
			set argl [lassign $e1 opcode]
			if {[lindex $e1 0] eq {}} {
			    # The value is available, we're done
			    continue
			}

			# Create a temp to hold the value in the predecessor
			set t [my pre_make_temp_for_expr $v $e]
			my debug-pre-detail {
			    puts "    Created $t to hold $e1 in $p"
			}
			dict set udchain $t $p

			# Create an instruction to evaluate the value in
			# the predecessor
			set avail_out_p [lindex $pre_avail_out $p]

    set changed 0

    # Walk through the basic blocks and their AVAIL sets
    set b -1
    foreach bb $bbcontent avail_out_b $pre_avail_out {
	incr b
	my debug-pre-detail {
	    puts "bb $b:"
	}
	set newbb {}

	# Walk through the instructions in the block
	set pc -1
	foreach q $bb {
	    incr pc
	    my debug-pre-detail {
		puts "  $pc: $q"
	    }
	    set argl [lassign $q opcode result]
	    set op [lindex $opcode 0]

	    # Might this instruction have been eliminated?
	    if {[dict exists $gvn_eliminable $op]} {

		    # Replace this instruction with a copy
		    foreach a $argl {
			if {[lindex $a 0] in {"temp" "var"}} {
			    my removeUse $a $b
			}
		    }
		    my addUse $x $b
		    my debug-pre {
			puts "   replace $b:$pc: $q"
		    }
		    set q [list copy $result $x]
		    set changed 1
		    my debug-pre {
			puts "   with    $b:$pc: $q"
		    }
		}
	    }
	    
	    lappend newbb $q
	}
	lset bbcontent $b $newbb

# Results:
#	Returns the result of the translation

oo::define quadcode::transformer method pre_phi_translate1 {es v e p s} {

    my variable pre_phi_gen
    
    my debug-pre-detail {
	puts "        Translate value $v: $e on edge $p -> $s"
    }

    set phis [lindex $pre_phi_gen $s]
    ;			       # Phi operations at the successor block
    set pkey [list bb $p];     # Key for looking up predecessor value at a phi

    # Handle temporaries by mapping them through any phis
    if {[lindex $e 0] eq {}} {
	set t [lindex $e 1]

	if {[dict exists $phis $t $pkey]} {

	    # temporary participates in a phi
	    set tprime [dict get $phis $t $pkey]
	    set eprime [list {} $tprime]
	    set vprime [my pre_gvn_lookup $eprime]
	    my debug-pre-detail {
		puts "          value $v: $t in $s maps to\
                                value $vprime: $tprime in $p"
	    }
	    return [list $vprime $eprime]
	} else {
	    my debug-pre-detail {
		puts "          value $v: $t does not appear in a phi in $s,\
                                so it maps to itself in $p"
	    }
	    return [list $v $e]
	}
    }
    

	    }
	}
    }

    set vout [my pre_gvn_lookup_or_add $eout]
    set result [list $vout $eout]

    my debug-pre-detail {
	puts "          value $v: $e in $s maps to value $vout: $eout in $p"
    }
    
    return $result
}

# quadcode::transformer method pre_clean --
#
#	Filters out killed dependent expressions from a set of anticipable
#	expressions
#
# Parameters:
#	es - Dictionary whose keys are value numbers and whose values
#	     are anticipable expressions, in dependency order
#
# Results:
#	Returns the dictionary with killed expressions pruned

oo::define quadcode::transformer method pre_clean {es} {

    my debug-pre-detail {
	puts "    clean anticipated set"
    }
    dict for {v e} $es {
	set argl [lassign $e opcode]
	if {$opcode eq {}} continue; # temps have already been handled
	foreach a $argl {
	    if {[lindex $a 0] eq "value"} {
		set v2 [lindex $a 1]
		if {![dict exists $es $v2]} {
		    dict unset es $v
		    my debug-pre-detail {
			puts "      remove $v = $e because value $v2 ($a)\
                                    is not anticipated"
		    }
		    break
		}
	    }
	}

		    if {[my mayInline $q]} {
			set mightInline 1
			break
		    }
		}
		if {$mightInline} {
		    set inf [dict get $typeInf $inst]
		    my debug-specializer {
			puts "INLINES [$inf full-name]"
		    }
		    if {[catch {$inf expandInlines} result]} {
			lassign $inst procName argTypes
			my diagnostic $procName $argTypes \
			    "" 0 $procName \
			    fatal $result $procName $::errorInfo
		    } elseif {$result} {
			my AddToWorklist 0 {*}$inst

    set inf [dict get $typeInf $instance]

    my debug-specializer {
	set argTypeNames [lmap x $argTypes {nameOfType $x}]
	puts "DONESPLIT $procName ($argTypeNames):"
    }




    $inf doneWithNodeSplitting



}

# quadcode::specializer method AddToWorklist --
#
#	Puts a procedure instance on the worklist of procedures to specialize.
#

	    }
	    my debug-tidy {
		lappend debugLine $result
	    }
	}
	my debug-tidy {
	    puts "$debugLine -- $changed"
	}
	my debug-timings {
	    foreach {pass usec} $timings {
		puts "$pass: $usec microseconds"
	    }
	}
	if {$changed} {
	    set somethingChanged 1
	}
    }

    # If any of these changes actually changed anything, it may
    # have narrowed types, so we need to return for more interprocedural
    # type analysis
	
    my debug-tidy {
	puts "tidy: did something change? $somethingChanged"
    }
    return $somethingChanged

}

# quadcode::transformer method doneWithNodeSplitting --
#
#	Removes all of the bits and pieces that are used to track
#	node splitting.
#
# Results:
#	None.
#
# Side effects:
#	Removes the markers for which nodes have been split. Removes
#	any remaining 'callFrameNop' instructions. Cleans up useless phis,
#	and eliminates the use of the callframe entirely if possible.
#
# TODO: It is very likely that removeCallFrameNop and eliminateCallFrame
#       can appear much earlier in optimization than this. It might be
#       profitable to investigate this.

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

    foreach pass {
	removeSplitMarkers
	removeCallFrameNop
	uselessphis
	eliminateCallFrame
    } {
	set cmd [string map [list @pass $pass] {
	    set result [my @pass]
	}]
	lappend timings $pass [lindex [time $cmd] 0]
	my debug-audit {
	    my audit-duchain $pass
	    my audit-phis $pass
	}
    }
    my debug-audit {
	my audit-duchain "exit from donesplit"
	my audit-phis "exit from donesplit"
    }
    my debug-timings {
	foreach {pass usec} $timings {
	    puts "$pass: $usec microseconds"
	}
    }
    return
}

# quadcode::transformer method sourceFile --
#
#	Returns the source file that this module was compiled from
#
# Results:
#	Returns the file name.

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

    my debug-inferTypes {
	puts "Before type inference:"
	my dump-bb
    }
    my debug-audit {
	my audit-duchain "entry to inferTypes"
	my audit-phis "entry to inferTypes"
    }

    namespace upvar ::quadcode::dataType BOTTOM BOTTOM FAIL FAIL STRING STRING

    # Initialize all types to BOTTOM
    set types {}
    dict for {v -} $udchain {
	dict set types $v $BOTTOM

    } elseif {[string is entier -strict $x]} {
	set y [expr {entier($x)}]
	if {$y eq $x} {
	    set impure 0
	} else {
	    set impure $dataType::IMPURE
	}
	if {$x >= -0x8000000000000000 && $x <= 0x7fffffffffffffff} {
	    if {$x == 0} {
		return [dataType::typeUnion $dataType::CONST0 $impure]
	    } elseif {$x == 1} {
		return [dataType::typeUnion $dataType::CONST1 $impure]
	    } else {
		return [dataType::typeUnion $dataType::INT $impure]
	    }
	} else {
	    return [dataType::typeUnion $dataType::BIGINT $impure]
	}
    } elseif {[string is double -strict $x]} {
	set y [expr {double($x)}]
	if {$y eq $x} {
	    return $dataType::DOUBLE
	} else {
	    return [dataType::typeUnion $dataType::DOUBLE $dataType::IMPURE]

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

    my debug-upvar {
        puts "Before \[upvar\] analysis:"
        my dump-bb
    }
    my debug-audit {
	my audit-duchain "entry to analyzeUpvar"
	my audit-phis "entry to analyzeUpvar"
    }

    my bbidom
    my bblevel

    # 1. Walk from the entry block, and analyze what variables contain
    #    the values of passed parameters.

    set argPos [my upvarAnalyzeArgs]

    # 2. Walk from the entry block, recording the state of [upvar]
    #    at each instruction that might change it.

    set upvarState [my upvarFindAliases $argPos]

    # 3. Walk 'moveToCallFrame', 'moveFromCallFrame' and 'invoke' to
    #    determine the procedure's effect on variables.

    set procEffect [my upvarProcEffect $upvarState]

    my debug-audit {
	my audit-duchain "exit from analyzeUpvar"
	my audit-phis "exit from analyzeUpvar"
    }

    return $procEffect
}

# quadcode::transformer method upvarAnalyzeArgs --
#
#       Determines what named variables in SSA-based quadcode are known to