Tcl Library Source Code

Check-in [49fdc19548]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added Roy Keene's new package, 'lazyset' (determine a value on 1st read of a variable)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 49fdc19548828f2b5f3f8442770a008fdc0454901ca835c2aac5a02ab32aae5e
User & Date: aku 2019-02-22 00:54:51
Context
2019-02-22
07:02
Corrected copy and paste error in test name check-in: 1aa3aa432f user: oehhar tags: trunk
00:54
Added Roy Keene's new package, 'lazyset' (determine a value on 1st read of a variable) check-in: 49fdc19548 user: aku tags: trunk
2019-02-21
23:39
Import trunk fixes Tweak manpage a bit for easier version update. Tweak package index to check core version. Closed-Leaf check-in: ca21301c2a user: aku tags: add-lazyset
23:32
Tkt [fdf6afed94] done. Merged tkt-fdf6afed94, full tests passing. check-in: 5e257ddf79 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added modules/lazyset/lazyset.man.
































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
[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]

Added modules/lazyset/lazyset.tcl.
















































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#! /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

Added modules/lazyset/lazyset.test.




































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
# 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:

Added modules/lazyset/pkgIndex.tcl.




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

Changes to support/installation/modules.tcl.

87
88
89
90
91
92
93

94
95
96
97
98
99
100
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  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






>







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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