Tcl Library Source Code

[vset VERSION 1]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin lazyset n [vset VERSION]]
[copyright {2018 Roy Keene}]
[moddesc   {Lazy evaluation for variables and arrays}]
[category  Utility]
[titledesc {Lazy evaluation}]
[require Tcl 8.5]
[require lazyset [opt [vset VERSION]]]
[description]
[para]

The [package lazyset] package provides a mechanism for deferring execution
of code until a specific variable or any index of an array is referenced.

[section {COMMANDS}]

[list_begin definitions]
[call [cmd ::lazyset::variable] [opt [arg {-array boolean}]] [opt [arg {-appendArgs boolean}]] [arg variableName] [arg commandPrefix]]
Arrange for the code specified as [arg commandPrefix] to be executed when
the variable whose name is specified by [arg variableName] is read for
the first time.

If the optional argument [arg {-array boolean}] is specified as true,
then the variable specified as [arg variableName] is treated as an
array and attempting to read any index of the array causes that
index to be set by the [arg commandPrefix] as they are read.

If the optional argument [arg {-appendArgs boolean}] is specified as
false, then the variable name and subnames are not appended to the
[arg commandPrefix] before it is evaluated.  If the argument
[arg {-appendArgs boolean}] is not specified or is specified as true
then 1 or 2 additional arguments are appended to the [arg commandPrefix].
If [arg {-array boolean}] is specified as true, then 2 arguments are
appended corresponding to the name of the variable and the index,
otherwise 1 argument is appended containing the name of variable.

The [arg commandPrefix] code is run in the same scope as the variable
is read.

[list_end]

[section EXAMPLES]

[example {
	::lazyset::variable page {apply {{name} {
		package require http
		set token [http::geturl http://www.tcl.tk/]
		set data [http::data $token]
		return $data
	}}}

	puts $page
}]

[example {
	::lazyset::variable -array true page {apply {{name index} {
		package require http
		set token [http::geturl $index]
		set data [http::data $token]
		return $data
	}}}

	puts $page(http://www.tcl.tk/)
}]

[example {
	::lazyset::variable -appendArgs false simple {
		return -level 0 42
	}

	puts $simple
}]

[section AUTHORS]
Roy Keene

[vset CATEGORY utility]
[include ../doctools2base/include/feedback.inc]
[manpage_end]

#! /usr/bin/env tclsh

package require Tcl 8.5

namespace eval ::lazyset {}

proc ::lazyset::variable {args} {
	lassign [lrange $args end-1 end] varName commandPrefix
	set args [lrange $args 0 end-2]

	set appendArgs true
	foreach {arg val} $args {
		switch -exact -- $arg {
			"-array" {
				set isArray [expr {!!$val}]
			}
			"-appendArgs" {
				set appendArgs [expr {!!$val}]
			}
			default {
				error "Valid options -array, -appendArgs: Invalid option \"$arg\""
			}
		}
	}

	set trace [uplevel 1 [list trace info variable $varName]]
	if {$trace ne ""} {
		uplevel 1 [list [list trace remove variable $varName $trace]]
	}

	if {![info exists isArray]} {
		set isArray false
		if {[uplevel 1 [list ::array exists $varName]]} {
			set isArray true
		}
	}

	set finalCode ""
	if {$isArray} {
		append finalCode {
			set varname "$name1\($name2\)"
			if {[uplevel 1 [list info exists $varname]]} {
				return
			}
		}
	} else {
		append finalCode {
			set varname $name1
		}
	}

	if {$appendArgs} {
		append finalCode {
			set args [lrange $args 1 end]
		}
		if {$isArray} {
			append finalCode {
				append code " " [list $name1 $name2 {*}$args]
			}
		} else {
			append finalCode {
				append code " " [list $name1 {*}$args]
			}
		}
	}

	append finalCode {
		set result [uplevel 1 $code]

		uplevel 1 [list unset -nocomplain $varname]
		uplevel 1 [list set $varname $result]
	}

	set code [list apply [list {code name1 name2 args} $finalCode] $commandPrefix]

	if {$isArray} {
		uplevel 1 [list unset -nocomplain $varName]
		uplevel 1 [list ::array set $varName [list]]
	} else {
		uplevel 1 [list set $varName ""]
	}

	uplevel 1 [list trace add variable $varName read $code]

	return
}

package provide lazyset 1

# lazyset.test - Copyright (c) 2018 Roy Keene
#
# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2

testing {
	useLocal lazyset.tcl lazyset
}

# -------------------------------------------------------------------------

test lazyset-basic-1.0 {} -body {
	::lazyset::variable -appendArgs false test {
		return -level 0 ok
	}
	set test
} -cleanup {
	unset test
} -result {ok}

test lazyset-withargs-1.0 {} -body {
	::lazyset::variable test [list apply {{name} {
		return ok
	}}]
	set test
} -cleanup {
	unset test
} -result {ok}

test lazyset-withargs-2.0 {} -body {
	::lazyset::variable test [list apply {{result name} {
		return $result
	}} ok]
	set test
} -cleanup {
	unset test
} -result {ok}

test lazyset-inscope-1.0 {} -body {
	::lazyset::variable -appendArgs false test {
		set x 0
		return -level 0 ok
	}
	set test
	set x
} -cleanup {
	unset test
	unset x
} -result {0}

test lazyset-onlyonce-1.0 {} -body {
	set x 0
	::lazyset::variable -appendArgs false test {
		incr x
		return -level 0 ok
	}
	set test
	set test
	set x
} -cleanup {
	unset test
	unset x
} -result {1}

test lazyset-onlyonce-2.0 {} -body {
	set x 0
	::lazyset::variable -appendArgs false -array true test {
		incr x
		return -level 0 ok
	}
	set test(a)
	set test(a)
	set x
} -cleanup {
	unset test
	unset x
} -result {1}

test lazyset-onlyonce-3.0 {} -body {
	set x 0
	::lazyset::variable -appendArgs false -array true test {
		incr x
		return -level 0 ok
	}
	set test(a)
	set test(a)
	set test(b)
	set test(b)
	set x
} -cleanup {
	unset test
	unset x
} -result {2}

test lazyset-array-1.0 {} -body {
	::lazyset::variable -appendArgs false -array true test {
		return -level 0 ok
	}
	set result $test(a)
	append result $test(b)
} -cleanup {
	unset test
	unset result
} -result {okok}

test lazyset-array-1.0 {} -body {
	::lazyset::variable -array true test [list apply {{_ index} {
		return $index
	}}]
	set result $test(a)
	append result $test(b)
} -cleanup {
	unset test
	unset result
} -result {ab}


# -------------------------------------------------------------------------
testsuiteCleanup

# Local variables:
# mode: tcl
# indent-tabs-mode: nil
# End:

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded lazyset 1 [list source [file join $dir lazyset.tcl]]

Module  inifile     _tcl  _man  _null
Module  interp      _tcl  _man  _null
Module  irc         _tcl  _man _exa
Module  javascript  _tcl  _man  _null
Module  jpeg        _tcl  _man  _null
Module  json        _tcl  _man  _null
Module  lambda      _tcl  _man  _null
Module  lazyset     _tcl  _man  _null
Module  ldap        _tcl  _man _exa
Module  log          _msg _man  {_exax logger}
Module  markdown     _tcl  _man  _null
Module  map         _tcl  _man  _null
Module  mapproj     _tcl  _man _exa
Module  math         _tci _man _exa
Module  md4         _tcl  _man  _null