source tiny_basic_RS.tcl
     basic { 10 n=2/7. : 20 print n} ;# returns 0.2857
     basic { 10 n=[/ 2 7. ]: 20 print n} ;# returns 0.2857
     basic { 10 n={2/ 7.}: 20 print n}: 20 print n}  :# returns 0.2857 
     # basic { 10 n=[ expr {2/ 7.} ] : 20 print n} ;#
     # tiny_basic_RS.tcl not invoking expr & regexp smoothly
     # keeper     string map {\{ "" \} ""} $item

        # Title: tiny_basic_RS in TCL V2
        # partial basic language interpreter tiny_basic_RS
        # demo basic from RS, (wiki 2000-08-21)
        # Original program  by Richard Suchenwirth on TCL WIKI
        # wiki page titled Basic in TCL
        # Reorganized code from, https://wiki.tcl-lang.org/915
        # for green screens, print,  and self_help
        # to tcl console.
        # search keywords < tiny basic 1976 >
        # written on Windows 10 on TCL
        # working under TCL version 8.6
        # on TCL Club , 20Sep2020
        # added statements for TCLLIB library
        package require math::numtheory
        package require math::constants
        package require math::trig
        package require math
        namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory math::trig math::constants }
        # Tried to keep clean RS  code in upper section
        # added extension for console presentation  below.
        # added simpler sugar for expr Sarnold 2005-11-10
        # wiki page >> let - a simpler sugar for expr
        global a b c d e f g h i j k l m n o p q r s t u v w x y z
        global A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
        #begin Sarnold 2005-11-10 code
        proc let {varname assign args} {
            # author Sarnold 2005-11-10
            global a b c d e f g h i j k l m n o p q r s t u v w x y z
            global A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
            upvar $varname leftvalue
            if {[llength $args]==1} {
                set args [lindex $args 0]
            }
            set args [uplevel expr $args]
            switch -exact -- $assign {
                += {set leftvalue [expr {$leftvalue+$args}]}
                -= {set leftvalue [expr {$leftvalue-$args}]}
                *= {set leftvalue [expr {$leftvalue*$args}]}
                /= {set leftvalue [expr {$leftvalue/$args}]}
                %= {set leftvalue [expr {$leftvalue%$args}]}
                =  {set leftvalue $args}
                # author Sarnold 2005-11-10
                default {error "invalid syntax : second argument is not an assignment"}
            }
            return $leftvalue
        }
        # begin RS code
           # One liners program 
           # basic style let in one line
           proc let2 {_var expr} {upvar 1 $_var var;set var [uplevel 1 [list expr $expr]] } ;# RS
           #Usage let a {999999} ; puts $a
        proc lpush {_list what} {
            upvar $_list L
            if ![info exists L] {set L {}}
            set L [concat [list $what] $L]
        }
        proc lpop {_list} {
            upvar $_list L
            if ![info exists L] {return ""}
            set t [lindex $L 0]
            set L [lrange $L 1 end]
            return $t
        }
        proc intgen {{seed 0}} {
            set self [lindex [info level 0] 0]
            proc $self "{seed [incr seed]}" [info body $self]
            set seed
        } ;# RS
        proc basic {script} {
            global a b c d e f g h i j k l m n o p q r s t u v w x y z
            global A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
            # old BASIC had 26 numeric variables..
            foreach i {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
                set $i 0
            }
            set states ""
            set Stack [list Error:Stack]
            foreach line [split [string toupper $script] \n] {
                if [regexp { *([0-9]+) +(.+)} $line -> label rest] {
                    set outline ""
                    foreach stmt [split $rest :] {
                        set step 1
                        if [regexp { ?('|REM)} $stmt] {
                            # start extension for console
                            # wish to print all comments
                            puts $stmt
                            break ;# no statements to be expected after comment
                        } elseif [regexp { ?('|PRINT_TXT)} $stmt] {
                            # wish to print specific text
                            puts $stmt
                            break ;# no statements to be expected
                            # insert extension code here
                        } elseif [regexp {PRINT +(.+)} $stmt -> what] {
                            regsub -all ", *" $what "\t" what
                            regsub -all "; *" $what " " what
                            regsub -all {([A-Z])} $what {$\1} what
                            append outline "puts \"$what\"; "
                        } elseif [regexp {FOR +([A-Z]) *= *(.+) TO (.+)( STEP (.+))?} \
                                $stmt -> looper from to - step] {
                                    regsub -all {([A-Z])} $from {$\1} from
                                    regsub -all {([A-Z])} $to {$\1} to
                                    set here -[intgen]
                                    set step 1 ;# to start with
                                    set next($looper) "incr $looper $step; if {\$$looper<=$to} {goto $here}"
                                    append outline "set $looper $from\}\n$here \{"
                                } elseif [regexp {NEXT (.+)} $stmt -> id] {
                                    append outline $next($id)
                                    unset next($id)
                                } elseif [regexp {IF +([^ ]+) +(THEN|GOTO) +([0-9]+)}\
                                $stmt -> cond - goto] {
                                    regsub -all {([A-Z])} $cond {$\1} cond
                                    append outline "if {$cond} {goto $goto}; "
                                } elseif [regexp {ON (.+) GOTO +(.+)} $stmt -> cond labels] {
                                    regsub -all {([A-Z])} $cond {$\1} cond
                                    append outline "goto \[lindex \{- [split $labels ,]\} \[expr $cond\]\]; "
                                } elseif [regexp {GO *TO ([0-9]+)} $stmt -> id] {
                                    append outline "goto $id; "
                                } elseif [regexp {GO *SUB ([0-9]+)} $stmt -> id] {
                                    set here -[intgen]
                                    append outline "lpush Stack $here; goto $id\}\n$here \{ "
                                } elseif [regexp {RETURN} $stmt] {
                                    append outline "goto \[lpop Stack\]; "
                                } elseif [regexp { *END} $stmt] {
                                    append outline "break; "
                                } elseif [regexp {([A-Z])=(.+)} $stmt -> lhs rhs] {
                                    regsub -all {([A-Z])} $rhs {$\1} rhs
                                    append outline "set $lhs \[expr $rhs\]; "
                                }
                    }
                    append states "$label {$outline}\n"
                }
            }
            states $states
        } ;#RS
        proc states body {
            proc goto {id} {uplevel set goto $id; return -code continue}
            uplevel set goto [lindex $body 0]
            set tmp [lindex $body 0]
            foreach {cmd label} [lrange $body 1 end] {
                if {$label==""} {set label default}
                lappend tmp "$cmd; goto [list $label]" $label
            }
            lappend tmp break ;# to match last "default" label
            uplevel while 1 "{switch -- \$goto [list $tmp]}"
            rename goto ""
        } ;#RS
        basic {
            100 J=1:K=1
            110 GOSUB 300
            120 PRINT I,J;K
            130 IF I<5 GOTO 110: REM DONE
            135 for a=100 to J+103
            137    print a
            140 next a
            150 END
            300 REM---------- slight increment
            310 I=I+J: K=K*2
            320 RETURN
        }
        # end of RS deck
        # add cosmetics below to bottom of file or source tiny_basic_RS.tcl
        # added statements above for TCLLIB library
        console show
        console eval {.console config -bg palegreen}
        console eval {.console config -font {fixed 20 bold}}
        console eval {wm geometry . 40x20}
        console eval {wm title . "tiny_basic_RS in TCL , screen grab and paste from console  to texteditor"}
        console eval {. configure -background orange -highlightcolor brown -relief raised -border 30}
        console eval { proc self_helpx {} {
                set msg "tiny_basic_RS in TCL, large black type on green
                from TCL,
                self help listing
                Conventional text editor formulas grabbed
                from internet screens can be pasted
                into green console
                colon is statement end
                # test statements for mixed tiny_basic_RS w/ TCL (let proc)
                # demo program tiny_basic_RS
                basic {
                    100 J=1:K=1
                    110 GOSUB 300
                    120 PRINT I,J;K
                    130 IF I<5 GOTO 110: REM DONE
                    135 for a=100 to J+103
                    137    print a
                    140 next a
                    150 END
                    300 REM---------- slight increment
                    310 I=I+J: K=K*2
                    320 RETURN
                }
                # basic { 10 N=[ expr {2/ 7.} ] : 20 print N} ;#
                # tiny_basic_RS.tcl not invoking expr smooth
                # demo tiny_basic from RS, (wiki 2000-08-21) "
                tk_messageBox -title "self_helpxx" -message $msg } }
        console eval {.menubar.help add command -label Self_help -command self_helpx }
        # proc basic here is a second program or set of commands
        basic {
            50 REM user on tiny_basic_RS, TCL 8.6
            70 REM math ops and proc let from TCL is loaded
            80 REM mixed tiny_basic_RS w/ TCL (let proc)
            100 a=1.
            137 print a
            140 b=  [* 5 6 ]
            150 print b
            160 c= [/ 5 7. ]
            170 print c
            175 REM PRINTING D
            180 d=5*5
            200 print d
            250 print [* 5 7 ]
            300 REM wish to print all REM strings
            315 PRINT_TXT user on TCL 8.6
            318 PRINT_TXT  [* 5 6 ]
            340 REM wish to use expr math
            350 EXPR  { 2*7 }
            400 RETURN
        }
        puts " returns to TCL 8.6  for check 5*6 = [* 5 6 ]"      

                             # begin extension for console, marked in above deck.
                             # need smoother invoking of expr and regexp assignment
                             # into the <tiny_basic_RS>.
                             # would not mind a alternate assignment ==
                         } elseif [regexp { ?('|EXPR)} $stmt]  { 
                             # wish eval content to expr
                             # $w move [$w find withtag "$tilex"] [expr {$x-$p(X)}] [expr {$y-$p(Y)}]
                             #set numberx [$w  gettags current]
                             #regexp {obj_(\d+)} $numberx -> tilex
                             puts " trick1   \[expr $stmt \] \[expr {[lindex [split $stmt ] 3 ]}\]" ;
                             puts " trick2  [expr   [expr {[lindex [split $stmt ] 3 ]} ]]" ;
                             puts " trick3    [expr {[lindex [split $stmt ] 3 ]} ] " ;
                             set tilex 7777;
                             regexp {EXPR(\a+)} $stmt -> tilex;
                            puts  $tilex;
                            break ;# no statements to be expected
                            # end extension for console. 

     source tiny_basic_RS.tcl
     basic { 10 n=2/7. : 20 print n} ;# returns 0.2857
     basic { 10 n=[/ 2 7. ]: 20 print n} ;# returns 0.2857
     basic { 10 n={2/ 7.}: 20 print n}: 20 print n}  :# returns 0.2857