further opts

lttb.tcl

@@ -45,6 +45,7 @@ proc lttb_exec {pline} {
 
 # Integer number normalizer (for TB-valid signed 16-bit range)
 proc lttb_norm {num} {
+  if {$num eq {}} {return 0}
   set num $(int($num))
   if {($num > 32767) || ($num < -32768)} {
     set num $($num % 65536)
@@ -65,85 +66,73 @@ proc _lpop {list_var} {
   return $val
 }
 
-# Tiny BASIC expression evaluator (two-pass)
+# Simple evaluation helper
+proc eval_helper {vsvar osvar} {
+  upvar $vsvar valstack
+  upvar $osvar opstack
+  set res 0
+  set op [_lpop opstack]
+  set v2 [_lpop valstack]
+  set v1 [_lpop valstack]
+  switch -exact -- $op {
+    {$} { set res [rand 0 $(($v2 + 32768) % 32768)] }
+    {+} { set res $($v1 + $v2) }
+    {-} { set res $($v1 - $v2) }
+    {*} { set res $($v1 * $v2) }
+    {/} { if {$v2 != 0} {set res $(int($v1 / $v2))} }
+    default { error "Unknown operator: $op" }
+  }
+  lappend valstack [lttb_norm $res]
+}
+
+# Tiny BASIC expression evaluator (single-pass)
 proc lttb_eval {lttb_ex} {
+  global vars
   # pre-checks
   set lttb_ex [string trim $lttb_ex]
   if {$lttb_ex eq {}} {return 0}
   if {[string is digit $lttb_ex]} {return [lttb_norm $(int($lttb_ex))]}
-  # pass 1: variable and parentheses substitution
-  global vars
-  regsub -all -nocase -- {RND} $lttb_ex {0$} lttb_ex
-  lassign {{(((} {}} pre_ex prevc
-  foreach c [split $lttb_ex {}] {
-    set outc {}
-    if {[string is digit $c] || $c eq {$}} {set outc $c}
-    if {[string is upper $c]} {set outc $vars($c)}
-    if {$c eq "("} {set outc {(((}}
-    if {$c eq ")"} {set outc {)))}}
-    if {$c eq "*" || $c eq "/"} {set outc [string cat {)} $c {(}]}
-    if {$c eq "+" || $c eq "-"} {
-      if {$prevc in {{} ( + -}} {
-        set outc [string cat 0 $c]
-      } else {set outc [string cat {))} $c {((}] }
-    }
-    append pre_ex $outc
-    set prevc $c
-  }
-  append pre_ex {)))}
-  # pass 2: two-stack LTR evaluator
-  local proc eval_helper {vsvar osvar} {
-    upvar $vsvar valstack
-    upvar $osvar opstack
-    set res 0
-    set op [_lpop opstack]
-    set v2 [_lpop valstack]
-    set v1 [_lpop valstack]
-    switch -exact -- $op {
-      {$} { set res [rand 0 $(($v2 + 32768) % 32768)] }
-      {+} { set res $($v1 + $v2) }
-      {-} { set res $($v1 - $v2) }
-      {*} { set res $($v1 * $v2) }
-      {/} { if {$v2 != 0} {set res $(int($v1 / $v2))} }
-      default { error "Unknown operator: $op" }
-    }
-    lappend valstack [lttb_norm $res]
-  }
-  lassign {{} {} {}} valbuf valstack opstack
-  set precmap {+ 1 - 1 * 2 / 2 $ 3}
-  foreach c [split $pre_ex {}] {
-    if {[string is space $c]} {continue}
-    if {[string is digit $c]} {
+  lassign {{( 0 + 1 - 1 * 2 / 2 $ 3} {} {} {} {} 0} precmap valbuf prevc valstack opstack i
+  set l [string length $lttb_ex]
+  loop i 0 $l {
+    set c [string index $lttb_ex $i]
+    if [string is space $c] {continue}
+    if [string is digit $c] {
       append valbuf $c
     } else {
-      if {[string length $valbuf] > 0} {
-        lappend valstack $(int($valbuf))
+      if {$valbuf ne {}} {
+        lappend valstack [lttb_norm $valbuf]
         set valbuf {}
       }
-      if {$c eq {(}} {
+      if {[string range $lttb_ex $i $($i+2)] eq {RND}} {
+        lappend valstack 0
+        set c {$}
+        incr i 2
+      } elseif {[string is upper $c]} {
+        lappend valstack [lttb_norm $vars($c)]
+      } elseif {$c eq {(}} {
         lappend opstack $c
       } elseif {$c eq {)}} {
-        while {[llength $opstack] > 0 && [lindex $opstack end] ne "("} {
+        while {[llength $opstack] > 0 && [lindex $opstack end] ne {(}} {
           eval_helper valstack opstack
         }
-        if {[lindex $opstack end] eq "("} {_lpop opstack}
-      } elseif {$c in {+ - * / $}} {
-        set prec $precmap($c)
-        while {[llength $opstack] > 0} {
-          set top_op [lindex $opstack end]
-          if {$top_op eq "("} { break }
-          if {$precmap($top_op) >= $prec} {
-            eval_helper valstack opstack
-          } else { break }
+        if {[lindex $opstack end] eq {(}} {_lpop opstack}
+      }
+      if {$c in {+ - * / $}} {
+        if {$c in {+ -} && $prevc in {{} ( + - * / $}} {
+          lappend valstack 0
+        }
+        while {[llength $opstack] > 0 && $precmap([lindex $opstack end]) >= $precmap($c) } {
+          eval_helper valstack opstack
         }
         lappend opstack $c
       }
     }
+    set prevc $c
   }
+  if {$valbuf ne {}} {lappend valstack [lttb_norm $valbuf]}
   while {[llength $opstack] > 0} {eval_helper valstack opstack}
-  set res [lindex $valstack 0]
-  if {$res eq {}} {set res 0}
-  return $res
+  return [lttb_norm [lindex $valstack 0]]
 }
 
 # Tiny BASIC routines implementing various commands