simple stack-based eval

General FreeBASIC programming questions.
srvaldez
Posts: 2482
Joined: Sep 25, 2005 21:54

simple stack-based eval

Postby srvaldez » Jun 18, 2020 9:13

not a tip or a trick, just for fun

Code: Select all

Declare Sub eval ( Byref expr_ As String, Byref result As Double )

'op_stack used by eval
Redim Shared op_stack ( 10 ) As Zstring*6
Dim Shared As Integer op_stack_pointer=0, op_stack_ubound=10

'value_stack used by eval
Redim Shared value_stack ( 10 ) As Double
Dim Shared As Integer value_stack_pointer=0, value_stack_ubound=10

'variables used by eval
Dim Shared As Integer expr_index, expr_length
Dim Shared As String op, number, expression, char, rpn
Dim Shared As Double factorial, lhs_value, rhs_value

'variables used by demo
Dim As String math_expr
Dim As Double result_value

' eval demo
math_expr=" "
While math_expr<>""
   line Input "? ",math_expr
   eval ( math_expr, result_value )
   Print result_value
   Print "rpn = ";rpn
Wend

' end of demo
'================================

Sub op_stack_push ( Byval n As String )
   op_stack ( op_stack_pointer )=n
   If op_stack_pointer=op_stack_ubound Then
      op_stack_ubound+=10
      Redim Preserve op_stack ( op_stack_ubound )
   End If
   op_stack_pointer+=1
End Sub

Function op_stack_pop () As String
   If op_stack_pointer=0 Then
      Print "op_stack is empty"
      Return ""
   End If
   op_stack_pointer-=1
   Return op_stack ( op_stack_pointer )
End Function

Sub value_stack_push ( Byval n As Double )
   value_stack ( value_stack_pointer )=n
   If value_stack_pointer=value_stack_ubound Then
      value_stack_ubound+=10
      Redim Preserve value_stack ( value_stack_ubound )
   End If
   value_stack_pointer+=1
End Sub

Function value_stack_pop () As Double
   If value_stack_pointer=0 Then
      Print "value_stack is empty"
      Return 0
   End If
   value_stack_pointer-=1
   Return value_stack ( value_stack_pointer )
End Function

'eval

Declare Sub scan
Declare Sub unary
Declare Sub gamma
Declare Sub expon
Declare Sub term
Declare Sub expr
Declare Sub factor
Declare Sub fn_factorial

Sub eval ( Byref expr_ As String, Byref result As Double )
   expression=Ucase ( expr_ )
   If Len ( expression ) = 0 Then expression = "0"
   rpn=""
   expr_index = 1: expr_length = Len ( expression )
   value_stack_pointer=0
   op_stack_pointer=0
   scan
   expr
   If char <> " " Then
      Print
      Print "Syntax Error"
      Print
   End If
   ?
   result = value_stack_pop () 'value_stack ( 0 )
End Sub

Sub scan
   If expr_index > expr_length Then
      char = " "
      Exit Sub
   End If
   char = Mid ( expression, expr_index, 1 )
   expr_index = expr_index + 1
   If char = " " Then scan
End Sub

Sub unary
   If char = "-" Or char = "+" Then
      op_stack_push ( char )
      scan
      term
      op = op_stack_pop ()
      If op <> "-" Then Exit Sub
      lhs_value=value_stack_pop ()
      value_stack_push ( - lhs_value )
      rpn += "NEG "
      Exit Sub
   End If
   factor
End Sub

Sub gamma
   unary
   While char = "!"
      lhs_value = value_stack_pop ()
      fn_factorial
      value_stack_push ( factorial )
      scan
      rpn += "! "
   Wend
End Sub

Sub expon
   gamma
   While char = "^"
      scan
      gamma
      rhs_value = value_stack_pop ()
      lhs_value = value_stack_pop ()
      value_stack_push ( lhs_value ^ rhs_value )
      rpn += "^ "
   Wend
End Sub

Sub term
   expon
   While ( char = "*" Or char = "/" )
      op_stack_push ( char )
      scan
      expon
      op = op_stack_pop ()
      If op = "*" Then
         rhs_value = value_stack_pop ()
         lhs_value = value_stack_pop ()
         value_stack_push ( lhs_value * rhs_value )
         rpn += "* "
      End If
      If op = "/" Then
         rhs_value = value_stack_pop ()
         lhs_value = value_stack_pop ()
         value_stack_push ( lhs_value / rhs_value )
         rpn += "/ "
      End If
   Wend
End Sub

Sub expr
   term
   While ( char = "-" Or char = "+" )
      op_stack_push ( char )
      scan
      term
      op = op_stack_pop ()
      If op = "-" Then
         rhs_value = value_stack_pop ()
         lhs_value = value_stack_pop ()
         value_stack_push ( lhs_value - rhs_value )
         rpn += "- "
      End If
      If op = "+" Then
         rhs_value = value_stack_pop ()
         lhs_value = value_stack_pop ()
         value_stack_push ( lhs_value + rhs_value )
         rpn += "+ "
      End If
   Wend
End Sub

Sub factor
   If Instr (".0123456789", char ) Then
      number = ""
      while char<>"." andalso Instr ("0123456789", char )
        number += char
        scan
      wend
      if char="." then
         number += char
         scan
      end if
      While Instr ("0123456789", char )
         number = number + char
         scan
      Wend
      if char="E" then
         number += char
         scan
         if char="-" or char="+" then
            number += char
            scan
         end if
         if Instr ("0123456789", char ) then
          While Instr ("0123456789", char )
            number += char
            scan
          wend
         else
         number += "0"
       end if
      end if
      value_stack_push ( Val ( number ) )
      rpn += number+" "
      Exit Sub
   End If

   If char = "(" Then
      scan
      expr
      If char =")" Then
         scan
      else
         Print
         Print "Missing ')'"
      End If
   End If
   'functions would be added here
   'here's a very crude example just to illustrate
    if char = "S" Then
        If mid(expression, expr_index - 1, 4) = "SIN(" Then
            expr_index = expr_index + 2 'advance pointer to just before "("
            scan
            factor
            value_stack( value_stack_pointer - 1) = Sin(value_stack( value_stack_pointer - 1))
            rpn += "SIN "
        end if
    'elseif '' check for more functions
    end if
End Sub

Sub fn_factorial
   factorial = 1
   For i As Integer = 1 To lhs_value
      factorial = factorial * i
   Next i
End Sub
Last edited by srvaldez on Aug 03, 2020 14:48, edited 6 times in total.
Tourist Trap
Posts: 2901
Joined: Jun 02, 2015 16:24

Re: simple stack-based eval

Postby Tourist Trap » Jun 20, 2020 15:28

Nice. You need to implement Exit() or something like that to be complete :)
D.J.Peters
Posts: 8117
Joined: May 28, 2005 3:28
Contact:

Re: simple stack-based eval

Postby D.J.Peters » Jul 31, 2020 8:54

Tourist Trap wrote:Nice. You need to implement Exit() or something like that to be complete :)
ENTER only will do the job !

@srvaldez nice and clean good job!

Joshy
TJF
Posts: 3599
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: simple stack-based eval

Postby TJF » Aug 02, 2020 8:18

srvaldez wrote:not a tip or a trick, just for fun
No fun yet :-(
? 1e5

Syntax Error
srvaldez
Posts: 2482
Joined: Sep 25, 2005 21:54

Re: simple stack-based eval

Postby srvaldez » Aug 02, 2020 15:45

Hi TJF
in this very simple evaluator I do a very poor number parsing, it's done in the sub factor
I added E to the numeric character list and entering a number in exponential format will now works but there's no checking for valid number entry
TJF
Posts: 3599
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: simple stack-based eval

Postby TJF » Aug 02, 2020 15:58

srvaldez wrote:I added E to the numeric character list and entering a number in exponential format will now works but there's no checking for valid number entry
Wanna fix further problems?
? (1+2)*3

Aborting due to runtime error 6 (out of bounds array access) at line 204 of eval.bas::FACTOR()
Regards
srvaldez
Posts: 2482
Joined: Sep 25, 2005 21:54

Re: simple stack-based eval

Postby srvaldez » Aug 02, 2020 16:28

thank you TJF for testing and reporting, it should be fixed now :-)
TJF
Posts: 3599
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: simple stack-based eval

Postby TJF » Aug 03, 2020 6:36

? 1e-5

-4
rpn = 1E 5 -
srvaldez
Posts: 2482
Joined: Sep 25, 2005 21:54

Re: simple stack-based eval

Postby srvaldez » Aug 03, 2020 9:59

hello TJF
you coerced me into the tricky float parsing :-)
still no float error trapping but as long as the number entered is a valid float it should work, thanks for the push :-)
TJF
Posts: 3599
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: simple stack-based eval

Postby TJF » Aug 03, 2020 19:51

Float parsing is not trivial
? .-5

-5
rpn = . 5 -
srvaldez
Posts: 2482
Joined: Sep 25, 2005 21:54

Re: simple stack-based eval

Postby srvaldez » Aug 04, 2020 1:00

Hi TJF
this may take me some time figure out
srvaldez
Posts: 2482
Joined: Sep 25, 2005 21:54

Re: simple stack-based eval

Postby srvaldez » Aug 04, 2020 16:07

@TJF
I am not so sure that the expression you posted above is interpreted wrongly, try that on the Windows Calculator and you will get the same answer
I suppose it depends on what you want to consider an acceptable number

Return to “General”

Who is online

Users browsing this forum: No registered users and 10 guests