#rR gscope_basic.tcl proc TestStack {} { puts [PushOnStack Bonjour] puts [PushOnStack Ca] puts [PushOnStack va] puts [IsEmptyStack] puts [PullFromStack] puts [ValFromStack] puts [ValFromStack] puts [ValFromStack] puts [PullFromStack] puts [PullFromStack] puts [PullFromStack] puts [PullFromStack] DestroyStack exit } proc IsEmptyStack {{OtherStack ""}} { global OurCurrentStack OurStacks if {$OtherStack!=""} { set OurCurrentStack $OtherStack } if {! [info exists OurCurrentStack] || $OurCurrentStack==""} { return 1 } if { ! [info exists OurStacks($OurCurrentStack,StackHeight)]} { return 1 } set h [set OurStacks($OurCurrentStack,StackHeight)] return [expr $h==0] } proc PushOnStack {Val {OtherStack ""}} { global OurCurrentStack OurStacks if {$OtherStack!=""} { set OurCurrentStack $OtherStack } if {! [info exists OurCurrentStack] || $OurCurrentStack==""} { set OurCurrentStack [NomDe Stack] } if { ! [info exists OurStacks($OurCurrentStack,StackHeight)]} { set OurStacks($OurCurrentStack,StackHeight) 0 } set h [set OurStacks($OurCurrentStack,StackHeight)] incr h set OurStacks($OurCurrentStack,$h) $Val set OurStacks($OurCurrentStack,StackHeight) $h return $h } proc DestroyStack {{OtherStack ""}} { global OurCurrentStack OurStacks if {$OtherStack!=""} { set OurCurrentStack $OtherStack } if { ! [info exists OurCurrentStack]} { return "" } if {[info exists OurStacks($OurCurrentStack,StackHeight)]} { while { ! [IsEmptyStack]} { PullFromStack } unset OurStacks($OurCurrentStack,StackHeight) unset OurCurrentStack } } proc PullFromStack {{OtherStack ""}} { return [ValFromStack $OtherStack Pull] } proc ValFromStack {{OtherStack ""} {Pull ""}} { global OurCurrentStack OurStacks if {$OtherStack!=""} { set OurCurrentStack $OtherStack } if { ! [info exists OurCurrentStack]} { return "" } if { ! [info exists OurStacks($OurCurrentStack,StackHeight)]} { set OurStacks($OurCurrentStack,StackHeight) 0 } set h [set OurStacks($OurCurrentStack,StackHeight)] if {$h==0} { return "" } set Val [set OurStacks($OurCurrentStack,$h)] if {$Pull!=""} { set OurStacks($OurCurrentStack,StackHeight) [incr h -1]} return $Val } proc DecrValFromStack {{OtherStack ""} {ValueForIncr ""}} { if {$ValueForIncr==""} { set ValueForIncr -1 } set V [ValFromStack $OtherStack] incr V $ValueForIncr PullFromStack $OtherStack PushOnStack $V $OtherStack return $V }