# Results:
    #	None.

    method dropReference {value} {
	my Call tcl.dropReference $value
	return
    }

    # Builder:dropReference(IMPURE EMPTY DICT) --
    #
    #	Generate code to decrement the reference count of a value and delete
    #	the value if it has ceased to be used.
    #
    # Parameters:
    #	value -	The IMPURE EMPTY DICT LLVM value reference for the operand.
    #
    # Results:
    #	None.

    method dropReference(IMPURE\040EMPTY\040DICT) {value} {
	my Call tcl.dropReference $value
	return
    }

    # Builder:dropReference(IMPURE EMPTY LIST) --
    #
    #	Generate code to decrement the reference count of a value and delete
    #	the value if it has ceased to be used.
    #
    # Parameters:
    #	value -	The IMPURE EMPTY LIST LLVM value reference for the operand.
    #
    # Results:
    #	None.

    method dropReference(IMPURE\040EMPTY\040LIST) {value} {
	my Call tcl.dropReference $value
	return
    }

    # Builder:dropReference(STRING) --
    #
    #	Generate code to decrement the reference count of a value and delete
    #	the value if it has ceased to be used.
    #
    # Parameters:

    method instanceOf.ZEROONE_BOOLEAN(STRING) {value {name ""}} {
	my call ${tcl.isZeroOneBoolean} [list $value [Const false bool]] $name
    }
    method instanceOf.IMPURE_ZEROONE_BOOLEAN(STRING) {value {name ""}} {
	my call ${tcl.isZeroOneBoolean} [list $value [Const false bool]] $name
    }

    # Builder:instanceOf.DICT --
    #
    #	Generate code to check if the given STRING contains something that can
    #	be parsed to get a DICT.

    method instanceOf.DICT(STRING) {value {name ""}} {
	my call ${tcl.isDict} [list $value] $name
    }
    method instanceOf.IMPURE_DICT(STRING) {value {name ""}} {
	my call ${tcl.isDict} [list $value] $name
    }

    # Builder:instanceOf.LIST --
    #
    #	Generate code to check if the given STRING contains something that
    #	can be parsed to get a LIST.

    method instanceOf.LIST(STRING) {value {name ""}} {
	my call ${tcl.isList} [list $value] $name
    }
    method instanceOf.IMPURE_LIST(STRING) {value {name ""}} {
	my call ${tcl.isList} [list $value] $name
    }

    # Builder:int --
    #
    #	Generate code to create an integer "literal".
    #
    # Parameters:
    #	value -	The Tcl integer that we are converting to an LLVM INT.

	if {[string match "* NEXIST" $type]} {
	    set type [string range $type 0 end-7]
	} elseif {[string match "NEXIST *" $type]} {
	    set type [string range $type 7 end]
	}
	my insert [my undef $type!] [Const true bool] 0 $name
    }

    # Builder:narrowToType.LIST(STRING) --
    #
    #	Generate code to parse the given STRING and extract a LIST. The
    #	STRING is already be known to contain a value of the right type (due
    #	to higher-level quadcode constraints). Quadcode implementation
    #	('narrowToType').
    #
    # Parameters:
    #	value -	The STRING LLVM value reference to parse.
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	A DOUBLE LLVM value reference.

    method narrowToType.LIST(STRING) {value {name ""}} {
	return $value
    }
    method narrowToType.IMPURE_LIST(STRING) {value {name ""}} {
	return $value
    }
    method narrowToType.EMPTY_LIST(STRING) {value {name ""}} {
	return $value
    }
    method narrowToType.IMPURE_EMPTY_LIST(STRING) {value {name ""}} {
	return $value
    }

    # Builder:unmaybe --
    #
    #	Get the value out of a FAIL or NEXIST. NOTE: The FAIL/NEXIST must be a
    #	Just or the result will be an 'undef'; test with the 'maybe' method
    #	first!
    #

    #	Returns an LLVM IMPURE NUMERIC value

    method packImpure(NUMERIC) {value {name ""}} {
	set sval [my stringify(NUMERIC) $value]
	my addReference(STRING) $sval
	return [my impure NUMERIC $sval $value $name]
    }

    # Builder:packImpure(DICT) --
    #
    #	Convert a DICT to an IMPURE DICT
    #
    # Parameters:
    #	value -	LLVM Value to pack into the 'impure' structure
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	Returns an LLVM IMPURE DICT value

    method packImpure(DICT) {value {name ""}} {
	return $value
    }

    # Builder:packImpure(EMPTY DICT) --
    #
    #	Convert an EMPTY DICT to an IMPURE EMPTY DICT
    #
    # Parameters:
    #	value -	LLVM Value to pack into the 'impure' structure
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	Returns an LLVM IMPURE DICT value

    method packImpure(EMPTY\040DICT) {value {name ""}} {
	return $value
    }

    # Builder:packImpure(EMPTY LIST) --
    #
    #	Convert an EMPTY LIST to an IMPURE EMPTY LIST
    #
    # Parameters:
    #	value -	LLVM Value to pack into the 'impure' structure
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	Returns an LLVM IMPURE LIST value

    method packImpure(EMPTY\040LIST) {value {name ""}} {
	return $value
    }

    # Builder:packImpure(LIST) --
    #
    #	Convert a LIST to an IMPURE LIST
    #
    # Parameters:
    #	value -	LLVM Value to pack into the 'impure' structure
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	Returns an LLVM IMPURE LIST value

    method packImpure(LIST) {value {name ""}} {
	return $value
    }

    # Builder:packImpure(ZEROONE BOOLEAN) --
    #
    #	Convert a ZEROONE BOOLEAN to an IMPURE ZEROONE BOOLEAN
    #
    # Parameters:
    #	value -	LLVM Value to pack into the 'impure' structure

			my Warn "default injection for parameter %d of '%s'; injecting '%s'" \
			    [expr {$idx + 1}] [GetValueName [$func ref]] $defaultvalue
			set var [my LoadTypedLiteral $defaultvalue $type]
		    } else {
			set var [$func param $idx $name]
		    }
		    set variables($tgt) $var
		    if {[regexp {^IMPURE } $type] && "LIST" ni $type && "DICT" ni $type} {
			set var [$b stringifyImpure $var]
			set type STRING
		    }
		    if {refType($type)} {
			$b printref $var "param:"
			$b addReference($type) $var
			$b assume [$b shared $var]

		    append opcode ( [my ValueTypes $src] )
		    set src [my LoadOrLiteral $src]
		    my StoreResult $tgt [$b $opcode $src $name]
		}
		"purify" {
		    lassign $l opcode tgt src
		    set value [my LoadOrLiteral $src]
		    set srctype [my OperandType $src]
		    if {"IMPURE" ni $srctype} {
			return -code error \
			    "Trying to purify something that is not impure"
		    }
		    set name [my LocalVarName $tgt]
		    if {"LIST" ni $srctype && "DICT" ni $srctype} {
			set value [$b impure.value $value $name]
		    }
		    set type [my OperandType $tgt]
		    if {refType($type)} {
			$b addReference($type) $value
			$b printref $value "purify:"
		    }
		    my StoreResult $tgt $value
		}
		"free" {
		    lassign $l opcode tgt src
		    set type [my OperandType $src]
		    if {$src ni $consumed} {
			if {$type eq "VOID"} {
			    # VOID is trivial to free
			} elseif {refType($type)} {
			    $b printref $variables($src) "free:"
			    set vt [my ValueTypes $src]
			    if {"ARRAY" in $vt} {
				# TRICKY POINT: need variable name to unset an array
				set name [Const [my LocalVarName $tgt] STRING]
				$b dropReference($vt) $variables($src) $name
			    } else {
				$b dropReference($vt) $variables($src)
			    }
			}
			lappend consumed $src
		    }
		}
		"exists" {
		    lassign $l opcode tgt src

		set tuple [$b arraystring.from.array $value]
	    } else {
		set svalue [my WidenedValue $value $srctype STRING]
		set tuple [$b arraystring.from.scalar $svalue]
	    }
	    return $tuple
	}

	# Variations of LIST and DICT go straight to STRING

	if {"STRING" in $tgttype && ("LIST" in $srctype || "DICT" in $srctype)} {
	    return $value
	}

	# IMPURE to IMPURE - Copy the string value, and promote the
	# inner value

	if {[lindex $tgttype 0] eq "IMPURE"
		&& [lindex $srctype 0] eq "IMPURE"} {
	    set itgttype [lrange $tgttype 1 end]

    variable tcl.resolveCmd tcl.originCmd

    # Variables holding implementations of Tcl's list operators
    variable tcl.list.create tcl.list.length tcl.list.append tcl.list.concat
    variable tcl.list.foreach.getStep tcl.list.foreach.mayStep
    variable tcl.list.foreach.nextStep tcl.list.foreach.start.step
    variable tcl.list.foreach.start.finish tcl.list.unshare
    variable tcl.list.range tcl.list.range1 tcl.list.in tcl.isList
    variable tcl.list.index tcl.list.index1 tcl.list.indexList
    variable tcl.list.set tcl.list.set1 tcl.list.setList tcl.list.verify

    # Variables holding implementations of Tcl's dict operators
    variable tcl.dict.get1 tcl.dict.get tcl.dict.set1 tcl.dict.set
    variable tcl.dict.exists1 tcl.dict.exists tcl.dict.unset1 tcl.dict.unset
    variable tcl.dict.iterStart tcl.dict.iterNext tcl.dict.iterDone

	    set call [my Call $func $obj $new]
	    AddCallAttribute $call 1 nocapture
	    AddCallAttribute $call 2 nocapture
	    my ret $new
	label fail:
	    my ret [my null STRING]
	}

	##### Function tcl.isList #####
	#
	# Type signature: objPtr:STRING -> int1
	#
	# Part of quadcode implementation ('isInstance')
	#
	# Wrapper around Tcl_ListObjLength that uses it to do a list-ness
	# check.

	set f [$m local "tcl.isList" int1<-STRING]
	params objPtr
	build {
	    nonnull $objPtr
	    set var [my alloc int "length"]
	    set code [$api Tcl_ListObjLength {} $objPtr $var]
	    my ret [my eq $code $0]
	}

	##### Function tcl.list.create #####
	#
	# Type signature: objc:int * objv:STRING* -> STRING
	#
	# Core of quadcode implementation ('list')
	#

    #	FOLLOWS STANDARD TclOO PROTOCOL
    #
    # Side effects:
    # 	May create a method. May perform a tailcall (beware if attempting to
    # 	wrap with a filter!)

    method unknown {methodName args} {
	set BASIC_REFTYPES {STRING LIST {EMPTY LIST} DICT {EMPTY DICT}}
	switch -regexp -matchvar match -- $methodName {
	    {^addReference\(FAIL[ _]IMPURE (.*)\)$} {
		lassign $match -> utype
		if {$utype ni $BASIC_REFTYPES} {
		    oo::objdefine [self] method $methodName {value} \
			[string map [list @utype $utype] {
			    set sval [my impure.string [my unmaybe $value]]
			    my impure.maybeAddReference [my maybe $value] $sval
			}]
		    tailcall my $methodName {*}$args
		}
	    }
	    {^dropReference\(FAIL[ _]IMPURE[ _](.*)\)$} {
		lassign $match -> utype
		if {$utype ni $BASIC_REFTYPES} {
		    oo::objdefine [self] method $methodName {value} \
			[string map [list @utype $utype] {
			    my select [my maybe $value] \
				[Const false bool] \
				[my addReference(STRING) \
				     [my impure.string [my unmaybe $value]]]
			}]
		    tailcall my $methodName {*}$args
		}
	    }
	    {^addReference\(IMPURE[ _](.*)\)$} {
		lassign $match -> utype
		if {$utype ni $BASIC_REFTYPES} {
		    oo::objdefine [self] method $methodName {value} \
			[string map [list @utype $utype] {
			    my addReference(STRING) [my impure.string $value]
			}]
		    tailcall my $methodName {*}$args
		}
	    }
	    {^dropReference\(IMPURE[ _](.*)\)$} {
		lassign $match -> utype
		if {$utype ni $BASIC_REFTYPES} {
		    oo::objdefine [self] method $methodName {value} \
			[string map [list @utype $utype] {
			    my dropReference(STRING) [my impure.string $value]
			    # How to determine whether the underlying type is
			    # itself a reference type? (Maybe never?)
			    #my {dropReference(@utype)} [my impure.value $value]
			}]
		    tailcall my $methodName {*}$args
		}
	    }
	}
	if {[my MakeTypecastWrapper $methodName]} {
	    tailcall my $methodName {*}$args

	}
	next $methodName {*}$args
    }
    unexport unknown

    # Builder:MakeTypecastWrapper --
    #

	    $b condBr [$b maybe $result] $isFail $next
	    $isFail build $b {
		$b ret [$b extract $result 0]
	    }
	    $next build-in $b
	    set result [$b unmaybe $result]
	}
	set resultType [string map {{EMPTY STRING} STRING} [string map {DICT STRING LIST STRING} $resultType]]
	if {[regexp "^IMPURE (.*)" $resultType -> payload]} {
	    if {$payload ne "STRING"} {
		set result [$b impure.string $result]
		SetValueName $result @result
	    }
	    set resultType STRING
	}
	upvar 0 thunk.result.$resultType thunkResultMapper
	if {![info exist thunkResultMapper]} {
	    error "unhandled result type: $resultType"
	}
	$b call $thunkResultMapper [list $interp $result]

    expr {wide($x)}
}

# A simple helper that is not compiled, but rather just shortens code below

proc cleanopt {script} {
    variable cleanopt
    set badopts {-errorinfo -errorstack}
    set code [uplevel 1 [list catch $script cleanopt(msg) cleanopt(opt)]]
    set msg $cleanopt(msg)
    set opt $cleanopt(opt)
    if {[dict exists $opt -during]} {
	dict set opt -during [lsort -stride 2 -dictionary -index 0 \
		[dict remove [dict get $opt -during] -during {*}$badopts]]
    }
    list $code $msg [lsort -stride 2 -dictionary -index 0 \
	    [dict remove $opt {*}$badopts]]
}
proc cleaneropt {script} {
    variable cleanopt
    set badopts {-errorinfo -errorstack -errorline -errorcode}
    set code [uplevel 1 [list catch $script cleanopt(msg) cleanopt(opt)]]
    set msg $cleanopt(msg)
    set opt $cleanopt(opt)
    if {[dict exists $opt -during]} {
	dict set opt -during [lsort -stride 2 -dictionary -index 0 \
		[dict remove [dict get $opt -during] -during {*}$badopts]]

    }
    list $code $msg [lsort -stride 2 -dictionary -index 0 \
	    [dict remove $opt {*}$badopts]]
}

#########################################################################
#
# List of demonstration scripts. Each of these will be executed before and
# after having the compilation engine applied; the output values from before
# and after will be compared, and if they match, the performance ratio will be

    {expandtest::test1}
    {expandtest::test2}
    {expandtest::test3}
    # {expandtest::test5}   Needs support for loop exception ranges
    {expandtest::test6 {a b c d e} {2 2} x}
    {expandtest::test7}
    {expandtest::test8}
    {cleaneropt {expandtest::test9}}
    {cleaneropt {expandtest::test10}}
    {cleaneropt {expandtest::test11}}
    {cleaneropt {expandtest::test12}}

    {bug-0616bcf08e::msrange 0 10}
    {bug-0616bcf08e::msrange2 0 10}
    {singleton::lforeach}
    {singleton::llindex}
    {singleton::srange}
    {qsort {3 6 8 7 0 1 4 2 9 5}}

	if {$y eq $x} {
	    return $dataType::DOUBLE
	} else {
	    return [dataType::typeUnion $dataType::DOUBLE $dataType::IMPURE]
	}
    } elseif {[string is boolean -strict $x]} {
	return [dataType::typeUnion $dataType::BOOLEAN $dataType::IMPURE]
    } elseif {[string is list $x] && ($x eq [list {*}$x])} {
	# Purity is determined by seeing if the string value could be made by
	# [list]; if not, we've got a value with extra whitespace we should
	# preserve.

	# We claim that lists of length one are simple STRINGs; that's usually
	# a more honest choice.
	if {[llength $x] <= 1} {
	    return $dataType::IMPUREOTHERSTRING
	}
	# Odd-length LISTs cannot be DICTs, and we prefer to not call them
	# DICTs if they have non-unique keys.
	if {[llength $x] & 1 == 0 && [dict create {*}$x] eq [list {*}$x]} {
	    return $dataType::NONEMPTYDICT
	} else {
	    return $dataType::NONDICTLIST
	}
    } else {
	return $dataType::IMPUREOTHERSTRING
    }
}

# builtinCommandType -