;# Title: Little_Math_Language_AM V2 in TCL
        ;# console extension to little_math_language
        ;# proc mathlang.tcl from AM, (original on tcl wiki 05-21-2004)
        ;# proc test code from RS
        ;# ref A little math language revisited, page on TCL Wiki
        ;# A little math language, page on TCL Wiki
        ;# Richard Suchenwirth 2002-01-02
        ;# Original program  by Arjen Markus on TCL Wiki
        ;# Reorganized code
        ;# for print and self_help
        ;# to tcl console.
        ;# written on Windows 10 on TCL
        ;# working under TCL version 8.6
        ;# on TCL WIKI , 20Oct2020
        ;# 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 AM  code in upper section
        ;# added extension to console below. -gold
        ;# mathlang.tcl --
        ;#    Provide commands that allow a more usual mathematical syntax:
        ;#
        ;#    mathfunc {x} {
        ;#       sinc = sin(x)/x if x != 0
        ;#       sinc = 0        otherwise
        ;#    }
        ;#    math {
        ;#       a = x*x + y*y
        ;#    }
        ;#
        ;#    Still to do: mathfunc
        ;#
        ;# (7 july 2004) Small improvement:
        ;#               recognise array elements
        ;#
        namespace eval ::mathsyntax {
            namespace export math
            variable cached_calcs {}
            variable func_names \
                    {abs acos asin atan atan2 ceil cos cosh double
                        exp floor fmod hypot int log log10 pow rand round
                        sin sinh sqrt srand tan tanh wide}
        }
        ;# ToExpr --
        ;#    Transform an expression to the form expr wants
        ;# Arguments:
        ;#    expression     A right-hand side of an assignment
        ;# Result:
        ;#    Valid Tcl expression
        ;#
        proc ::mathsyntax::ToExpr { expression } {
            variable func_names
            set rhs [string map {" " ""} $expression]
            set indices [regexp -inline -all -indices {[a-zA-Z][a-zA-Z0-9_]*} $rhs]
            set offset 0
            foreach idx $indices {
                foreach {start stop} $idx {break}
                set start [expr {$start+$offset}]
                set stop  [expr {$stop+$offset}]
                set next  [expr {$stop+1}]
                if { [string index $rhs $next] != "(" } {
                    set char [string index $rhs $start]
                    set rhs  [string replace $rhs $start $start "\$$char" ]
                    incr offset
                } else {
                    set char [string index $rhs $start]
                    set name [string range $rhs $start $stop]
                    if { [lsearch $func_names $name] < 0 } {
                        set rhs  [string replace $rhs $start $start "\$$char" ]
                    }
                }
            }
            return $rhs
        }
        ;# Transform --
        ;#    Transform a series of mathematical expressions into Tcl code
        ;# Arguments:
        ;#    id         ID to use
        ;#    calc       One or more mathematical assignments
        ;# Result:
        ;#    None
        ;# Side effects:
        ;#    A private procedure is created
        ;# Note:
        ;#    No conditions yet
        ;#
        proc ::mathsyntax::Transform { id calc } {
            set calc [split $calc "\n"]
            set body {"uplevel 2 \{"}
            foreach assign $calc {
                set assign [string trim $assign]
                if { $assign != "" } {
                    regexp {([a-zA-Z][a-zA-Z0-9_()]*) *= *(.*)} $assign ==> lhs rhsfull
                    ;#
                    ;# Is there a condition?
                    ;#
                    set cond1 [string first " if"        $rhsfull]
                    ;# PM: set cond2 [string first " otherwise" $rhsfull]
                    set cond  ""
                    if { $cond1 > 0 } {
                        set rhs  [string range $rhsfull 0 [expr {$cond1-1}]]
                        set cond [string range $rhsfull [expr {$cond1+3}] end]
                        lappend body "if { [ToExpr $cond] } \{"
                    } else {
                        set rhs $rhsfull
                    }
                    ;# If the left-hand side refers to an array element,
                    ;# we need to add a dollar-sign
                    ;#
                    set lhs [string map {"(" "($"} $lhs]
                    ;#
                    ;# Prepare the assignment
                    ;#
                    set rhs [ToExpr $rhs]
                    lappend body "set $lhs \[expr {$rhs}\]"
                    if { $cond != "" } {
                        lappend body "\}"
                    }
                }
            }
            lappend body "\}"
            proc Cached$id {} [join $body "\n"]
        }
        ;# math --
        ;#    Allow mathematical expressions inside Tcl code
        ;# Arguments:
        ;#    calc       One or more mathematical assignments
        ;# Result:
        ;#    None
        ;# Side effects:
        ;#    As the code is executed in the caller's scope, variables
        ;#    in the calling procedure are set
        ;#    The code is transformed into a procedure that is cached
        ;#
        proc ::mathsyntax::math { calc } {
            variable cached_calcs
            set id [lsearch $cached_calcs $calc]
            if { $id < 0 } {
                lappend cached_calcs $calc
                set id [expr {[llength $cached_calcs]-1}]
                Transform $id $calc
            }
            ::mathsyntax::Cached$id
        }
        ;#
        ;# Simple test
        ;#
        if {0} {
            namespace import ::mathsyntax::math
            set a 1
            set b 1
            set c ""
            set d ""
            set sinc ""
            math {
                c = a + b
                d = a + cos(b+c)
            }
            puts "$c $d"
            for {set i 0} {$i < 20} {incr i} {
                math {
                    x = 0.1*i
                    sinc = 1 if x == 0
                    sinc = sin(x)/x if x != 0
                    y(i) = sinc*sinc
                }
                puts "$i $x $sinc $y($i)"
            }
            ;#
            ;# Just to check
            ;#
            parray y  }
        ;# end of AM deck
        ;# add cosmetics below to bottom of file
        ;#  or source Little_Math_Language_AM
        ;# added statements above for TCLLIB library
        proc test args {
            foreach {case expected}  $args  {
                catch {uplevel 1 $case} res  ;# RS
                if {$res != $expected} {error "$case->$res, expected $expected"}
                puts "example >>  $case -> $res, & expected was $expected"
                ;# res ,  expected, variables  were not recycling ???
                ;# proc test is RS code from TCL Wiki
            }
        }
        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 . "Little_Math_Language_AM 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 "Little_Math_Language_AM,
                large black type on green
                from TCL,
                self help listing
                ;# Conventional text editor formulas grabbed
                ;# from internet screens can be pasted
                ;# into green screen console
                ;# colon is statement end
                ;# proc test code from RS
                ;# ref A little math language revisited, page on TCL Wiki
                ;# Original program  by Arjen Markus on TCL Wiki
                ;# Reorganized code from
                ;# for print and self_help
                ;# to tcl console.
                ;# mathlang.tcl from AM, (original on tcl wiki 05-21-2004) "
                tk_messageBox -title "self_helpxx" -message $msg } }
        console eval {.menubar.help add command -label Self_help -command self_helpx }
        proc basic_alphabet_variables {} {
            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
            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 1
            }
            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 1
            } }
        proc demo {} {
            puts " demo "
            namespace import ::mathsyntax::math
            ;# set lower & upper case global alphabet_variables to 1
            basic_alphabet_variables
            set a 1
            set b 1
            set c ""
            set d ""
            set sinc ""
            math {
                c = a + b
                d = a + cos(b+c)
            }
            puts "$c $d"
            for {set i 0} {$i < 20} {incr i} {
                math {
                    x = 0.1*i
                    sinc = 1 if x == 0
                    sinc = sin(x)/x if x != 0
                    y(i) = sinc*sinc
                }
                puts "$i $x $sinc $y($i)"
            }
            ;#
            ;#
            parray y
            puts " returns to TCL 8.6  for check   = [exp 5 ]"
            puts "  set a 1 , set b 1 , set c 1 & <c d sinc strings nulled> "
            puts "math c = a + b ; d = a + cos(b+c), puts c d "
            puts "$c $d"
            test { isprime 7 } 1
            test { + 1 1     } 2
            test { - 10 1    } 9
            test { * 10 1    } 10
            test { / 10 2    } 5
            test { math { a = 10 / 2 } } 5
            test { math { b = 10. / 2 } } 5.
            test { math { c = 10. / 2. } } 5.
            test { math { d = 1 + 1  } } 2
            test { math { e = 10 - 1 } } 9
            test { math { f = 10 * 1 } } 10
            test { math { g = 10 / 2 } } 5
            test { math { h = 10 ** 2 } } 100
            test { math { i = 10 % 2 } }   0
            test { math { i = 3 * 4 / 2 } }   6
            test { math { i = (3>2) } }  1
            test { math { i = (3<2) } }  0
        }
        demo
        # end of file