# upvar.tcl --
#
#       Methods to analyze the effect of [upvar] upon callers of a procedure.
#
# Copyright (c) 2017 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 analyzeUpvar --
#
#       Analyzes the effect that [upvar] will have on the callers of the
#       procedure being compiled.
#
# Results:
#       Returns the procedure's frame effect
#
# Preconditions:
#       The quadcode must be in SSA form. The 'callframeMotion' pass must
#       have installed the (possibly redundant) 'moveToCallFrame' and
#       'moveFromCallFrame' instructions. Copy propagation must have been
#       performed.
#
# Side effects:
#       Calls the specializer to set attributes of the current procedure:
#
#           reads - List of parameters that contain argument positions
#                   of input variables passed by name.
#           writes - List of parameters that contain argument positions
#                    of output variables passed by name.
#           readsNamed - List of names of input variables passed implicitly
#           writesNamed - List of names of output variables passed implicitly
#           noCallFrame - Flag if it is permissible to eliminate the caller's
#                         callframe entirely.
#           allCallFrames - Flag if all callers on the stack must have
#                           callframes (because, for instance, of an
#                           [upvar] to an unknown stack level).

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

    my debug-upvar {
        puts "Before \[upvar\] analysis:"
        my dump-bb
    }

    # 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]

    return $procEffect
}

# quadcode::transformer method upvarAnalyzeArgs --
#
#       Determines what named variables in SSA-based quadcode are known to
#       contain the values of passed parameters (with possible MAYBE and
#       NEXIST monads eliminated). (TODO: It may in future also be necessary
#       to look for widened or narrowed types.)
#
# Results:
#       Returns a dictionary whose keys are SSA value names and whose values
#       are the corresponding parameter positions.

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

    # Analyze the entry block, looking for 'param' instructions

    set worklist {}
    set argPos {}
    foreach q [lindex $bbcontent 0] {
        if {[lindex $q 0] eq "param"} {
            set var [lindex $q 1]
            set argIdx [expr {[lindex $q 2 1] + 1}]
            my debug-upvar {
                puts "[lindex $q 1] is argument \#$argIdx]"
            }
            dict set argPos $var $argIdx
            my addUsesToUpvarWorklist worklist $var
        }
    }

    # Propagate the identity of the parameters through copies, extracts,
    # and type narrowing.

    while {[llength $worklist] > 0} {
        set worklist [lassign $worklist b]
        foreach q [lindex $bbcontent $b] {
            switch -exact [lindex $q 0 0] {
                copy -
                extractExists -
                extractMaybe -
                narrowToType -
                purify -
                widenTo {
                    set var [lindex $q 1]
                    set invar [lindex $q 2]
                    if {![dict exists $argPos $var]
                        && [dict exists $argPos $invar]} {
                        set argIdx [dict get $argPos $invar]
                        my debug-upvar {
                            puts "  $var also refers to arg $argIdx"
                        }
                        dict set argPos $var [dict get $argPos $invar]
                        my addUsesToUpvarWorklist worklist $var
                    }
                }
            }
        }
    }

    return $argPos
}

# quadcode::transformer method upvarFindAliases --
#
#       Determines what variables in a procedure's callframe may alias
#       what variables in the caller's frame.
#
# Parameters:
#
#       argPos -
#           Dictionary whose keys are the names of quadcode variables and
#           whose values are positions in the argument list. The values
#           in question are known always to contain the values of
#           passed parameters; therefore, if they appear on 'upvar', they
#           are variables passed by name
#
#
# Results:
#
#	Returns a two-element list.
#
#	The first element indicates whether all alias effects could be
#	computed. If it is zero, the second element is a dictionary described
#	below. If it is 1, there is at least one 
#       Returns a dictionary whose keys are the names
#       of quadcode variables that contain callframes. Each value in the
#	dictionary is a second-level dictionary whose keys are the names
#	of variables in the callframe and whose values are chosen from
#       among:
#
#           {arg N} - The variable name is the Nth parameter of the
#                     current procedure (pass-by-name}
#           {named N} - The variable name is constant (named variable
#                       in the caller's frame).
#           {unknown} - The variable name is unknown, but is known
#                       at least to be in the caller's callframe, rather
#                       farther out on the stack. (The implication
#                       of {unknown} is that the variable may potentially
#                       alias any variable in the caller's frame.)
#           {global} - The variable is known to be in global or
#                      namespace scope, not in the callframe.
#           {nonlocal} - The variable may be in the callframe of an
#                        outer caller, so calling this procedure might
#                        have nonlocal effects.
#
# Operations that change the aliasing status of one or more variables:
#    callFrameNop
#    extractCallFrame
#    moveToCallFrame
#       Do noting about aliasing, simply copy the aliasing information from
#       the source callframe to the destination callframe.
#    entry -
#       On entry, no variable is an alias
#    invoke -
#       Adjust aliasing according to what the invoked command does.
#    nsupvar
#       Indicate that the designated variable is global. (If the target
#       variable name is nonconstant, error out).
#    phi
#       Set the aliases in the result callframe to the union of the aliases
#       in the input callframes
#    upvar
#       Indicate that the designated variable is an arg, a name, or an unknown
#       ref (Only cases handled are upvar 1 and upvar #0)
#    variable
#       Indicate that the designated variable is global. (If the name is
#       nonconstant, error out


oo::define quadcode::transformer method upvarFindAliases {argPos} {

    # Trace data flows from the entry block.
    set firstq [lindex $bbcontent 0 0]
    if {[lindex $firstq 0] ne "entry" || [lindex $firstq 1] eq {}} {
	# The procedure does not use the callframe
	return {}
    }

    set worklist {}
    set entryFrame [lindex $firstq 1]
    dict set aliasInfo $entryFrame {}
    my addUsesToUpvarWorklist worklist $entryFrame

    # While there's analysis to be done, do it.
    while {[llength $worklist] > 0} {

	# Find the next basic block to analyze and walk its instructions,
	# unpacking opcode, result, and input callframe from each one.
	set worklist [lassign $worklist b]
	set bb [lindex $bbcontent $b]
	set pc -1
	foreach q $bb {
	    incr pc
	    lassign $q opcode result arg1 arg2

	    # resFrame, if set is the alias info for the new quad.
	    unset -nocomplain resFrame

	    # Analyze individual quads
	    switch -exact -- [lindex $opcode 0] {
		callFrameNop -
		extractCallFrame -
		invoke {

		    # These instructions do not change aliases, so copy
		    # the input frame to the result frame.
		    if {![dict exists $aliasInfo $arg1]} {
			set resFrame {}
		    } else {
			set resFrame [dict get $aliasInfo $arg1]
		    }

		}
		moveToCallFrame {

		    # If the variable isn't already upvar or global,
		    # this instruction will make it local.
		    if {![dict exists $aliasInfo $arg1]} {
			set resFrame {}
		    } else {
			set resFrame [dict get $aliasInfo $arg1]
		    }
		    if {[lindex $arg2 0] ne "literal"} {
			return 1; # Local variable name not constant
		    }
		    foreach {localVar source} [lrange $q 3 end] {
			if {[lindex $localVar 0] ne "literal"} {
			    error "cannot handle double-dereference"
			}
			set localVarName [lindex $localVar 1]
			if {![dict exists $resFrame $localVarName]} {
			    dict set resFrame $localVarName local
			}
		    }

		}
		nsupvar - variable {

		    # These instructions always make the local variable
		    # alias a namespace variable

		    if {![dict exists $aliasInfo $arg1]} {
			set resFrame {}
		    } else {
			set resFrame [dict get $aliasInfo $arg1]
		    }
		    if {[lindex $arg2 0] ne "literal"} {
			return 1; # Local variable name not constant"
		    }
		    set localVar [lindex $arg2 1]
		    if {[dict exists $resFrame $localVar]
			&& [dict get $resFrame $localVar] eq "local"} {
			# TODO - How to report static errors?
			error "$localVar is already defined"
		    }
		    dict set resFrame $localVar global
		}
		
		phi {
		    set isCallframe 0
		    if {![dict exists $aliasInfo $arg2]} {
			set resFrame {}
		    } else {
			set isCallframe 1
			set resFrame [dict get $aliasInfo $arg2]
		    }
		    foreach {- arg} [lrange $q 4 end] {
			if {[dict exists $aliasInfo $arg]} {
			    set isCallframe 1
			    set resFrame [my upvarPhi $resFrame \
					      [dict get $aliasInfo $arg]]
			}
		    }
		    if {!$isCallframe} {
			unset resFrame
		    }
			
		}
		
		upvar {
		    if {![dict exists $aliasInfo $arg1]} {
			set resFrame {}
		    } else {
			set resFrame [dict get $aliasInfo $arg1]
		    }
		    if {[lindex $arg2 0] ne "literal"} {
			return 1; # Local variable name not constant"
		    }
		    set localVar [lindex $arg2 1]
		    set level [lindex $q 4]
		    set remoteName [lindex $q 5]
		    if {[lindex $remoteName 0] eq "literal"
			&& [string first :: [lindex $remoteName 1]] >= 0} {
			set status "global"
		    } elseif {[lindex $level 0] ne "literal"} {
			set status "nonlocal"
		    } elseif {[lindex $level 1] eq "1"} {
			if {[lindex $remoteName 0] eq "literal"} {
			    set status [list "named" [lindex $remoteName 1]]
			} elseif {[dict exists $argPos $remoteName]} {
			    set status \
				[list "arg" [dict get $argPos $remoteName]]
			} else {
			    set status "unknown"
			}
		    } elseif {[lindex $level 1] eq "#0"} {
			set status "global"
		    } else {
			set status "nonlocal"
		    }
		    if {[dict exists $resFrame $localVar]
			&& [dict get $resFrame $localVar] eq "local"} {
			# TODO - How to report static errors?
			error "$localVar is already defined"
		    }
		    dict set resFrame $localVar $status

		}
	    }

	    # If the state of the callframe at this point has changed,
	    # add the dependencies

	    if {[info exists resFrame]} {
		set resFrame [lsort -ascii -increasing -index 0 -stride 2 \
				  $resFrame]
		if {![dict exists $aliasInfo $result]
		    || $resFrame ne [dict get $aliasInfo $result]} {
		    my debug-upvar {
			puts "$b:$pc: $q"
			puts "   -> $resFrame"
		    }
		    dict set aliasInfo $result $resFrame
		    my addUsesToUpvarWorklist worklist $result
		}
	    }
	}
    }

    return $aliasInfo

}

# quadcode::transformer method upvarPhi --
#
#	Combines the aliasing information when callframes arrive at a phi.
#
# Parameters:
#	f1 - First callframe's alias information
#	f2 - Second callframe's variable
#
# Results:
#	Returns a conservative estimate of the alias information after
#	the phi.

oo::define quadcode::transformer method upvarPhi {f1 f2} {

    # Walk the first dictionary and promote the values to the second
    # dictionary's alias type if necessary.

    dict for {v a} $f1 {
	if {[dict exists $f2 $v]} {
	    set b [dict get $f2 $v]
	    if {$a ne $b} {
		if {$b eq "nonlocal"} {
		    dict set f1 $v $b
		} elseif {$a eq "nonlocal"} {
		} elseif {$b eq "unknown"} {
		    dict set f1 $v $b
		} elseif {$a eq "unknown"} {
		} elseif {$a eq "local"} {
		    dict set v1 $v $b
		} elseif {$b eq "local"} {
		} else {
		    # mismatched combination of named and arg
		    dict set v1 $v "unknown"
		}
	    }		
	    dict unset f2 $v
	}
    }

    return [dict merge $f1 $f2]
    
}

# quadcode::transformer method upvarProcEffect --
#
#	Determines the effect of a procedure on the outer callframes of
#	the stack.
#
# Parameters:
#	state - Dictionaries whose keys are the names of quadcode variables
#	        that designate callframes, and whose values are the possible
#               aliases of the variables in outer frames.
#
# Results:
#	Returns a dictionary that characterizes the code's effect.

oo::define quadcode::transformer method upvarProcEffect {aliasInfo} {

    # All of the information should be in place to allow us simply to
    # accumulate the effect of 'moveToCallFrame', 'moveFromCallFrame',
    # and invoked commands.

    set result [dict create \
		    killable Inf noCallFrame {} pure {} \
		    reads {} writes {} \
		    readsNamed {} writesNamed {} \
		    readsAny 0 writesAny 0 \
		    readsNonLocal 0 writesNonLocal 0]

    # Walk through the quadcode, analyzing instructions that get/set
    # values in the callframe for their effects on potential aliases.

    set b -1
    foreach bb $bbcontent {
	incr b
	set pc -1
	foreach q $bb {
	    incr pc

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

		"moveFromCallFrame" {
		    set did 1
		    lassign $q opcode qcvar callframe cfvar
		    if {[lindex $cfvar 0] ne "literal"} {
			error "Cannot handle double-dereference"
		    } else {
			set cfvar [lindex $cfvar 1]
		    }
		    if {[dict exists $aliasInfo $callframe $cfvar]} {
			my upvarRecordRead result \
			    [dict get $aliasInfo $callframe $cfvar]
			# must do: dict unset result pure
		    }
		}

		"moveToCallFrame" {
		    set did 1
		    set vs [lassign $q opcode cfout cfin]
		    foreach {cfvar qcvar} $vs {
			if {[lindex $cfvar 0] ne "literal"} {
			    error "Cannot handle double-dereference"
			} else {
			    set cfvar [lindex $cfvar 1]
			}
			if {[dict exists $aliasInfo $cfout $cfvar]} {
			    my upvarRecordWrite result \
				[dict get $aliasInfo $cfout $cfvar]
			    # must do: dict unset result pure;
			    # must do: dict unset result killable;
			}
		    }
		}

		"invoke" {
		    set did 1
		    set argList [lassign $q opcode cfout cfin cmdName]
		    set typeList [lmap arg $argList {typeOfOperand $types $arg}]
		    set attrs [$specializer frameEffect $q $typeList]
		    my upvarInvoke result $aliasInfo $attrs $q $typeList
		}

	    }

	    my debug-upvar {
		if {$did} {
		    puts "$b:$pc: $q"
		    puts "    effect changed to $result"
		}
	    }
	}
    }

    my debug-upvar {
	puts "Before rewrites: stack effect: $result"
    }

    if {[dict get $result readsAny]} {
	dict set result reads 0
    } else {
	dict set result reads [dict keys [dict get $result reads]]
    }
    dict unset result readsAny
    if {[dict get $result writesAny]} {
	dict set result writes 0
    } else {
	dict set result writes [dict keys [dict get $result writes]]
    }
    dict unset result writesAny
    if {[llength [dict get $result reads]] == 0} {
	dict unset result reads
    }
    if {[llength [dict get $result writes]] == 0} {
	dict unset result writes
    }
    if {[dict size [dict get $result readsNamed]] == 0} {
	dict unset result readsNamed
    } else {
	dict set result readsNamed [dict keys [dict get $result readsNamed]]
    }
    if {[dict size [dict get $result writesNamed]] == 0} {
	dict unset result writesNamed
    } else {
	dict set result writesNamed [dict keys [dict get $result writesNamed]]
    }
    if {![dict get $result readsNonLocal]} {
	dict unset result readsNonLocal
    }
    if {![dict get $result writesNonLocal]} {
	dict unset result writesNonLocal
    }

    if {[dict exists $result reads]
	|| [dict exists $result readsAny]
	|| [dict exists $result readsNonLocal]} {
	dict unset result pure
	dict unset result noCallFrame
    }
    if {[dict exists $result writes]
	|| [dict exists $result writesAny]
	|| [dict exists $result writesNonLocal]} {
	dict unset result pure
	dict unset result noCallFrame
	dict unset result killable
    }

    my debug-upvar {
	puts "Stack effect calculated to be: $result"
    }
    return $result
}
                                                                
# quadcode::transformer method upvarInvoke --
#
#	Compute the callframe effect of an invoked command.
#
# Parameters:
#	resultV - Name of a variable in caller's scope containing the
#	          callframe effect of the current command
#	aliasInfo - Dictionary that identifies what callframe variables have
#		    aliases in the caller
#	effect - Callframe effect of the invoked command.
#	q - 'invoke' instruction being processed
#	typeList - Types of the arguments to $q
#
# Results:
#	None.
#
# Side effects:
#	Records the effect of the 'invoke' on the current callframe.

oo::define quadcode::transformer method upvarInvoke {resultV aliasInfo
						     effect q typeList} {

    upvar 1 $resultV result

    # Record purity

    if {![dict exists $effect pure]} {
	dict unset result pure
    }

    # Record nonlocal effects

    if {[dict exists $effect readsNonLocal]} {
	dict set result readsNonLocal 1
    }
    if {[dict exists $effect writesNonLocal]} {
	dict set result writesNonLocal 1
    }

    # Defer to specializer for produced and consumed variables

    lassign [my variablesUsedBy $q $typeList] status varlist
    if {$status} {
	foreach v $varlist {
	    if {[dict exists $aliasInfo $v]} {
		my recordRead [dict get $aliasInfo $v]
	    }
	}
    } else {
	dict set result reads {0 {}}
    }
    lassign [my variablesProducedBy $q $typeList] status varlist
    if {$status} {
	foreach v $varlist {
	    if {[dict exists $aliasInfo $v]} {
		my recordWrite [dict get $aliasInfo $v]
	    }
	}
    } else {
	dict set result writes {0 {}}
    }
}

oo::define quadcode::transformer method upvarRecordRead {resultV alias} {

    upvar 1 $resultV result
    if {$alias ni {"local" "global"}} {
	dict unset result killable
	dict unset result noCallFrame
    }
    my upvarRecordAction result $alias reads
}
    

oo::define quadcode::transformer method upvarRecordWrite {resultV alias} {
    upvar 1 $resultV result
    if {$alias ne "local"} {
	dict unset result pure
	dict unset result killable
	dict unset result noCallFrame
    }
    my upvarRecordAction result $alias writes
}

oo::define quadcode::transformer method upvarRecordAction {resultV alias act} {

    upvar 1 $resultV result

    switch -exact -- [lindex $alias 0] {
	"arg" {
	    dict set result $act [lindex $alias 1] {}
	}
	"global" {
	    dict set result ${act}Global {}
	}
	"local" {
	}
	"named" {
	    dict set result ${act}Named [lindex $alias 1] {}
	}
	"nonlocal" {
	    dict set result ${act}NonLocal {}
	}
	"unknown" {
	    dict set result $act {0 {}}
	}
	default {
	    error "TODO - Handle alias type $alias"
	}
    }
}
    

oo::define quadcode::transformer method addUsesToUpvarWorklist {worklistVar v} {
    upvar 1 $worklistVar worklist
    if {[dict exists $duchain $v]} {
        dict for {use -} [dict get $duchain $v] {
            my addToUpvarWorklist worklist $use
        }
    }
}

oo::define quadcode::transformer method addToUpvarWorklist {worklistVar item} {
    upvar 1 $worklistVar worklist
    set idx [lsearch -sorted -integer -increasing -bisect  $worklist $item]
    if {[lindex $worklist $idx] != $item} {
        set worklist [linsert $worklist[set worklist {}] [expr {$idx+1}] $item]
    }
}
