docs: update documentation for recent changes
[jimtcl.git] / stdlib.tcl
blob3a2bbd8f85a8bdf7638e669c78646c60f9bfdbab
1 # Implements script-based standard commands for Jim Tcl
3 # Creates an anonymous procedure
4 proc lambda {arglist args} {
5 tailcall proc [ref {} function lambda.finalizer] $arglist {*}$args
8 proc lambda.finalizer {name val} {
9 rename $name {}
12 # Like alias, but creates and returns an anonyous procedure
13 proc curry {args} {
14 alias [ref {} function lambda.finalizer] {*}$args
17 # Returns the given argument.
18 # Useful with 'local' as follows:
19 # proc a {} {...}
20 # local function a
22 # set x [lambda ...]
23 # local function $x
25 proc function {value} {
26 return $value
29 # Returns a live stack trace as a list of proc filename line ...
30 # with 3 entries for each stack frame (proc),
31 # (deepest level first)
32 proc stacktrace {{skip 0}} {
33 set trace {}
34 incr skip
35 foreach level [range $skip [info level]] {
36 lappend trace {*}[info frame -$level]
38 return $trace
41 # Returns a human-readable version of a stack trace
42 proc stackdump {stacktrace} {
43 set lines {}
44 foreach {l f p} [lreverse $stacktrace] {
45 set line {}
46 if {$p ne ""} {
47 append line "in procedure '$p' "
48 if {$f ne ""} {
49 append line "called "
52 if {$f ne ""} {
53 append line "at file \"$f\", line $l"
55 if {$line ne ""} {
56 lappend lines $line
59 join $lines \n
62 # Sort of replacement for $::errorInfo
63 # Usage: errorInfo error ?stacktrace?
64 proc errorInfo {msg {stacktrace ""}} {
65 if {$stacktrace eq ""} {
66 # By default add the stack backtrace and the live stacktrace
67 set stacktrace [info stacktrace]
68 # omit the procedure 'errorInfo' from the stack
69 lappend stacktrace {*}[stacktrace 1]
71 lassign $stacktrace p f l
72 if {$f ne ""} {
73 set result "Runtime Error: $f:$l: "
75 append result "$msg\n"
76 append result [stackdump $stacktrace]
78 # Remove the trailing newline
79 string trim $result
82 # Needs to be set up by the container app (e.g. jimsh)
83 # Returns the empty string if unknown
84 proc {info nameofexecutable} {} {
85 if {[exists ::jim::exe]} {
86 return $::jim::exe
90 # Script-based implementation of 'dict with'
91 proc {dict with} {&dictVar {args key} script} {
92 set keys {}
93 foreach {n v} [dict get $dictVar {*}$key] {
94 upvar $n var_$n
95 set var_$n $v
96 lappend keys $n
98 catch {uplevel 1 $script} msg opts
99 if {[info exists dictVar] && ([llength $key] == 0 || [dict exists $dictVar {*}$key])} {
100 foreach n $keys {
101 if {[info exists var_$n]} {
102 dict set dictVar {*}$key $n [set var_$n]
103 } else {
104 dict unset dictVar {*}$key $n
108 return {*}$opts $msg
111 # Script-based implementation of 'dict update'
112 proc {dict update} {&varName args script} {
113 set keys {}
114 foreach {n v} $args {
115 upvar $v var_$v
116 if {[dict exists $varName $n]} {
117 set var_$v [dict get $varName $n]
120 catch {uplevel 1 $script} msg opts
121 if {[info exists varName]} {
122 foreach {n v} $args {
123 if {[info exists var_$v]} {
124 dict set varName $n [set var_$v]
125 } else {
126 dict unset varName $n
130 return {*}$opts $msg
133 # Script-based implementation of 'dict merge'
134 # This won't get called in the trivial case of no args
135 proc {dict merge} {dict args} {
136 foreach d $args {
137 # Check for a valid dict
138 dict size $d
139 foreach {k v} $d {
140 dict set dict $k $v
143 return $dict
146 proc {dict replace} {dictionary {args {key value}}} {
147 if {[llength ${key value}] % 2} {
148 tailcall {dict replace}
150 tailcall dict merge $dictionary ${key value}
153 # Script-based implementation of 'dict lappend'
154 proc {dict lappend} {varName key {args value}} {
155 upvar $varName dict
156 if {[exists dict] && [dict exists $dict $key]} {
157 set list [dict get $dict $key]
159 lappend list {*}$value
160 dict set dict $key $list
163 # Script-based implementation of 'dict append'
164 proc {dict append} {varName key {args value}} {
165 upvar $varName dict
166 if {[exists dict] && [dict exists $dict $key]} {
167 set str [dict get $dict $key]
169 append str {*}$value
170 dict set dict $key $str
173 # Script-based implementation of 'dict incr'
174 proc {dict incr} {varName key {increment 1}} {
175 upvar $varName dict
176 if {[exists dict] && [dict exists $dict $key]} {
177 set value [dict get $dict $key]
179 incr value $increment
180 dict set dict $key $value
183 # Script-based implementation of 'dict remove'
184 proc {dict remove} {dictionary {args key}} {
185 foreach k $key {
186 dict unset dictionary $k
188 return $dictionary
191 # Script-based implementation of 'dict values'
192 proc {dict values} {dictionary {pattern *}} {
193 dict keys [lreverse $dictionary] $pattern
196 # Script-based implementation of 'dict for'
197 proc {dict for} {vars dictionary script} {
198 if {[llength $vars] != 2} {
199 return -code error "must have exactly two variable names"
201 dict size $dictionary
202 tailcall foreach $vars $dictionary $script