Initial data commit

Task/Arithmetic-evaluation/FreeBASIC/arithmetic-evaluation.basic

@@ -0,0 +1,195 @@
+'Arithmetic evaluation
+'
+'Create a program which parses and evaluates arithmetic expressions.
+'
+'Requirements
+'
+'    * An abstract-syntax tree (AST) for the expression must be created from parsing the
+'      input.
+'    * The AST must be used in evaluation, also, so the input may not be directly evaluated
+'      (e.g. by calling eval or a similar language feature.)
+'    * The expression will be a string or list of symbols like "(1+3)*7".
+'    * The four symbols + - * / must be supported as binary operators with conventional
+'      precedence rules.
+'    * Precedence-control parentheses must also be supported.
+'
+'Standard mathematical precedence should be followed:
+'
+'    Parentheses
+'    Multiplication/Division (left to right)
+'    Addition/Subtraction (left to right)
+'
+'  test cases:
+'  2*-3--4+-0.25 : returns -2.25
+'  1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10 : returns 71
+
+enum
+    false = 0
+    true = -1
+end enum
+
+enum Symbol
+    unknown_sym
+    minus_sym
+    plus_sym
+    lparen_sym
+    rparen_sym
+    number_sym
+    mul_sym
+    div_sym
+    unary_minus_sym
+    unary_plus_sym
+    done_sym
+    eof_sym
+end enum
+
+type Tree
+    as Tree ptr leftp, rightp
+    op as Symbol
+    value as double
+end type
+
+dim shared sym as Symbol
+dim shared tokenval as double
+dim shared usr_input as string
+
+declare function expr(byval p as integer) as Tree ptr
+
+function isdigit(byval ch as string) as long
+    return ch <> "" and Asc(ch) >= Asc("0") and Asc(ch) <= Asc("9")
+end function
+
+sub error_msg(byval msg as string)
+    print msg
+    system
+end sub
+
+' tokenize the input string
+sub getsym()
+    do
+        if usr_input = "" then
+            line input usr_input
+            usr_input += chr(10)
+        endif
+        dim as string ch = mid(usr_input, 1, 1) ' get the next char
+        usr_input = mid(usr_input, 2)           ' remove it from input
+
+        sym = unknown_sym
+        select case ch
+            case " ":     continue do
+            case chr(10), "": sym = done_sym: return
+            case "+":     sym = plus_sym:     return
+            case "-":     sym = minus_sym:    return
+            case "*":     sym = mul_sym:      return
+            case "/":     sym = div_sym:      return
+            case "(":     sym = lparen_sym:   return
+            case ")":     sym = rparen_sym:   return
+            case else
+                if isdigit(ch) then
+                    dim s as string = ""
+                    dim dot as integer = 0
+                    do
+                        s += ch
+                        if ch = "." then dot += 1
+                        ch = mid(usr_input, 1, 1)       ' get the next char
+                        usr_input = mid(usr_input, 2)   ' remove it from input
+                    loop while isdigit(ch) orelse ch = "."
+                    if ch = "." or dot > 1 then error_msg("bogus number")
+                    usr_input = ch + usr_input          ' prepend the char to input
+                    tokenval = val(s)
+                    sym = number_sym
+                end if
+                return
+        end select
+    loop
+end sub
+
+function make_node(byval op as Symbol, byval leftp as Tree ptr, byval rightp as Tree ptr) as Tree ptr
+    dim t as Tree ptr
+
+    t = callocate(len(Tree))
+    t->op = op
+    t->leftp = leftp
+    t->rightp = rightp
+    return t
+end function
+
+function is_binary(byval op as Symbol) as integer
+    select case op
+        case mul_sym, div_sym, plus_sym, minus_sym: return true
+        case else: return false
+    end select
+end function
+
+function prec(byval op as Symbol) as integer
+    select case op
+        case unary_minus_sym, unary_plus_sym:  return 100
+        case mul_sym, div_sym:                 return  90
+        case plus_sym, minus_sym:              return  80
+        case else:                             return   0
+    end select
+end function
+
+function primary as Tree ptr
+    dim t as Tree ptr = 0
+
+    select case sym
+        case minus_sym, plus_sym
+            dim op as Symbol = sym
+            getsym()
+            t = expr(prec(unary_minus_sym))
+            if op = minus_sym then return make_node(unary_minus_sym, t, 0)
+            if op = plus_sym  then return make_node(unary_plus_sym,  t, 0)
+        case lparen_sym
+            getsym()
+            t = expr(0)
+            if sym <> rparen_sym then error_msg("expecting rparen")
+            getsym()
+            return t
+        case number_sym
+            t = make_node(sym, 0, 0)
+            t->value = tokenval
+            getsym()
+            return t
+        case else: error_msg("expecting a primary")
+    end select
+end function
+
+function expr(byval p as integer) as Tree ptr
+    dim t as Tree ptr = primary()
+
+    while is_binary(sym) andalso prec(sym) >= p
+        dim t1 as Tree ptr
+        dim op as Symbol = sym
+        getsym()
+        t1 = expr(prec(op) + 1)
+        t = make_node(op, t, t1)
+    wend
+    return t
+end function
+
+function eval(byval t as Tree ptr) as double
+    if t <> 0 then
+        select case t->op
+            case minus_sym:       return eval(t->leftp) - eval(t->rightp)
+            case plus_sym:        return eval(t->leftp) + eval(t->rightp)
+            case mul_sym:         return eval(t->leftp) * eval(t->rightp)
+            case div_sym:         return eval(t->leftp) / eval(t->rightp)
+            case unary_minus_sym: return -eval(t->leftp)
+            case unary_plus_sym:  return  eval(t->leftp)
+            case number_sym:      return t->value
+            case else:            error_msg("unexpected tree node")
+        end select
+    end if
+    return 0
+end function
+
+do
+    getsym()
+    if sym = eof_sym then exit do
+    if sym = done_sym then continue do
+    dim t as Tree ptr = expr(0)
+    print"> "; eval(t)
+    if sym = eof_sym then exit do
+    if sym <> done_sym then error_msg("unexpected input")
+loop