Author Topic: Numeric/String Eval function (Read 6096 times)

Ed Davis · « **on:** February 25, 2021, 01:24:12 pm »

Numeric/String Eval function, supports all QBasic operators, as well as
selected numeric and string functions, and numeric and string variables and
assignment.

String functions:
chr$ date$ hex$ lcase$ left$ ltrim$ mid$ right$ rtrim$ space$ str$ string$ time$
trim$ ucase$

Numeric functions:
abs atan cos exp fix int len log rnd sgn sin sqr tan val

Simple to add additional single parameter functions
Just a little busy work to add multiple parameter functions

Compiles with QB64 and FreeBasic (-lang qb).

Precedence - highest to lowest:
^
unary -, +
*, /
\
mod
+, -
=, <>, <, >, <=, >=
unary not
and
or
xor
eqv
imp

Example usage:

a$ = "abs(1+2*3+(5-1) + sin(42))"
print eval$(a$)

To Create variables:

a$ = "num1 = 42"
print eval$(a$)

a$ = "st1$ = " + chr$(34) + "hello" + chr$(34)
print eval$(a$)

Code: QB64: [Select]

'Numeric/String Eval function, supports all QBasic operators, as well as
' selected numeric and string functions, and numeric and string variables and
' assignment.
'
'String functions:
'chr$ date$ hex$ lcase$ left$ ltrim$ mid$ right$ rtrim$ space$ str$ string$ time$
'trim$ ucase$
'
'Numeric functions:
'abs atan cos exp fix int len log rnd sgn sin sqr tan val
'
'Simple to add additional single parameter functions
'Just a little busy work to add multiple parameter functions
'
'Compiles with QB64 and FreeBasic (-lang qb).
'
'Precedence - highest to lowest:
' ^
' unary -, +
' *, /
' \
' mod
' +, -
' =, <>, <, >, <=, >=
' unary not
' and
' or
' xor
' eqv
' imp
'
'Example usage:
'
'a$ = "abs(1+2*3+(5-1) + sin(42))"
'print eval$(a$)
'
'To Create variables:
'
'a$ = "num1 = 42"
'print eval$(a$)
'
'a$ = "st1$ = " + CHR$(34) + "hello" + CHR$(34)
'print eval$(a$)
'
'Written by Ed Davis.  Contact: ed_davis2 at that yahoo place.
'Use at your own risk.
 
option _explicit ' underscore in QB64; none in FreeBasic.
 
declare function eval$(userstr as string)
declare function numeric_expr#(p as integer, userstr as string, sym as string)
declare function str_expr$(userstr as string, sym as string)
' required for FreeBasic, not for QB64
declare sub store_numeric_var(vname as string, nvalue as double)
 
dim userstr as string
 
$console
$screenhide
_dest _console
 
' code for running unit tests
if command$(1) = "-t" then
    dim cmds(500) as string, i as integer, fname as string, n as integer
    fname = ltrim$(rtrim$(mid$(command$, 4)))
 
    i = 0
    open fname for input as 1
    while not eof(1)
        i = i + 1
        line input #1, cmds(i)
    wend
    n = i
    if ltrim$(cmds(n)) = "" then n = n - 1
    for i = 1 to n
        print eval$(cmds(i))
    next
    system
end if
 
' some test variables
call store_string_var("s1$", "first")
call store_string_var("s2$", "last")
 
call store_numeric_var("n1", 42)
call store_numeric_var("n2", 86)
 
call help
do
    line input "Enter expression: ", userstr
    select case userstr
        case "list":  call dump_tables
        case "help":  call help
        case "cls":   cls
             case "": exit do
        case else
            print eval$(userstr)
    end select
loop
 
const rightassoc=0, leftassoc=1
const tyunknown=0,tystring=1,tynum=2
 
const max_store=256
 
type names_t
    vname    as string
    index   as integer
end type
 
' used by expression parser
dim shared str_stack(1 to max_store) as string
dim shared num_stack(1 to max_store) as double
dim shared str_stk_ndx as integer, num_stk_ndx as integer
 
' variable store
dim shared string_store(1 to max_store) as string
dim shared numeric_store(1 to max_store) as double
dim shared var_names(1 to max_store) as names_t
dim shared str_store_ndx as integer, num_store_ndx as integer, var_names_ndx as integer
 
sub help
    print
    print "Eval function, supports string and numeric variables and assignment"
    print "All QBasic operators are supported"
    print
    print "String functions:"
    print "chr$ date$ hex$ lcase$ left$ ltrim$ mid$ right$ rtrim$ space$ str$ string$ time$"
    print "trim$ ucase$"
    print
    print "Numeric functions:"
    print "abs atan cos exp fix int len log rnd sgn sin sqr tan val"
    print
    print "cls  -- clear the screen"
    print "help -- this screen"
    print "list -- list assigned variables"
    print
end sub
 
sub dump_tables
    dim i as integer
 
    print "Variables: "; var_names_ndx
    for i = 1 to var_names_ndx
        print var_names(i).vname, " index: "; var_names(i).index;
        if right$(var_names(i).vname, 1) = "$" then
            print string_store(var_names(i).index)
        else
            print numeric_store(var_names(i).index)
        end if
    next
 
    print "String store: "; str_store_ndx
    for i = 1 to str_store_ndx
        print i, string_store(i)
    next
 
    print "Numeric store: "; num_store_ndx
    for i = 1 to num_store_ndx
        print i, numeric_store(i)
    next
end sub
 
' get the value of a string variable
function get_string_var$(vname as string)
    dim i as integer
 
    for i = 1 to var_names_ndx
        if var_names(i).vname = vname then
            get_string_var$ = string_store(var_names(i).index)
            exit function
        end if
    next
    get_string_var$ = ""
end function
 
' get the value of a numeric variable
function get_numeric_var#(vname as string)
    dim i as integer
 
    for i = 1 to var_names_ndx
        if var_names(i).vname = vname then
            get_numeric_var# = numeric_store(var_names(i).index)
            'print "get_numeric_var vname at: "; i; " data at: "; var_names(i).index; " data: "; numeric_store(var_names(i).index)
            exit function
        end if
    next
    get_numeric_var# = 0
end function
 
' Create or update a string variable
sub store_string_var(vname as string, svalue as string)
    dim i as integer
 
    for i = 1 to var_names_ndx
        if var_names(i).vname = vname then
            string_store(var_names(i).index) = svalue
            exit sub
        end if
    next
 
    str_store_ndx = str_store_ndx + 1
    var_names_ndx = var_names_ndx + 1
    var_names(var_names_ndx).vname = vname
    var_names(var_names_ndx).index = str_store_ndx
    string_store(str_store_ndx) = svalue
end sub
 
' Create or update a numeric variable
sub store_numeric_var(vname as string, nvalue as double)
    dim i as integer
 
    for i = 1 to var_names_ndx
        if var_names(i).vname = vname then
            numeric_store(var_names(i).index) = nvalue
            exit sub
        end if
    next
 
    num_store_ndx = num_store_ndx + 1
    var_names_ndx = var_names_ndx + 1
    var_names(var_names_ndx).vname = vname
    var_names(var_names_ndx).index = num_store_ndx
    numeric_store(num_store_ndx) = nvalue
    'print "store_numeric_var value: "; nvalue; " stored at: "; num_store_ndx
end sub
 
' lexical analyzer functions
 
function isdigit%(ch as string)
    isdigit% = left$(ch, 1) >= "0" and left$(ch, 1) <= "9"
end function
 
function isnumeric%(ch as string)
    isnumeric% = isdigit(ch) or left$(ch, 1) = "."
end function
 
function isalpha%(ch as string)
    isalpha% = lcase$(left$(ch, 1)) >= "a" and lcase$(left$(ch, 1)) <= "z"
end function
 
function is_str_var%(s as string)
    is_str_var% = isalpha%(s) and right$(s, 1) = "$"
end function
 
function is_str_lit%(s as string)
    is_str_lit% = left$(s, 1) = chr$(34)
end function
 
sub takechar(userstr as string, sym as string)
    sym = sym + left$(userstr, 1)
    userstr = right$(userstr, len(userstr) - 1)
end sub
 
function peekch$(userstr as string)
    peekch$ = left$(ltrim$(userstr), 1)
end function
 
sub nextsym(userstr as string, sym as string)
    sym = ""
    userstr = ltrim$(userstr)
    takechar userstr, sym
    select case sym
        case "%", "(", ")", "*", "+", ",", "-", "/", "=", "\", "^"   'all set
        case "0" to "9"
            while isdigit%(userstr)
                takechar userstr, sym
            wend
            if left$(userstr, 1) = "." then
                takechar userstr, sym
 
                while isdigit%(userstr)
                    takechar userstr, sym
                wend
            end if
        case "."
            while isdigit%(userstr)
                takechar userstr, sym
            wend
 
        case "<"
            if left$(userstr, 1) = "=" or left$(userstr, 1) = ">" then
                takechar userstr, sym
            end if
 
        case ">"
            if left$(userstr, 1) = "=" then
                takechar userstr, sym
            end if
 
        case "a" to "z", "A" to "Z"
            while isalpha%(userstr) or isdigit%(userstr) or left$(userstr, 1) = "_"
                takechar userstr, sym
            wend
            if left$(userstr, 1) = "$" then
                takechar userstr, sym
            end if
            sym = lcase$(sym)
        ' literal strings keep the double quotes at begin/end
        case chr$(34)
            while left$(userstr, 1) <> chr$(34) and userstr <> ""
                takechar userstr, sym
            wend
            if left$(userstr, 1) <> chr$(34) then
                print "Closing: '"; chr$(34); "' expected"
            else
                takechar userstr, sym
            end if
 
        case ""
        case else
            print "unrecognized character:", sym
            sym = ""
    end select
end sub
 
' parser starts here
 
function accept&(s as string, userstr as string, sym as string)
  accept& = 0
  if sym = s then accept& = -1: nextsym userstr, sym
end function
 
sub expect(s as string, userstr as string, sym as string)
  if not accept&(s, userstr, sym) then print "expecting "; s; " but found "; sym
end sub
 
function unaryprec%(op as string)
    select case op
        case "+", "-": unaryprec% = 13
        case "not":    unaryprec% =  6
        case else:     unaryprec% =  0  ' not a unary operator
    end select
end function
 
function binaryprec%(op as string)
    select case op
        case "^":                              binaryprec% = 14
        case "*", "/":                         binaryprec% = 12
        case "\" :                             binaryprec% = 11
        case "mod":                            binaryprec% = 10
        case "+", "-":                         binaryprec% =  9
        case "=", "<>", "<", ">", "<=", ">=":  binaryprec% =  7
        case "and":                            binaryprec% =  5
        case "or":                             binaryprec% =  4
        case "xor":                            binaryprec% =  3
        case "eqv":                            binaryprec% =  2
        case "imp":                            binaryprec% =  1
        case else:                             binaryprec% =  0 ' not a binary operator
    end select
end function
 
' all QBasic operators are left associative
function associativity%(op as string)
    if op = op then :
    associativity% = leftassoc
end function
 
' parse a parenthesized one argument numeric expression
function getvalue#(userstr as string, sym as string)
    getvalue# = 1
    nextsym userstr, sym     ' skip fun
    expect "(", userstr, sym
 
    getvalue# = numeric_expr#(0, userstr, sym)
 
    expect ")", userstr, sym
end function
 
' parse a parenthesized one argument string expression
function getstring$(userstr as string, sym as string)
    getstring$ = ""
    nextsym userstr, sym     ' skip fun
    expect "(", userstr, sym
 
    getstring$ = str_expr$(userstr, sym)
 
    expect ")", userstr, sym
end function
 
' Handle string operands - functions, variables, literal strings
function strfactor$(userstr as string, sym as string)
  dim x as integer, y as integer, s as string, n as double
 
  select case sym
    case "chr$":       n = getvalue#(userstr, sym): strfactor$ = chr$(n)
    case "date$":      nextsym userstr, sym: strfactor$ = date$
    case "hex$":       n = getvalue#(userstr, sym): strfactor$ = hex$(n)
    case "lcase$":     s = getstring$(userstr, sym): strfactor$ = lcase$(s)
    case "left$"
        nextsym userstr, sym
        expect "(", userstr, sym
        s = str_expr$(userstr, sym)
        expect ",", userstr, sym
        x = numeric_expr#(0, userstr, sym)
        strfactor$ = left$(s, x)
        expect ")", userstr, sym
    case "ltrim$":     s = getstring$(userstr, sym): strfactor$ = ltrim$(s)
    case "mid$"
        nextsym userstr, sym
        expect "(", userstr, sym
        s = str_expr$(userstr, sym)
        expect ",", userstr, sym
        x = numeric_expr#(0, userstr, sym)
        if accept&(",", userstr, sym) then
          y = numeric_expr#(0, userstr, sym)
          strfactor$ = mid$(s, x, y)
        else
          strfactor$ = mid$(s, x)
        end if
        expect ")", userstr, sym
    case "right$"
      nextsym userstr, sym
      expect "(", userstr, sym
      s = str_expr$(userstr, sym)
      expect ",", userstr, sym
      x = numeric_expr#(0, userstr, sym)
      strfactor$ = right$(s, x)
      expect ")", userstr, sym
    case "rtrim$":     s = getstring$(userstr, sym): strfactor$ = rtrim$(s)
    case "space$"
      nextsym userstr, sym
      expect "(", userstr, sym
      strfactor$ = space$(numeric_expr#(0, userstr, sym))
      expect ")", userstr, sym
    case "str$":       n = getvalue#(userstr, sym): strfactor$ = str$(n)
    case "string$"
      nextsym userstr, sym ' string$(n [, strexpr])
      expect "(", userstr, sym
      x = numeric_expr#(0, userstr, sym)
      expect ",", userstr, sym
      if is_str_lit%(sym) or is_str_var%(sym) then
        strfactor$ = string$(x, str_expr$(userstr, sym))
      else
        strfactor$ = string$(x, numeric_expr#(0, userstr, sym))
      end if
      expect ")", userstr, sym
    case "time$":      nextsym userstr, sym: strfactor$ = time$
    case "trim$":      s = getstring$(userstr, sym): strfactor$ = ltrim$(rtrim$(s))
    case "ucase$":     s = getstring$(userstr, sym): strfactor$ = ucase$(s)
 
    case else
      if is_str_lit%(sym) then
        strfactor$ = mid$(sym, 2, len(sym) - 2)
        nextsym userstr, sym
      elseif is_str_var%(sym) then
        strfactor$ = get_string_var(sym)
        nextsym userstr, sym
      else
        print "In strfactor, expecting an operand, found: "; sym
      end if
  end select
end function
 
' handle numeric operands - numbers, variables, functions and unary operators
function primary#(userstr as string, sym as string)
    dim op as string, prec as integer, n as double, s as string
 
    primary# = 0                    'prepare for errors
    prec = unaryprec%(sym)
    if prec > 0 then
        op = sym
        nextsym userstr, sym
        select case op
            case "-":   primary# =     -numeric_expr#(prec, userstr, sym)
            case "+":   primary# =      numeric_expr#(prec, userstr, sym)
            case "not": primary# =  not numeric_expr#(prec, userstr, sym)
        end select
    elseif isnumeric%(sym) then
        primary# = val(sym)
        nextsym userstr, sym
    else
        select case sym
            case "abs":  n = getvalue#(userstr, sym): primary# = abs(n)
            case "atan": n = getvalue#(userstr, sym): primary# = atn(n)
            case "cos":  n = getvalue#(userstr, sym): primary# = cos(n)
            case "exp":  n = getvalue#(userstr, sym): primary# = exp(n)
            case "fix":  n = getvalue#(userstr, sym): primary# = fix(n)
            case "int":  n = getvalue#(userstr, sym): primary# = int(n)
            case "len":  s = getstring$(userstr, sym): primary# = len(s)
            case "log":  n = getvalue#(userstr, sym): primary# = log(n)
            case "rnd"
                if peekch$(userstr) = "(" then
                    n = getvalue#(userstr, sym): primary# = rnd(n)
                else
                    nextsym userstr, sym
                    primary# = rnd
                end if
            case "sgn":  n = getvalue#(userstr, sym): primary# = sgn(n)
            case "sin":  n = getvalue#(userstr, sym): primary# = sin(n)
            case "sqr":  n = getvalue#(userstr, sym): primary# = sqr(n)
            case "tan":  n = getvalue#(userstr, sym): primary# = tan(n)
            case "val":  s = getstring$(userstr, sym): primary# = val(s)
            case else
                if isalpha%(sym) then
                    primary# = get_numeric_var(sym)
                    nextsym userstr, sym
                else
                    print "syntax error: expecting a primary, found:", sym
                end if
        end select
    end if
end function
 
sub push_str(s as string)
  str_stk_ndx = str_stk_ndx + 1
  str_stack(str_stk_ndx) = s
end sub
 
sub push_num(n as double)
  num_stk_ndx = num_stk_ndx + 1
  num_stack(num_stk_ndx) = n
end sub
 
function pop_str$
  pop_str = str_stack(str_stk_ndx)
  str_stk_ndx = str_stk_ndx - 1
end function
 
function pop_num#
  pop_num = num_stack(num_stk_ndx)
  num_stk_ndx = num_stk_ndx - 1
end function
 
' evaluate binary string operators, operands on the stack
function evalstrexpr&(op as string)
  dim s as string, s2 as string, n as double, val_type as integer
 
  val_type = tynum ' most operators give a numeric result
  s2 = pop_str$
  s = pop_str$
  select case op
    case "=":   n = s = s2
    case "<>":  n = s <> s2
    case "<":   n = s <  s2
    case ">":   n = s >  s2
    case "<=":  n = s <= s2
    case ">=":  n = s >= s2
    case "+":   s = s +  s2: val_type = tystring
    case else
      print "evalstrexpr: expecting a string operator, found: "; op
  end select
  if val_type = tynum then
    push_num(n)
    evalstrexpr& = tynum
  elseif val_type = tystring then
    push_str(s)
    evalstrexpr& = tystring
  end if
end function
 
' evaluate binary numeric operators, operands on the stack
function evalnumericexpr&(op as string)
  dim n as double, n2 as double
 
  n2 = pop_num#
  n = pop_num#
  select case op
    case "^":   n = n ^   n2
    case "*":   n = n *   n2
    case "/":   if n2 = 0 then print "division by 0" else n = n /   n2
    case "\":   if n2 = 0 then print "division by 0" else n = n \   n2
    case "mod": if n2 = 0 then print "division by 0" else n = n mod n2
    case "+":   n = n +   n2
    case "-":   n = n -   n2
    case "=":   n = n =   n2
    case "<>":  n = n <>  n2
    case "<":   n = n <   n2
    case ">":   n = n >   n2
    case "<=":  n = n <=  n2
    case ">=":  n = n >=  n2
    case "and": n = n and n2
    case "or":  n = n or  n2
    case "xor": n = n xor n2
    case "eqv": n = n eqv n2
    case "imp": n = n imp n2
    case else: print "evalnumericexpr: unexpected operator: "; op
  end select
  push_num(n)
  evalnumericexpr& = tynum
end function
 
' main expression parsing routine
function any_expr&(p as integer, userstr as string, sym as string)
    dim op as string, q as integer, prec as integer
    dim left_type as integer, right_type as integer
 
    ' we need to decide which primary to call - numeric or string
    ' leading parens don't tell us which primary, so just do recursive call
    if accept&("(", userstr, sym) then
      left_type = any_expr&(0, userstr, sym)
      expect ")", userstr, sym
    elseif is_str_lit%(sym) or is_str_var%(sym) then
      push_str(strfactor$(userstr, sym))
      left_type = tystring
    elseif isnumeric%(sym) or sym = "-" or sym = "+" or sym = "not" or isalpha%(sym) then
      push_num(primary#(userstr, sym))
      left_type = tynum
    elseif sym = "" then
      print "In expr, unexpected end-of-input found: "
    else
      print "In expr, unexpected symbol found: "; sym
    end if
 
    do  ' while binary operator and precedence of sym >= p
        prec = binaryprec%(sym)
        if prec = 0 or prec < p then exit do
        op = sym
 
        nextsym userstr, sym
        select case associativity%(op)
            case rightassoc : q = binaryprec%(op)
            case leftassoc  : q = binaryprec%(op) + 1
        end select
 
        right_type = any_expr&(q, userstr, sym)
 
        if left_type = tystring and right_type = tystring then
            left_type = evalstrexpr&(op)
        elseif left_type = tynum and right_type = tynum then
            left_type = evalnumericexpr&(op)
        else
            print "type missmatch in expr - left_type:"; left_type; " right_type:"; right_type
        end if
    loop
 
    any_expr& = left_type
end function
 
function numeric_expr#(p as integer, userstr as string, sym as string)
  if any_expr&(p, userstr, sym) = tynum then
    numeric_expr# = pop_num#
  else
    print "numeric expression expected"
    numeric_expr# = 0
  end if
end function
 
function str_expr$(userstr as string, sym as string)
  if any_expr&(0, userstr, sym) = tystring then
    str_expr$ = pop_str$
  else
    print "string expression expected"
    str_expr$ = ""
  end if
end function
 
function eval$(userstr as string)
    dim sym as string, save_sym as string, val_type as integer, nresult as double, sresult as string
 
    eval$ = ""
    ' reset the stacks used during expression parsing
    str_stk_ndx = 0: num_stk_ndx = 0
    nextsym userstr, sym
 
    ' does it look like an assignment?  "var = expression"
    save_sym = ""
    if peekch$(userstr) = "=" then
        save_sym = sym      ' save the left side variable
        nextsym userstr, sym ' skip the variable
        nextsym userstr, sym ' skip "="
    end if
 
    ' evalualte the expression
    val_type = any_expr&(0, userstr, sym)
 
    if sym <> "" then
        print "error: extra symbols found: "; sym; userstr
    elseif val_type = tystring then
        sresult = pop_str
        eval$   = sresult
    elseif val_type = tynum then
        nresult = pop_num
        eval$   = str$(nresult)
    end if
 
    ' was it an assignment?
    if save_sym <> "" then
        if is_str_var%(save_sym) and val_type = tystring then
            call store_string_var(save_sym, sresult)
        elseif isalpha%(save_sym) and val_type = tynum then
            call store_numeric_var(save_sym, nresult)
        else
            print "Type mismatch in assignment"
        end if
    end if
end function
 

Below are the passed unit tests, using a modified version of flukiluke's unit testing program:

Code: QB64: [Select]

$title: Eval Numeric Tests
(5-7)* 2
(-5--7)*2
2*(-5-7)
(-1--2)+(-3--4)
x = 5
x*x-2*x-3
2*-3--4+-0.25
1+2*(3+((4*5)+(6*7*8))-9)/10
1+2*(3-2*(3-2)*((2-4)*5-22/(7+2*(3-1))-1))+1
1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2
(1.4 + 2^(19 mod 4))/2
-5 ^ 1.9
e=exp(1)
e^2
log(2980.958)
.3+2*10^-8
((((((((3 + 2) * ((((((2)))))))))))))
4*2.5 + 8.5+1.5 / 3.0
2 -4 +6 -1 -1- 0 +8
1 -1   + 2   - 2   +  4 - 4 +    6
 2*3 - 4*5 + 6/3
2*3*4/8 -   5/2*4 +  6 + 0/3
(5 + 2*3 - 1 + 7 * 8)
(67 + 2 * 3 - 67 + 2/1 - 7)
(2) + (17*2-30) * (5)+2 - (8/2)*4
(( ((2)) + 4))*((5))
(5-4)*(12-11)/((((5-4)*(12-11))))
2+4+-4+-2*10 mod 9*7
1/-2
((((((-99))))))-1
1+(2-5)*3+8/(5+3)^2
(1+(2-5)*3+8/(5+3)^2)/sqr(5^2+3^2)
(1+(2-5)*3+8/(5+3)^2)/sqr(4^2+3^2)
sqr(4^2+3^2)
4*(1/1-1/3+1/5-1/7+1/9-1/11+1/13-1/15+1/17-1/19+10/401)
$expect: stdout
-4
 4
-24
 2
 5
 12
-2.25
 71
 60
 2.718281828458994
 4.7
-21.28349806301961
 2.718281828459045
 7.38905609893065
 8.000000004347015
 .30000002
 10
 19
 10
 6
-12
-1
 66
 1
 8
 30
 1
-18
-.5
-100
-7.875
-1.350551357997257
-1.575
 5
 3.1415902423708
$finish
 
$title: Eval String Tests
"a" + "b" > "a"
"abc" + "def"
"abc" + chr$(36) + "def"
lcase$("ABC")
left$(ltrim$("   ="), 1) = "="
mid$("abcdef", sqr(2^2), 6/2)
mid$("abcdef", 2^2)
s$ = "abc" + space$(9/3) + "def"
str$(123) + str$(456)
ltrim$(str$(1+2*(3+((4*5)+(6*7*8))-9)/10)) + ltrim$(str$(1+2*(3-2*(3-2)*((2-4)*5-22/(7+2*(3-1))-1))+1))
len(mid$("abcdef", sqr(2^2), 6/2)) + len(mid$("abcdef", 2^2))
$expect: stdout
-1
abcdef
abc$def
abc
-1
bcd
def
abc   def
 123 456
7160
 6
$finish
 

bplus · « **Reply #1 on:** February 25, 2021, 02:00:56 pm »

Ah just the Super Evaluator I m stuck on! Thanks @Ed Davis JIT!

Curious about the 2nd Code thing? Is that FB version?

Ed Davis · « **Reply #2 on:** February 25, 2021, 04:11:25 pm »

Quote from: bplus on February 25, 2021, 02:00:56 pm

Curious about the 2nd Code thing? Is that FB version?

That is the unit test data i used, running a modified version of flukiluke's unit test program.
I should have been more clear - sorry about that.

re: FB version. Just change "_explicit" to "explicit", and then it compiles with FreeBasic: fbc -lang qb eval.bas

Wait - was that supposed to be a joke? ("the 2nd Code thing"). Cause I'm pretty sure you know what FB code looks like. If it was a joke, then it was a good one, and you got me :)

bplus · « **Reply #3 on:** February 25, 2021, 09:04:37 pm »

Quote

Wait - was that supposed to be a joke?

:) not meant as joke, just never saw anything that's all $ sign commands = instructions to compiler, now, I will guess.

SMcNeill · « **Reply #4 on:** February 25, 2021, 09:54:08 pm »

Quote from: bplus on February 25, 2021, 09:04:37 pm

:) not meant as joke, just never saw anything that's all $ sign commands = instructions to compiler, now, I will guess.

All our precompiler commands are using $.

$let
$if
$elseif
$else
$end if
$color
and so on... ;D

bplus · « **Reply #5 on:** February 25, 2021, 10:55:23 pm »

ha! $let

What is $expect: stdout

FellippeHeitor · « **Reply #6 on:** February 25, 2021, 10:57:33 pm »

Quote from: bplus on February 25, 2021, 10:55:23 pm

ha! $let

What is $expect: stdout

Quote

That is the unit test data i used, running a modified version of flukiluke's unit test program.
I should have been more clear - sorry about that.

https://github.com/flukiluke/L-BASIC/blob/master/tools/test.bas

Dav · « **Reply #7 on:** February 26, 2021, 08:25:20 am »

Nice code, @Ed Davis. Works solid on what I could throw at it.

Thanks for sharing.

- Dav

bplus · « **Reply #8 on:** February 26, 2021, 11:36:45 am »

Well I found early on you can't throw any caps at it eg Mid$ instead of mid$.

Not disappointed in least about that though.

bplus · « **Reply #9 on:** February 26, 2021, 11:46:35 am »

Quote from: FellippeHeitor on February 25, 2021, 10:57:33 pm

https://github.com/flukiluke/L-BASIC/blob/master/tools/test.bas

Thanks @FellippeHeitor

I think the gist of that link is put all your test stuff in an array of UDT
Type
testString as string
expectedReturn as string
comparedResults as string
End type

And have the tester report both results and say if they are exactly same or not plus add some reports from the stopwatch as well.

Did I miss take the understanding of the link?

Well anyway my take away is to build a smarter tester, ie test through an array of items you can build as bugs are reported.

Dav · « **Reply #10 on:** February 26, 2021, 11:56:27 am »

Ah. I didnt try changing caps. Played with odd things though, like doing 1--1.

-Dav

Ed Davis · « **Reply #11 on:** February 27, 2021, 07:17:14 am »

Quote from: Dav on February 26, 2021, 11:56:27 am

Ah. I didnt try changing caps. Played with odd things though, like doing 1--1.

-Dav

Thanks for trying the odd things - I'm using this code in another program, and every bit of testing helps!

Ed Davis · « **Reply #12 on:** February 27, 2021, 07:19:55 am »

Quote from: bplus on February 26, 2021, 11:36:45 am

Well I found early on you can't throw any caps at it eg Mid$ instead of mid$.

Not disappointed in least about that though.

Sorry about that. I knew I'd forgotten something :)

I have updated the code in the original post. It now accepts mid$, Mid$, MID$ and so on, and the same for other identifiers. And I'll add that to my unit tests.

Ed Davis · « **Reply #13 on:** February 27, 2021, 07:37:28 am »

Quote from: bplus on February 26, 2021, 11:46:35 am

Thanks @FellippeHeitor

I think the gist of that link is put all your test stuff in an array of UDT
Type
testString as string
expectedReturn as string
comparedResults as string
End type

And have the tester report both results and say if they are exactly same or not plus add some reports from the stopwatch as well.

Did I miss take the understanding of the link?

I believe you got the gist.

For instance, based on your earlier report, I have added the following unit tests:

Code: QB64: [Select]

$title: Eval ignore case in identifiers
num = 42
NUM
num2 = 86
NUM3 = NUM + NUM2
NUM3
num3
MID$("abcd", 2)
mid$("ABCD", 2)
$expect: stdout
 42
 42
 86
 128
 128
 128
bcd
BCD
$finish
 

I put that in a file called eval.case.test, and run:

test eval.exe eval.case.test

And I get:

eval.case:Eval ignore case in identifiers: OK
Total 1/1 OK in 3.8 seconds

Each time I find a bug, I try to create a new test case that covers it.
Each time I make changes to eval, after recompiling, I run the unit tests. While passing the unit tests doesn't mean that Eval has no bugs, it pretty quickly helps me know if it still sorta/kinda works, or if I've horribly broken it :)

bplus · « **Reply #14 on:** March 01, 2021, 10:40:19 pm »

Hi @Ed Davis

I am trying to understand how you are parsing in Eval and I start around Expect, a couple of lines then goto by Sub or Function someplace else, a couple of lines, then someplace else... and this isn't spaghetti code but the effect on following it for understanding seems the same.

I am naming the opposite of spaghetti code, shattered code, so refactored, so splintered and broken up... it's a nightmare to follow.

Not saying it's a bad thing, in fact I am wondering if it is some sign of being better for computers and efficiencies even if human understanding is made difficult.

But I am not familiar with the variables yet, it's like watching for first time a sitcom or soap opera that has been going for years.

News:

Author Topic: Numeric/String Eval function (Read 6096 times)

Ed Davis

Numeric/String Eval function

bplus

Re: Numeric/String Eval function

Ed Davis

Re: Numeric/String Eval function

bplus

Re: Numeric/String Eval function

SMcNeill

Re: Numeric/String Eval function

bplus

Re: Numeric/String Eval function

FellippeHeitor

Re: Numeric/String Eval function

Dav

Re: Numeric/String Eval function

bplus

Re: Numeric/String Eval function

bplus

Re: Numeric/String Eval function

Dav

Re: Numeric/String Eval function

Ed Davis

Re: Numeric/String Eval function

Ed Davis

Re: Numeric/String Eval function

Ed Davis

Re: Numeric/String Eval function

bplus

Re: Numeric/String Eval function