Artifact
5a105a3c2406703afa6800b35e5dd9e553b40157:
Attachment "stack.tcl" to
ticket [2868499fff]
added by
dgp
2010-03-31 01:57:32.
0000: 70 72 6f 63 20 73 74 61 63 6b 20 7b 7d 20 7b 0a proc stack {} {.
0010: 20 20 20 20 73 65 74 20 6c 20 5b 69 6e 66 6f 20 set l [info
0020: 6c 65 76 65 6c 5d 0a 20 20 20 20 69 6e 63 72 20 level]. incr
0030: 6c 20 2d 31 0a 20 20 20 20 73 65 74 20 73 20 24 l -1. set s $
0040: 6c 3a 0a 20 20 20 20 77 68 69 6c 65 20 7b 24 6c l:. while {$l
0050: 7d 20 7b 0a 09 61 70 70 65 6e 64 20 73 20 5c 6e } {..append s \n
0060: 5c 74 5b 69 6e 66 6f 20 6c 65 76 65 6c 20 24 6c \t[info level $l
0070: 5d 0a 09 69 6e 63 72 20 6c 20 2d 31 0a 20 20 20 ]..incr l -1.
0080: 20 7d 0a 20 20 20 20 72 65 74 75 72 6e 20 24 73 }. return $s
0090: 0a 7d 0a 0a 73 65 74 20 6f 62 6a 20 5b 6f 6f 3a .}..set obj [oo:
00a0: 3a 6f 62 6a 65 63 74 20 6e 65 77 5d 0a 6f 6f 3a :object new].oo:
00b0: 3a 6f 62 6a 64 65 66 69 6e 65 20 24 6f 62 6a 20 :objdefine $obj
00c0: 7b 0a 20 20 20 20 6d 65 74 68 6f 64 20 34 61 20 {. method 4a
00d0: 7b 7d 20 7b 0a 09 70 75 74 73 20 5b 73 74 61 63 {} {..puts [stac
00e0: 6b 5d 0a 09 75 70 6c 65 76 65 6c 20 31 20 5b 6c k]..uplevel 1 [l
00f0: 69 73 74 20 5b 73 65 6c 66 5d 20 34 62 5d 0a 20 ist [self] 4b].
0100: 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 }. method
0110: 34 62 20 7b 7d 20 7b 0a 09 70 75 74 73 20 5b 73 4b {} {..puts [s
0120: 74 61 63 6b 5d 0a 09 6d 79 20 35 61 0a 20 20 20 tack]..my 5a.
0130: 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 35 61 }. method 5a
0140: 20 7b 7d 20 7b 0a 09 70 75 74 73 20 5b 73 74 61 {} {..puts [sta
0150: 63 6b 5d 0a 09 75 70 6c 65 76 65 6c 20 31 20 6d ck]..uplevel 1 m
0160: 79 20 35 62 0a 20 20 20 20 7d 0a 20 20 20 20 6d y 5b. }. m
0170: 65 74 68 6f 64 20 35 62 20 7b 7d 20 7b 0a 09 70 ethod 5b {} {..p
0180: 75 74 73 20 5b 73 74 61 63 6b 5d 0a 09 75 70 6c uts [stack]..upl
0190: 65 76 65 6c 20 23 30 20 7b 0a 09 20 20 20 20 6f evel #0 {.. o
01a0: 6f 3a 3a 6f 62 6a 64 65 66 69 6e 65 20 5b 6f 6f o::objdefine [oo
01b0: 3a 3a 6f 62 6a 65 63 74 20 6e 65 77 5d 20 7b 0a ::object new] {.
01c0: 09 09 70 75 74 73 20 5b 73 74 61 63 6b 5d 0a 09 ..puts [stack]..
01d0: 09 65 72 72 6f 72 20 21 0a 09 20 20 20 20 7d 0a .error !.. }.
01e0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 65 78 70 .}. }. exp
01f0: 6f 72 74 20 34 61 20 34 62 0a 7d 0a 0a 70 72 6f ort 4a 4b.}..pro
0200: 63 20 33 63 20 7b 7d 20 7b 0a 20 20 20 20 75 70 c 3c {} {. up
0210: 6c 65 76 65 6c 20 31 20 7b 70 75 74 73 20 5b 73 level 1 {puts [s
0220: 74 61 63 6b 5d 7d 0a 20 20 20 20 70 75 74 73 20 tack]}. puts
0230: 5b 73 74 61 63 6b 5d 0a 20 20 20 20 24 3a 3a 6f [stack]. $::o
0240: 62 6a 20 34 61 0a 7d 0a 69 6e 74 65 72 70 20 68 bj 4a.}.interp h
0250: 69 64 65 20 7b 7d 20 33 63 0a 0a 70 72 6f 63 20 ide {} 3c..proc
0260: 31 61 20 7b 7d 20 7b 0a 20 20 20 20 70 75 74 73 1a {} {. puts
0270: 20 5b 73 74 61 63 6b 5d 0a 20 20 20 20 32 61 0a [stack]. 2a.
0280: 7d 0a 70 72 6f 63 20 32 61 20 7b 7d 20 7b 0a 20 }.proc 2a {} {.
0290: 20 20 20 70 75 74 73 20 5b 73 74 61 63 6b 5d 0a puts [stack].
02a0: 20 20 20 20 61 70 70 6c 79 20 7b 7b 7d 20 7b 0a apply {{} {.
02b0: 09 20 20 20 20 70 75 74 73 20 5b 73 74 61 63 6b . puts [stack
02c0: 5d 0a 09 20 20 20 20 75 70 6c 65 76 65 6c 20 31 ].. uplevel 1
02d0: 20 33 62 0a 20 20 20 20 7d 7d 0a 7d 0a 70 72 6f 3b. }}.}.pro
02e0: 63 20 33 62 20 7b 7d 20 7b 0a 20 20 20 20 70 75 c 3b {} {. pu
02f0: 74 73 20 5b 73 74 61 63 6b 5d 0a 20 20 20 20 75 ts [stack]. u
0300: 70 6c 65 76 65 6c 20 32 20 7b 0a 09 6e 61 6d 65 plevel 2 {..name
0310: 73 70 61 63 65 20 65 76 61 6c 20 32 62 20 7b 0a space eval 2b {.
0320: 09 09 70 75 74 73 20 5b 3a 3a 73 74 61 63 6b 5d ..puts [::stack]
0330: 0a 09 09 75 70 6c 65 76 65 6c 20 23 30 20 31 62 ...uplevel #0 1b
0340: 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 70 72 6f 63 ..}. }.}.proc
0350: 20 31 62 20 7b 7d 20 7b 0a 20 20 20 20 70 75 74 1b {} {. put
0360: 73 20 5b 73 74 61 63 6b 5d 0a 20 20 20 20 69 6e s [stack]. in
0370: 74 65 72 70 20 69 6e 76 6f 6b 65 68 69 64 64 65 terp invokehidde
0380: 6e 20 7b 7d 20 2d 6e 61 6d 65 73 70 61 63 65 20 n {} -namespace
0390: 3a 3a 20 33 63 0a 7d 0a 63 61 74 63 68 20 31 61 :: 3c.}.catch 1a
03a0: 20 6d 20 6f 0a 70 75 74 73 20 45 49 3a 5b 64 69 m o.puts EI:[di
03b0: 63 74 20 67 65 74 20 24 6f 20 2d 65 72 72 6f 72 ct get $o -error
03c0: 69 6e 66 6f 5d 5c 6e 0a 70 75 74 73 20 2d 6e 6f info]\n.puts -no
03d0: 6e 65 77 6c 69 6e 65 20 45 53 3a 0a 66 6f 72 65 newline ES:.fore
03e0: 61 63 68 20 7b 74 6f 6b 65 6e 20 76 61 6c 75 65 ach {token value
03f0: 7d 20 5b 64 69 63 74 20 67 65 74 20 24 6f 20 2d } [dict get $o -
0400: 65 72 72 6f 72 73 74 61 63 6b 5d 20 7b 0a 20 20 errorstack] {.
0410: 20 20 70 75 74 73 20 5b 6c 69 73 74 20 24 74 6f puts [list $to
0420: 6b 65 6e 20 24 76 61 6c 75 65 5d 0a 7d 0a 0a ken $value].}..
