proc polartest {u v} {
    set th [expr {atan2($v,$u)}]
    set r [expr {hypot($v,$u)}]
    set u2 [expr {$r * cos($th)}]
    set v2 [expr {$r * sin($th)}]
    return [expr {hypot($v2-$v, $u2-$u)}]
}

proc lmapconsttest {} {
    lmap y {10 20 30} {
	lmap x {1 2 3} {expr {$x + $y}}
    }
}

# This is a cut-down version of the version in Tcllib's math package
namespace eval math {}
proc ::math::ln_Gamma { x } {

    # Handle the common case of a real argument that's within the
    # permissible range.

    {fib 85}
    {fib-r 15}
    {cos 1.2}
    # Fails on a roundoff error: {tantest 1.2}
    {inttest 345}
    {math::ln_Gamma 1.3}
    {polartest 0.6 0.8}
    {lmapconsttest}
    {powmul1 13 3}
    {powmul2 13 3}
    {zerodiv}
    {uplustest 123 456}
    {uplustest 01 010}
    {cleanopt {uplustest abc def}}
    # String operations

    # heavily, the others are less critical
    fib fib-r
    ::cos
    tantest
    inttest
    math::ln_Gamma
    polartest
    lmapconsttest
    shift
    powmul1 powmul2
    zerodiv
    uplustest
    # String operations
    strtest
    passthrough

    # Walk through basic blocks in forward sequence.

    for {set b 0} {$b < [llength $bbcontent]} {incr b} {
	set newbb {}
	set newpc -1
	for {set pc 0} {$pc < [llength [lindex $bbcontent $b]]} {incr pc} {
	    set q [lindex $bbcontent $b $pc]
	    lset bbcontent $b $pc [list nop {}]
	    set mightfold 1
	    set argl {}
	    foreach arg [lrange $q 2 end] {
		if {[lindex $arg 0] ne "literal"} {
		    set mightfold 0
		    break
		}
		lappend argl [lindex $arg 1]
	    }
	    set result [lindex $q 1]
	    if {$mightfold} {

		switch -exact -- [lindex $q 0 0] {

		    "@debug-file" - "@debug-context" -
		    "@debug-line" - "@debug-script" -
		    "dictIterStart" - "directAppend" - "directArrayAppend" -

		    }

		    "add" {
			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
		    }

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

			if {[quadcode::dataType::isa $have $want]} {
			    set replacement {literal 1}
			} elseif {![quadcode::dataType::mightbea $have $want]} {
			    set replacement {literal 0}
			}
			if {[info exists replacement]} {
			    my debug-constfold {
				puts "$b:$pc: can replace $result with\
                                      $replacement and remove the instruction"
			    }

			    my removeUse $source $b

			    dict unset udchain $result
			    my replaceUses $result $replacement
			    set changed 1
			    continue; # delete the quad
			}			
		    }

		    "bitand" {
			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
		    }

		    "bitnot" {
			lassign $argl x
			set res [list literal [expr {~$x}]]
			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
		    }

		    "bitor" {
			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
		    }

		    "bitxor" {
			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
		    }

		    "copy" {
			lassign $argl res
			set res [list literal $res]
			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
		    }

		    "dictExists" {
			set argl [lassign $argl d]
			if {[llength $argl] == 0} {
			    set res 0
			} else {
			    set res [dict exists $d {*}[lreverse $argl]]
			}
			set res [list literal $res]
			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
		    }

		    "dictGet" - "dictGetOrNexist" {
			set argl [lassign $argl d]
			set res [dict get $d {*}[lreverse $argl]]
			set res [list literal $res]
			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
		    }

		    "dictIncr" {
			set argl [lassign $argl res]
			dict incr res {*}$argl
			set res [list literal $res]
			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
		    }


		    "dictSet" - "dictSetOrUnset" {
			set argl [lassign $argl d]
			dict set d {*}[lreverse $argl]
			set res [list literal $d]
			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
		    }

		    "div" {
			lassign $argl x y
			if {[catch {expr {$x / $y}} res]} {
			    my diagnostic warning $b $pc \
				"expression will divide by zero at run time"
			    lset bbcontent $b [incr newpc] $q
			} else {
			    set res [list literal $res]
			    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
			}
		    }

		    "eq" {
			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
		    }

		    "exists" {
			lassign $argl x
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with {literal 1}"
			}
			dict unset udchain $result
			my replaceUses $result {literal 1}
			set changed 1
			continue; # delete the quad
		    }

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

			if {[quadcode::dataType::isa $have $want]} {
			    set replacement [list literal $source]
			} elseif {![quadcode::dataType::mightbea $have $want]} {
			    # This is dead code, but we don't know it yet
			}
			if {[info exists replacement]} {
			    my debug-constfold {
				puts "$b:$pc: can replace $result with\
                                      $replacement and remove the instruction"
			    }

			    my removeUse $source $b

			    dict unset udchain $result
			    my replaceUses $result $replacement
			    set changed 1
			    continue; # delete the quad
			}			
		    }

		    "extractScalar" {
			my debug-constfold {

			if {[quadcode::dataType::isa $have $want]} {
			    # This is dead code, but we don't know it yet
			} elseif {![quadcode::dataType::mightbea $have $want]} {
			    set replacement [list literal $source]
			}
			if {[info exists replacement]} {
			    my debug-constfold {
				puts "$b:$pc: can replace $result with\
                                      $replacement and remove the instruction"
			    }

			    my removeUse $source $b

			    dict unset udchain $result
			    my replaceUses $result $replacement
			    set changed 1
			    continue; # delete the quad
			}			
		    }

		    "ge" {
			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
		    }

		    "gt" {
			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
		    }

		    "initIfNotExists" {
			set res [list literal [lindex $argl 0]]
			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
		    }

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

			if {[quadcode::dataType::isa $have $want]} {
			    set replacement {literal 1}
			} elseif {![quadcode::dataType::mightbea $have $want]} {
			    set replacement {literal 0}
			}
			if {[info exists replacement]} {
			    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"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }

		    "list" {
			set res [list literal [list {*}$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
		    }

		    "listAppend" {
			set res [lindex $argl 0]
			lappend res {*}[lrange $argl 1 end]
			set res [list literal $res]
			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
		    }

		    "listConcat" {
			set res [list literal [concat {*}$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
		    }

		    "listIndex" {
			set res [list literal [lindex {*}$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
		    }

		    "listLength" {
			set res [list literal [llength {*}$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
		    }

		    "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
		    }

		    "lt" {
			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
		    }

		    "mod" {
			lassign $argl x y
			if {[catch {expr {$x % $y}} res]} {
			    my diagnostic warning $b $pc \
				"expression will divide by zero at run time"
			    lset bbcontent $b [incr newpc] $q
			} else {
			    set res [list literal $res]
			    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
			}
		    }

		    "mult" {
			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
		    }

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

			if {[quadcode::dataType::isa $have $want]} {
			    set replacement [lindex $q 0]
			} elseif {![quadcode::dataType::mightbea $have $want]} {
			    # this is dead code, but we don't know it yet
			}
			if {[info exists replacement]} {
			    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
			}			
		    }

		    "ne" {
			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
		    }

		    "not" {
			lassign $argl x
			set res [list literal [expr {!$x}]]
			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"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }

		    "strrange" {
			set res [list literal [string range {*}$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
		    }

		    "sub" {
			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
		    }

		    "uminus" {
			set res [list literal [expr {- [lindex $argl 0]}]]
			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
		    }

		    "unset" {
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with Nothing"
			}
			dict unset udchain $result
			my replaceUses $result Nothing
			set changed 1
			continue; # delete the quad
		    }

		    default {
			my debug-constfold {
			    puts "$b:$pc: $q"
			}
			my diagnostic debug $b $pc \

		    set debugScript {}
		}
		break
	    }

	}
    }

    return [list $sourcefile $debugLines $debugScript $debugContext]
}

# quadcode::transformer method propDebugInfo --
#
#	Propagates debug information across the quadcode so that
#	it is available locally in each basic block rather than

	    bitand bitnot bitor bitxor
	    concat
	    dictAppend dictExists dictGet dictGetOrNexist
	    dictLappend dictSet dictSetOrUnset dictSize dictUnset
	    div
	    eq expand exists expon extractArray extractCallFrame extractExists
	    extractFail extractMaybe extractScalar

	    frameArgs frameDepth
	    ge gt
	    initArray initArrayIfNotExists initIfNotExists
	    instanceOf isBoolean
	    le
	    listAppend listConcat listIn listIndex listLength listRange
	    listSet

	my audit-duchain pre-3
	my audit-phis pre-3
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }
    set did_something [my pre_insert]
    if {$did_something} {
	puts "pre_insert did something!"
    }

    # 4. Rewrite the program to replace calculations of available values
    #    with copies from the temps that hold the values

    if {[catch {
	my audit-duchain pre-4
	my audit-phis pre-4
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }
    if {[my pre_eliminate]} {
	puts "Eliminate did something!"
	set did_something 1
    }

    # 5. Now, dead code elimination and copy propagation will eliminate
    #    any messes that step 4 left behind.
    
    if {[catch {

oo::define quadcode::transformer method pre_insert_do_expr {b v e} {

    my variable pre_new_sets

    my debug-pre {
	puts "Examine value $v: $e for code motion at entry to block $b"
    }

    if {[my pre_gvn_is_literal $v -]} {
	my debug-pre {
	    puts "$v: $e is a literal - there's nothing to be done."
	}	    
	return 0;		# There's nothing to insert for a literal
    }
	

    # Is this a point where it's appropriate to insert (It is if
    # the value is available on at least one predecessor, and not on all).

    set avail [my pre_insertion_point $b $v $e]
    if {[dict size $avail] == 0} {
	my debug-pre {

	    set tv [my pre_gvn_lookup_or_add $eprime]
	    my pre_gvn_add [list {} $t] $tv
	    set insn [list $opcode $t]
	    foreach a $argl {
		if {[lindex $a 0] ne "value"} {
		    lappend insn $a
		} else {
		    set v [lindex $a 1]
		    if {[dict exists $avail_out_p $v]} {
			set var [dict get $avail_out_p $v]
			my addUse $var $p
			lappend insn $var
		    } elseif {[my pre_gvn_is_literal $v lit]} {
			lappend insn $lit
		    } else {
			error "$v is unavailable at end of $p!"
		    }
		}
	    }

	    # Insert the instruction in the block
	    set pb [lindex $bbcontent $p]
	    lset bbcontent $p {}
	    my debug-pre {

		}
	    }
	    
	    lappend newbb $q
	}
	lset bbcontent $b $newbb
    }







    return $changed
}

# quadcode::transformer method pre_cleanup --
#
#	Clean up globals left behind by partial redundancy elimination
#

    if {$x == -1} {		# We haven't seen the expression yet
	set x [llength $pre_vexprs]
	lappend pre_vexprs {}
	my pre_gvn_add $e $x
    }
    return $x
}

# quadcode::transformer method pre_gvn_is_literal --
#
#	Determines whether a given value represents a literal.
#
# Parameters:
#	v - Value number to examine
#	litVar - Name of a variable in caller's scope that should receive
#	         the literal that the value number represents
#
# Results:
#	Returns 1 if the value represents a literal, 0 otherwise.
#
# Side effects:
#	Stores the name in 'litVar' if the value represents a literal

oo::define quadcode::transformer method pre_gvn_is_literal {v litVar} {
    upvar 1 $litVar lit

    my variable pre_vexprs

    foreach expr [lindex $pre_vexprs $v] {
	if {[lindex $expr 0] eq "literal"} {
	    set lit $expr
	    return 1
	}
    }

    return 0
}

	    copyprop
	    cleanupMoveFromCallFrame
	    cleanupMoveToCallFrame
	    cleanupCallFrameUse
	    cleanupNarrow
	    deadjump
	    deadbb
	    bbidom
	    bblevel
	    constfold
	    deadvars
	    uselessphis
	    constfold


	    partialredundancy
	} {
	    set cmd [string map [list @pass $pass] {
		set result [my @pass]
	    }]
	    lappend timings $pass [lindex [time $cmd] 0]
	    if {$result} {