RPN Interpreter Eval function

Post by **idle** » Fri Mar 25, 2011 5:17 pm

No real reason for doing it other than insomnia entertainment.
Converts from infix to RPN and evaluates the expressions
While it's far from optimized hopefully it'll at least be of some educational benefit
mostly untested so may be bugs

supported operators
+ - * / "% ^ << >>
~ ! | &
> < >= <= <> == ternary operators eg a > b ? x : y or a > b : x : y or a > b x y
sin cos tan sqrt
variables numeric and strings

Code: Select all

; Author: IDLE
; Date: 11,10,2019
; PB version: v5.62 windows
; Version 0.53
; Updated for PB 5.62
; added fix for unary negation
; Date: 26,4, 2011
; PB version: v4.51 linux

; Version 0.52 
; ---------------------------------------------------------------------------------------------------------------
; Description:
; ---------------------------------------------------------------------------------------------------------------
; RPN interpretor (Reverse Polish Notation)
; parse infix to RPN and calculates results
; http://en.wikipedia.org/wiki/Reverse_Polish_notation
; supported operators
; + - * / "% ^ << >>
; ~ ! | &  bitwise
; > < >= <= <> ==  ternary operators  eg a > b ? x : y  or  a > b : x : y  or a > b x y   
; sin cos tan sqrt
; variables numeric and strings
EnableExplicit

Enumeration 10
  #RPN_IsNumeric
  #RPN_IsAlpha
  #RPN_IsSymbol
  #RPN_IsOther
EndEnumeration

Structure RPN_Variables     
  len.i
  type.i
  num.d
  str.s
EndStructure

Structure RPN_Class
  *vt
  StackCounter.i
  rpn.s
  Map tokens.i()
  Map var.RPN_Variables()
  List stack.s()
EndStructure   

Declare.s RPN_Eval(*this.RPN_Class,expr.s)
Declare RPN_IsNumeric(*this.RPN_Class,strin.s)
Declare RPN_Free(*this.RPN_Class)

Interface IRPN
  Eval.s(expr.s)
  IsNumeric(expr.s)
  Free()
EndInterface   

DataSection: VT_RPN:
  Data.i @RPN_Eval()
  Data.i @RPN_IsNumeric()
  Data.i @RPN_Free()
EndDataSection   

Procedure NewRPN()
  Protected *this.RPN_Class
  *this = AllocateStructure(RPN_Class)
  If *this
    *this\tokens("(") =1
    *this\tokens("+") =4
    *this\tokens("-")=4
    *this\tokens("_")=8
    *this\tokens("*")=5
    *this\tokens("/")=5
    *this\tokens("%")=7
    *this\tokens("^")=5
    *this\tokens(">>")=7
    *this\tokens("<<")=7
    *this\tokens("!")=6
    *this\tokens("&")=6
    *this\tokens("|")=6
    *this\tokens("~")=8
    *this\tokens("=")=8
    *this\tokens(">")=4
    *this\tokens("<")=4
    *this\tokens(">=")=4
    *this\tokens("<=")=4
    *this\tokens("<>")=4
    *this\tokens("==")=4
    *this\tokens(")")=1
    *this\tokens("sin")=5
    *this\tokens("cos")=5
    *this\tokens("tan")=5
    *this\tokens("?")=0
    *this\tokens(":")=0
    *this\tokens("sqrt")=5
    *this\vt = ?VT_RPN
    ProcedureReturn *this
  EndIf   

EndProcedure 

Procedure RPN_Free(*this)
  ClearStructure(*this,RPN_Class)
  FreeStructure(*this)
EndProcedure

Procedure RPN_IsNumeric(*this,strin.s)
  Protected char.i
  If strin <> ""
  char = PeekC(@strin)
  If char = 45 Or (char >=48 And char <=57)
    ProcedureReturn 1
  Else 
    ProcedureReturn 0
  EndIf     
  EndIf
EndProcedure

Procedure RPN_NewVar(*this.RPN_Class,v.s,val.s)
  Protected *v
 
  If RPN_IsNumeric(*this,val) 
    *this\var(v)\num = ValD(val)
    *this\var(v)\len = SizeOf(Double)
    *this\var(v)\type = #RPN_IsNumeric
  Else
    *this\var(v)\str = val
    *this\var(v)\type = #RPN_IsAlpha
    *this\var(v)\len = Len(val)
  EndIf   
 
EndProcedure

Procedure RPN_SetVar(*this.RPN_Class,v.s,val.s)
  Protected *v,va.s,type.s
 
  If Not *this\var(v)\len
    RPN_NewVar(*this,v,val)
  Else
    If *this\var(v)\type = #RPN_IsNumeric 
      *this\var(v)\num = ValD(val)
    Else
      *this\var(v)\str = val
      *this\var(v)\len = Len(val)
    EndIf   
   
  EndIf   
EndProcedure

Procedure RPN_Push(*this.RPN_Class,token.s)
  Static ct,top.s
  If token = "("
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  ElseIf *this\StackCounter = 0   
    AddElement(*this\stack())
    *this\stack()= token
    *this\StackCounter+1
  Else
    top = *this\stack()
    While *this\tokens(top) > *this\tokens(token) And *this\StackCounter > 0
      *this\rpn + *this\stack() + " "
      DeleteElement(*this\stack())
      *this\StackCounter-1
    Wend
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  EndIf
 
EndProcedure

Procedure RPN_Pop(*this.RPN_Class,cond.s)
  Protected token.s
  While *this\StackCounter > 0
    token = *this\stack()
    If token = cond
      DeleteElement(*this\stack())
      *this\StackCounter-1
      Break
    Else
      *this\rpn + token + " "
    EndIf
    DeleteElement(*this\stack())
    *this\StackCounter-1
  Wend
EndProcedure

Procedure RPN_InfixToRpn(*this.RPN_Class,expr.s)
  Protected len,a,b,c,char,state,token.s,Tstate,lstate,ltoken.s
 
  len = StringByteLength(expr)
 
  While a < len
    b=a
    token=""
    While b < len
      char = PeekC(@expr+b)
      If (char = '.' And state = #RPN_IsNumeric) Or (char >='0' And char <='9')
        state = #RPN_IsNumeric
      ElseIf (char = '.' And state = #RPN_IsAlpha) Or (char >='A' And char <='Z') 
        state = #RPN_IsAlpha
      ElseIf char >='a' And char <='z'
        state = #RPN_IsAlpha
      ElseIf char <> ' ' 
        state = #RPN_IsSymbol
      Else
        state = #RPN_IsOther
      EndIf
      If Not Tstate
        Tstate = state
      EndIf   
      If Tstate <> state
        Break
      Else
        token + Chr(char)
        If (char >= '(') And (char <='+') Or char = '-' Or char = '/' Or char = '=' Or char ='!' Or char = '^' Or char = '_' Or char = '~'
          b+SizeOf(Character)
          Break
        EndIf   
      EndIf   
      b+SizeOf(Character)
    Wend       
    a=b     
   
    If Tstate = #RPN_IsSymbol
      If token = ")"
        RPN_Pop(*this,"(")
      ElseIf *this\tokens(token)
        If ((lstate = #RPN_IsSymbol Or lstate =0) And token = "-") 
          If (ltoken <> ")" And Not RPN_IsNumeric(*this,ltoken))
            token = "_"
          EndIf   
        EndIf   
        RPN_Push(*this,token)
      EndIf   
    ElseIf tstate = #RPN_IsAlpha
      If *this\tokens(token)
        RPN_Push(*this,token)
      Else
        *this\Rpn + token + " "   
      EndIf   
    ElseIf tState = #RPN_IsNumeric
      *this\Rpn + token + " "   
    EndIf   
    Tstate = state
    lstate = state 
    ltoken = token
  Wend   
  RPN_Pop(*this,"end")
  *this\rpn = Trim(*this\rpn)
 
EndProcedure

Macro _RPN_Pop(op,v)
  If ListSize(*this\stack()) > 0
    op = *this\stack()
    If *this\var(op)\type > 0
      *v = @*this\var(op)
      vr\type = #RPN_IsNumeric
    Else   
      If RPN_IsNumeric(*this,op)
        *v = @t#v
        *v\num = ValD(op)
        *v\str = ""
        *v\type = #RPN_IsNumeric
        vr\type =#RPN_IsNumeric
      Else 
        *v = @t#v
        *v\num = 0
        *v\str = op
        *v\type = #RPN_IsAlpha
        vr\type =#RPN_IsAlpha
      EndIf 
    EndIf   
    DeleteElement(*this\stack())
  EndIf   
EndMacro

Macro _RPN_Assign(cond)
  If cond
    If *v2\type = #RPN_IsNumeric
      vr\num = *v2\num
    Else
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str
    EndIf   
  Else
    If *v1\type = #RPN_IsNumeric
      vr\num = *v1\num
    Else
      vr\type = #RPN_IsAlpha
      vr\str = *v1\str
    EndIf
  EndIf   
EndMacro

Procedure RPN_EvalOperator(*this.RPN_Class,operator.s)
  Protected op1.s,op2.s,op3.s,op4.s,result.s
  Protected t1.q,tq.q,rq.q,t2
  Protected *v1.RPN_Variables,*v2.RPN_Variables,*v3.RPN_Variables,*v4.RPN_Variables
  Protected tv1.RPN_Variables,tv2.RPN_Variables,tv3.RPN_Variables,tv4.RPN_Variables
  Protected vr.RPN_Variables
  _RPN_Pop(op1,v1)
  If operator <> "~" And operator <> "sin" And operator <> "cos" And operator <> "tan" And  operator <> "sqrt" And operator <> "_"
    _RPN_Pop(op2,v2)
    If op2 <> ""
      *this\StackCounter-2
    Else
      *this\StackCounter-1
    EndIf   
  Else
    *this\StackCounter-1
  EndIf
  If operator = "+"
    If *v1\type = #RPN_IsNumeric And  *v2\type = #RPN_IsNumeric
      vr\num = *v2\num + *v1\num
      vr\type = #RPN_IsNumeric
    Else
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str + *v1\str
    EndIf   
  ElseIf  operator = "-"
    If op2 <> ""
      vr\num = *v2\num - *v1\num
    Else
      vr\num = -*v1\num 
    EndIf 
  ElseIf operator = "*"
    vr\num = *v2\num * *v1\num
  ElseIf operator = "/"
    If *v1\num <> 0
      vr\num = *v2\num / *v1\num
    EndIf   
  ElseIf operator = "%"
    vr\num =Mod(*v2\num,*v1\num)
  ElseIf operator = "^"
    vr\num = Pow(*v2\num,*v1\num)
  ElseIf operator =">"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num > *v3\num)
  ElseIf operator ="<"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num < *v3\num)
  ElseIf operator =">="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num >= *v3\num)
  ElseIf operator ="<="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num <= *v3\num)
  ElseIf operator ="<>"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num <> *v3\num)
    Else
      _RPN_Assign(*v4\str <> *v3\str)
    EndIf
  ElseIf operator ="=="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num = *v3\num)
    Else
      _RPN_Assign(*v4\str = *v3\str)
    EndIf
  ElseIf operator =">>"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 >> t1
    vr\num = rq
  ElseIf operator ="<<"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 << t1
    vr\num = rq
  ElseIf operator ="!"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 ! t1
    vr\num = rq
  ElseIf operator ="&"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 & t1
    vr\num = rq
  ElseIf operator ="|"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 | t1
    vr\num = rq   
  ElseIf operator ="~"
    t1 = *v1\num
    rq = ~t1
    vr\num = rq
  ElseIf operator ="_"
    t1 = *v1\num
    rq = -t1
    vr\num = rq 
  ElseIf operator ="sin"
    vr\num = Sin(*v1\num)
  ElseIf operator ="cos"
    vr\num = Cos(*v1\num)
  ElseIf operator ="tan"
    vr\num = Tan(*v1\num)
  ElseIf  operator = "sqrt"
    vr\num = Sqr(*v1\num)
  EndIf   
  If operator = "="
    If *v2 And *v2\type = #RPN_IsNumeric 
      RPN_SetVar(*this,op1,op2)
    Else
      RPN_SetVar(*this,op2,op1)
    EndIf   
  Else
    If vr\type = #RPN_IsNumeric
      result = StrD(vr\num)
    Else
      result = vr\str
    EndIf   
    AddElement(*this\stack())
    *this\stack() = result
    *this\StackCounter+1
  EndIf
EndProcedure

Procedure.s RPN_Eval(*this.RPN_Class,expr.s)
  Protected token.s,len,ct,a,result.s
 
  ClearList(*this\stack())
  ClearMap(*this\var())
  *this\StackCounter=0
  *this\rpn = ""
  RPN_InfixToRpn(*this,expr)
  len = Len(*this\rpn)
  ct = CountString(*this\rpn," ")
  For a = 1 To ct+1
    token = StringField(*this\rpn,a," ")
    If *this\tokens(token)
      RPN_EvalOperator(*this,token)
    ElseIf token <> ":"  And token <> "?"
      AddElement(*this\stack())
      *this\stack() = token
      *this\StackCounter+1
    EndIf   
  Next   
  
  If *this\StackCounter  
    result.s = *this\stack()
    DeleteElement(*this\stack())
  EndIf  
  ProcedureReturn result
 
EndProcedure   

CompilerIf #PB_Compiler_IsMainFile
 
Define *rpn.IRPN = NewRPN()
;examples *************************************************************************************
Debug *rpn\Eval("6*(3-2)") ;6
Debug *rpn\Eval("-5+-3"); -8
Debug *rpn\eval("(varA=Hello varB=World c=2) 6>>1 > c ? (varA+varB) : (varB+varA)"); "HelloWorld"
Debug *rpn\eval("(varA=Hello varB=World c=4) 6>>1 > c ? (varA+varB) : (varB+varA)"); "WorldHello"
Debug *rpn\eval("(a=5  b=4) (a*b*2)") ;40   
Debug *rpn\eval("(a=5  b=4) c= (a*b*2) : c > 39 ? true : false"); True
Debug *rpn\eval("(a=5 b=4) cc= (a*b*2) cc + cc < (a*b) ? true : cc"); 80
Debug *rpn\eval("1+-3"); -2
Debug *rpn\eval("5+((1+2)*4)-3"); 14
Debug *rpn\eval("5.12+sin(-13)"); 4.6998
Debug *rpn\Eval("a = 5")

Debug 5.12+Sin(-13); 4.6998

*rpn\Free()
*rpn.IRPN = NewRPN()

;Example basic Calculator 
Global strinput.s,memory.s,ev,evg,evt
;{
Enumeration
  #output
  #BBack
  #BCE
  #BC
  #BL
  #BR
  #BMC
  #B7
  #B8
  #B9
  #BDIV
  #Bsqrt
  #BMR
  #B4
  #B5
  #B6
  #BMUL
  #BPer
  #BMS
  #B1
  #B2
  #B3
  #BMIN
  #B1X
  #BMP
  #B0
  #BPM
  #BDOT
  #BPLUS
  #BEQ
EndEnumeration
;}
OpenWindow(0,0,0,240,230,"calc")
StringGadget(#Output,0,0,240,30,"")
;{-
ButtonGadget(#BBack,0,30,40,40,"<-")
ButtonGadget(#BCE,40,30,40,40,"CE")
ButtonGadget(#BC,80,30,40,40,"C")
ButtonGadget(#BL,120,30,40,40,"(")
ButtonGadget(#BR,160,30,40,40,")")

;}-
;{-
ButtonGadget(#BMC,0,70,40,40,"MC")
ButtonGadget(#B7,40,70,40,40,"7")
ButtonGadget(#B8,80,70,40,40,"8")
ButtonGadget(#B9,120,70,40,40,"9")
ButtonGadget(#Bdiv,160,70,40,40,Chr(247))
ButtonGadget(#Bsqrt,200,70,40,40,"sqr")
;}
;{
ButtonGadget(#BMR,0,110,40,40,"MR")
ButtonGadget(#B4,40,110,40,40,"4")
ButtonGadget(#B5,80,110,40,40,"5")
ButtonGadget(#B6,120,110,40,40,"6")
ButtonGadget(#BMUL,160,110,40,40,"x")
ButtonGadget(#BPer,200,110,40,40,"%")
;}
;{
ButtonGadget(#BMS,0,150,40,40,"MS")
ButtonGadget(#B1,40,150,40,40,"1")
ButtonGadget(#B2,80,150,40,40,"2")
ButtonGadget(#B3,120,150,40,40,"3")
ButtonGadget(#BMIN,160,150,40,40,"-")
ButtonGadget(#B1X,200,150,40,40,"1/x")
;}
;{
ButtonGadget(#BMP,0,190,40,40,"M+")
ButtonGadget(#B0,40,190,40,40,"0")
ButtonGadget(#BPM,80,190,40,40,Chr(177))
ButtonGadget(#BDOT,120,190,40,40,".")
ButtonGadget(#BPLUS,160,190,40,40,"+")
ButtonGadget(#BEQ,200,190,40,40,"=")
;}

Repeat
 
  ev=WaitWindowEvent()
  If ev <> 0
    evg = EventGadget()
    evt = EventType()
   
    If evt = #PB_EventType_LeftClick       
     
      Select evg
        Case #B0
          strinput + "0"
        Case #B1
          strinput + "1"
        Case #B2
          strinput + "2"
        Case #B3
          strinput + "3"
        Case #B4
          strinput + "4"
        Case #B5
          strinput + "5"
        Case #B6
          strinput + "6"
        Case #B7
          strinput + "7"
        Case #B8
          strinput + "8"
        Case #B9
          strinput + "9"
        Case #BPLUS
          strinput + "+"
        Case #BMIN
          strinput + "-"
        Case #BMul
          strinput + "*"
        Case #BDIV
          strinput + "/"
        Case #BDOT
          strinput +"."
        Case #B1X
          strinput = "1/(" + strinput + ")"
        Case #Bsqrt
          strinput + "sqrt"
        Case #BL 
          strinput + "("
        Case #BR
          strinput + ")"
        Case #BPer
          Define ct,strval.s,sop.s
          ct=Len(strinput)
          While *rpn\IsNumeric(Mid(strinput,ct,1)) And ct > 0
            ct-1
          Wend 
          strval = Right(strinput,Len(strinput)-ct)
          sop = Mid(strinput,ct,1)
          strinput = Left(strinput,ct)
          If sop <> "*" And sop <> "/"
            strinput + "(" + strval + "*(" + strval + "/100))"
          Else
            strinput + "(" + strval + "/100)" 
          EndIf   
          strinput = *rpn\eval(strinput) 
        Case #BPM
          strinput = "-(" + strinput + ")"
        Case #BC
          strinput = ""
        Case #BCE
          strinput =""
          memory = ""
        Case #BMS
          memory = strinput
        Case #BMP
          memory = *rpn\eval(strinput + "+" + memory)
        Case #BMR
          strinput + memory
        Case #BMC
          memory = ""
        Case #BEQ
          If strinput =""
            strinput = GetGadgetText(#output)
          EndIf
          If strinput <> ""
            strinput = *rpn\eval(strinput)
          EndIf   
      EndSelect
      If evg
        SetGadgetText(#output,strinput)
      EndIf
    EndIf
  EndIf
Until ev = #PB_Event_CloseWindow

CompilerEndIf

Post by **idle** » Sat Mar 26, 2011 6:24 am

currently supports
"+ - * / "% ^ << >>
~ ! | & bitwise note ~ =nand
> < >= <= <> == ternary operators
you can use either ? or just two : : eg a >= b ? x : y or a >= b : x : y
sin cos tan
variables

may extend variables to include types and thinking about adding functions

you still need to add a space between each operand and operator
will fix it at some point but for now it'll do.

EvalRpn("( a = 5 b = 4 ) cc = ( a * b ) cc * 2 + cc > 10 ? 10 : cc") ;cc = 4*5*2 : if cc > 10 : 10 : else cc : endif
Evalrpn("5 + ( ( 1 + 2 ) * 4 ) - 3")
Evalrpn("5.12 + sin ~ ( 3 * 4 )")

I haven't tested if the ternary operators beyond the examples yet.

Peyman · Post by **Peyman** » Sun Mar 27, 2011 9:28 pm

very interesting job,
thanks for sharing

.

Post by **idle** » Sun Mar 27, 2011 9:54 pm

thanks

I added string variables to it this morning but I don't think I was awake enough, there's probably a much better way to do it.
while it's untyped you still need to cast the variables and the evalops has become a bit convoluted.

Post by **idle** » Sat Apr 30, 2011 12:09 am

added a calculator example
use buttons or directly input an expression in the display.
no error checking.

Crusiatus Black · Post by **Crusiatus Black** » Fri May 11, 2012 11:55 pm

Hey there. I'm trying out this code and it is absolutely lovely, however
if I experiment with negative numbers a bit, I got some weird behaviour.

Apparently, *v2 is pointing to a 0 address when I use expressions like
100 ! -110
or like
100 +- 33

What might be causing this? Thanks.

Post by **idle** » Sat May 12, 2012 12:12 am

I don't think I figured out how to address the case of unary negation
but maybe I can take another look and see if I can figure it out

only way to make it work at the moment is to do it like
eval("100 + (0-33)")

Tenaja · Post by **Tenaja** » Sat May 12, 2012 1:43 am

That's a pretty cool deal.

I had an error compiling... if you change your procedures pop and push to do_pop and do_push, it will compile with ASM enabled. For future flexibility, I always avoid asm keywords outside of asm use.

Post by **idle** » Sat May 12, 2012 2:07 am

Thanks, it's not often I get complemented for buggy hacks

I just made a quick and dirty fix to handle unary negation but it required that I change the precedence of the "-" symbol
so it may cock up in compound statements without parenthesise

Also renamed the push and pop procedures.

Crusiatus Black · Post by **Crusiatus Black** » Sat May 12, 2012 12:38 pm

Thanks for taking a look at it, it really is a nice script!
Good job ^^

Post by **idle** » Fri Oct 11, 2019 6:02 am

Updated to work with unicode
and added fix for unary negation, hope it's right.
also at top post

Code: Select all

; Author: IDLE
; Date: 11,10,2019
; PB version: v5.62 windows 
; Version 0.53
; Updated for PB 5.62 
; added fix for unary negation 
; Date: 26,4, 2011
; PB version: v4.51 linux

; Version 0.52  
; ---------------------------------------------------------------------------------------------------------------
; Description:
; ---------------------------------------------------------------------------------------------------------------
; RPN interpretor (Reverse Polish Notation) 
; parse infix to RPN and calculates results 
; http://en.wikipedia.org/wiki/Reverse_Polish_notation
; supported operators
; + - * / "% ^ << >>
; ~ ! | &  bitwise 
; > < >= <= <> ==  ternary operators  eg a > b ? x : y  or  a > b : x : y  or a > b x y   
; sin cos tan sqrt
; variables numeric and strings 
EnableExplicit 

Enumeration 10
  #RPN_IsNumeric
  #RPN_IsAlpha
  #RPN_IsSymbol 
  #RPN_IsOther 
EndEnumeration

Structure RPN_Variables     
  len.i
  type.i
  num.d
  str.s
EndStructure

Structure RPN_Class
  *vt
  StackCounter.i
  rpn.s
  Map tokens.i()
  Map var.RPN_Variables()
  List stack.s()
EndStructure   

Declare.s RPN_Eval(*this.RPN_Class,expr.s)
Declare RPN_IsNumeric(*this.RPN_Class,strin.s) 
Declare RPN_Free(*this.RPN_Class) 

Interface IRPN 
  Eval.s(expr.s) 
  IsNumeric(expr.s) 
  Free() 
EndInterface   

DataSection: VT_RPN: 
  Data.i @RPN_Eval()
  Data.i @RPN_IsNumeric() 
  Data.i @RPN_Free() 
EndDataSection   

Procedure NewRPN() 
  Protected *this.RPN_Class 
  *this = AllocateStructure(RPN_Class) 
  If *this 
    *this\tokens("(") =1
    *this\tokens("+") =4
    *this\tokens("-")=4
    *this\tokens("_")=8
    *this\tokens("*")=5
    *this\tokens("/")=5
    *this\tokens("%")=7
    *this\tokens("^")=5
    *this\tokens(">>")=7
    *this\tokens("<<")=7
    *this\tokens("!")=6
    *this\tokens("&")=6
    *this\tokens("|")=6
    *this\tokens("~")=8
    *this\tokens("=")=8
    *this\tokens(">")=4
    *this\tokens("<")=4
    *this\tokens(">=")=4
    *this\tokens("<=")=4
    *this\tokens("<>")=4
    *this\tokens("==")=4 
    *this\tokens(")")=1
    *this\tokens("sin")=5
    *this\tokens("cos")=5
    *this\tokens("tan")=5
    *this\tokens("?")=0
    *this\tokens(":")=0
    *this\tokens("sqrt")=5
    *this\vt = ?VT_RPN 
    ProcedureReturn *this 
  EndIf   

EndProcedure  

Procedure RPN_Free(*this) 
  ClearStructure(*this,RPN_Class) 
  FreeStructure(*this) 
EndProcedure 

Procedure RPN_IsNumeric(*this,strin.s) 
  Protected char.i
  If strin <> ""
  char = PeekC(@strin)
  If char = 45 Or (char >=48 And char <=57) 
    ProcedureReturn 1
  Else  
    ProcedureReturn 0
  EndIf      
  EndIf 
EndProcedure

Procedure RPN_NewVar(*this.RPN_Class,v.s,val.s)
  Protected *v
  
  If RPN_IsNumeric(*this,val)  
    *this\var(v)\num = ValD(val) 
    *this\var(v)\len = SizeOf(Double)
    *this\var(v)\type = #RPN_IsNumeric
  Else 
    *this\var(v)\str = val 
    *this\var(v)\type = #RPN_IsAlpha
    *this\var(v)\len = Len(val) 
  EndIf   
  
EndProcedure 

Procedure RPN_SetVar(*this.RPN_Class,v.s,val.s)
  Protected *v,va.s,type.s
  
  If Not *this\var(v)\len
    RPN_NewVar(*this,v,val)
  Else 
    If *this\var(v)\type = #RPN_IsNumeric  
      *this\var(v)\num = ValD(val)
    Else 
      *this\var(v)\str = val 
      *this\var(v)\len = Len(val) 
    EndIf    
    
  EndIf   
EndProcedure 

Procedure RPN_Push(*this.RPN_Class,token.s)
  Static ct,top.s
  If token = "("
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  ElseIf *this\StackCounter = 0   
    AddElement(*this\stack())
    *this\stack()= token
    *this\StackCounter+1
  Else
    top = *this\stack()
    While *this\tokens(top) > *this\tokens(token) And *this\StackCounter > 0
      *this\rpn + *this\stack() + " "
      DeleteElement(*this\stack())
      *this\StackCounter-1
    Wend
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  EndIf
  
EndProcedure

Procedure RPN_Pop(*this.RPN_Class,cond.s)
  Protected token.s
  While *this\StackCounter > 0
    token = *this\stack()
    If token = cond
      DeleteElement(*this\stack())
      *this\StackCounter-1
      Break
    Else
      *this\rpn + token + " "
    EndIf
    DeleteElement(*this\stack())
    *this\StackCounter-1
  Wend
EndProcedure

Procedure RPN_InfixToRpn(*this.RPN_Class,expr.s)
  Protected len,a,b,c,char,state,token.s,Tstate,lstate,ltoken.s 
  
  len = StringByteLength(expr)
  
  While a < len 
    b=a
    token=""
    While b < len
      char = PeekC(@expr+b)
      If (char = '.' And state = #RPN_IsNumeric) Or (char >='0' And char <='9') 
        state = #RPN_IsNumeric
      ElseIf (char = '.' And state = #RPN_IsAlpha) Or (char >='A' And char <='Z')  
        state = #RPN_IsAlpha 
      ElseIf char >='a' And char <='z'
        state = #RPN_IsAlpha 
      ElseIf char <> ' '  
        state = #RPN_IsSymbol
      Else 
        state = #RPN_IsOther
      EndIf 
      If Not Tstate 
        Tstate = state 
      EndIf   
      If Tstate <> state 
        Break
      Else 
        token + Chr(char)
        If (char >= '(') And (char <='+') Or char = '-' Or char = '/' Or char = '=' Or char ='!' Or char = '^' Or char = '_' Or char = '~'
          b+SizeOf(Character)
          Break 
        EndIf    
      EndIf   
      b+SizeOf(Character)
    Wend       
    a=b      
    
    If Tstate = #RPN_IsSymbol
      If token = ")"
        RPN_Pop(*this,"(")
      ElseIf *this\tokens(token)
        If ((lstate = #RPN_IsSymbol Or lstate =0) And token = "-")  
          If (ltoken <> ")" And Not RPN_IsNumeric(*this,ltoken))
            token = "_"
          EndIf   
        EndIf   
        RPN_Push(*this,token)
      EndIf   
    ElseIf tstate = #RPN_IsAlpha
      If *this\tokens(token)
        RPN_Push(*this,token)
      Else 
        *this\Rpn + token + " "   
      EndIf    
    ElseIf tState = #RPN_IsNumeric 
      *this\Rpn + token + " "   
    EndIf   
    Tstate = state
    lstate = state  
    ltoken = token
  Wend   
  RPN_Pop(*this,"end")
  *this\rpn = Trim(*this\rpn)
  
EndProcedure

Macro _RPN_Pop(op,v)
  If ListSize(*this\stack()) > 0
    op = *this\stack()
    If *this\var(op)\type > 0
      *v = @*this\var(op)
      vr\type = #RPN_IsNumeric 
    Else   
      If RPN_IsNumeric(*this,op)
        *v = @t#v
        *v\num = ValD(op)
        *v\str = ""
        *v\type = #RPN_IsNumeric 
        vr\type =#RPN_IsNumeric 
      Else  
        *v = @t#v
        *v\num = 0
        *v\str = op
        *v\type = #RPN_IsAlpha
        vr\type =#RPN_IsAlpha
      EndIf  
    EndIf   
    DeleteElement(*this\stack())
  EndIf   
EndMacro

Macro _RPN_Assign(cond)
  If cond
    If *v2\type = #RPN_IsNumeric 
      vr\num = *v2\num
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str
    EndIf   
  Else
    If *v1\type = #RPN_IsNumeric
      vr\num = *v1\num
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v1\str
    EndIf
  EndIf    
EndMacro 

Procedure RPN_EvalOperator(*this.RPN_Class,operator.s)
  Protected op1.s,op2.s,op3.s,op4.s,result.s
  Protected t1.q,tq.q,rq.q,t2
  Protected *v1.RPN_Variables,*v2.RPN_Variables,*v3.RPN_Variables,*v4.RPN_Variables 
  Protected tv1.RPN_Variables,tv2.RPN_Variables,tv3.RPN_Variables,tv4.RPN_Variables
  Protected vr.RPN_Variables 
  _RPN_Pop(op1,v1)
  If operator <> "~" And operator <> "sin" And operator <> "cos" And operator <> "tan" And  operator <> "sqrt" And operator <> "_"
    _RPN_Pop(op2,v2)
    If op2 <> ""
      *this\StackCounter-2
    Else 
      *this\StackCounter-1
    EndIf   
  Else
    *this\StackCounter-1
  EndIf
  If operator = "+"
    If *v1\type = #RPN_IsNumeric And  *v2\type = #RPN_IsNumeric
      vr\num = *v2\num + *v1\num 
      vr\type = #RPN_IsNumeric
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str + *v1\str 
    EndIf   
  ElseIf  operator = "-"
    If op2 <> ""
      vr\num = *v2\num - *v1\num
    Else 
      vr\num = -*v1\num  
    EndIf  
  ElseIf operator = "*"
    vr\num = *v2\num * *v1\num
  ElseIf operator = "/"
    If *v1\num <> 0
      vr\num = *v2\num / *v1\num
    EndIf   
  ElseIf operator = "%"
    vr\num =Mod(*v2\num,*v1\num)
  ElseIf operator = "^"
    vr\num = Pow(*v2\num,*v1\num)
  ElseIf operator =">"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num > *v3\num)
  ElseIf operator ="<"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num < *v3\num)
  ElseIf operator =">="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num >= *v3\num)
  ElseIf operator ="<="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num <= *v3\num)
  ElseIf operator ="<>"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num <> *v3\num)
    Else
      _RPN_Assign(*v4\str <> *v3\str)
    EndIf 
  ElseIf operator ="=="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num = *v3\num)
    Else
      _RPN_Assign(*v4\str = *v3\str)
    EndIf 
  ElseIf operator =">>"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 >> t1
    vr\num = rq
  ElseIf operator ="<<"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 << t1
    vr\num = rq
  ElseIf operator ="!"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 ! t1
    vr\num = rq
  ElseIf operator ="&"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 & t1
    vr\num = rq
  ElseIf operator ="|"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 | t1
    vr\num = rq   
  ElseIf operator ="~"
    t1 = *v1\num
    rq = ~t1
    vr\num = rq
  ElseIf operator ="_"
    t1 = *v1\num
    rq = -t1
    vr\num = rq  
  ElseIf operator ="sin"
    vr\num = Sin(*v1\num)
  ElseIf operator ="cos"
    vr\num = Cos(*v1\num)
  ElseIf operator ="tan"
    vr\num = Tan(*v1\num)
  ElseIf  operator = "sqrt"
    vr\num = Sqr(*v1\num)
  EndIf   
  If operator = "="
    If *v2 And *v2\type = #RPN_IsNumeric  
      RPN_SetVar(*this,op1,op2)
    Else
      RPN_SetVar(*this,op2,op1)
    EndIf   
  Else
    If vr\type = #RPN_IsNumeric
      result = StrD(vr\num)
    Else 
      result = vr\str
    EndIf   
    AddElement(*this\stack())
    *this\stack() = result
    *this\StackCounter+1
  EndIf
EndProcedure

Procedure.s RPN_Eval(*this.RPN_Class,expr.s)
  Protected token.s,len,ct,a,result.s
  
  ClearList(*this\stack())
  ClearMap(*this\var())
  *this\StackCounter=0
  *this\rpn = ""
  RPN_InfixToRpn(*this,expr)
  len = Len(*this\rpn)
  ct = CountString(*this\rpn," ")
  For a = 1 To ct+1
    token = StringField(*this\rpn,a," ")
    If *this\tokens(token)
      RPN_EvalOperator(*this,token) 
    ElseIf token <> ":"  And token <> "?" 
      AddElement(*this\stack())
      *this\stack() = token
      *this\StackCounter+1
    EndIf   
  Next   
  
  result.s = *this\stack()
  DeleteElement(*this\stack())
  
  ProcedureReturn result
  
EndProcedure   

CompilerIf #PB_Compiler_IsMainFile 
  
Define *rpn.IRPN = NewRPN() 
;examples ************************************************************************************* 
Debug *rpn\Eval("6*(3-2)") ;6
Debug *rpn\Eval("-5+-3"); -8
Debug *rpn\eval("(varA=Hello varB=World c=2) 6>>1 > c ? (varA+varB) : (varB+varA)"); "HelloWorld"
Debug *rpn\eval("(varA=Hello varB=World c=4) 6>>1 > c ? (varA+varB) : (varB+varA)"); "WorldHello"
Debug *rpn\eval("(a=5  b=4) (a*b*2)") ;40    
Debug *rpn\eval("(a=5  b=4) c= (a*b*2) : c > 39 ? true : false"); True
Debug *rpn\eval("(a=5 b=4) cc= (a*b*2) cc + cc < (a*b) ? true : cc"); 80
Debug *rpn\eval("1+-3"); -2
Debug *rpn\eval("5+((1+2)*4)-3"); 14
Debug *rpn\eval("5.12+sin(-13)"); 4.6998
Debug 5.12+Sin(-13); 4.6998 

*rpn\Free() 
*rpn.IRPN = NewRPN()

;Example basic Calculator  
Global strinput.s,memory.s,ev,evg,evt
;{
Enumeration 
  #output
  #BBack
  #BCE
  #BC
  #BL
  #BR
  #BMC
  #B7
  #B8
  #B9
  #BDIV
  #Bsqrt
  #BMR
  #B4
  #B5
  #B6
  #BMUL
  #BPer
  #BMS
  #B1
  #B2
  #B3
  #BMIN
  #B1X
  #BMP
  #B0
  #BPM
  #BDOT
  #BPLUS
  #BEQ 
EndEnumeration
;} 
OpenWindow(0,0,0,240,230,"calc")
StringGadget(#Output,0,0,240,30,"")
;{-
ButtonGadget(#BBack,0,30,40,40,"<-")
ButtonGadget(#BCE,40,30,40,40,"CE")
ButtonGadget(#BC,80,30,40,40,"C")
ButtonGadget(#BL,120,30,40,40,"(")
ButtonGadget(#BR,160,30,40,40,")")

;}-
;{-
ButtonGadget(#BMC,0,70,40,40,"MC")
ButtonGadget(#B7,40,70,40,40,"7")
ButtonGadget(#B8,80,70,40,40,"8")
ButtonGadget(#B9,120,70,40,40,"9")
ButtonGadget(#Bdiv,160,70,40,40,Chr(247))
ButtonGadget(#Bsqrt,200,70,40,40,"sqr")
;}
;{
ButtonGadget(#BMR,0,110,40,40,"MR")
ButtonGadget(#B4,40,110,40,40,"4")
ButtonGadget(#B5,80,110,40,40,"5")
ButtonGadget(#B6,120,110,40,40,"6")
ButtonGadget(#BMUL,160,110,40,40,"x")
ButtonGadget(#BPer,200,110,40,40,"%")
;}
;{
ButtonGadget(#BMS,0,150,40,40,"MS")
ButtonGadget(#B1,40,150,40,40,"1")
ButtonGadget(#B2,80,150,40,40,"2")
ButtonGadget(#B3,120,150,40,40,"3")
ButtonGadget(#BMIN,160,150,40,40,"-")
ButtonGadget(#B1X,200,150,40,40,"1/x")
;}
;{
ButtonGadget(#BMP,0,190,40,40,"M+")
ButtonGadget(#B0,40,190,40,40,"0")
ButtonGadget(#BPM,80,190,40,40,Chr(177))
ButtonGadget(#BDOT,120,190,40,40,".")
ButtonGadget(#BPLUS,160,190,40,40,"+")
ButtonGadget(#BEQ,200,190,40,40,"=")
;}

Repeat 
  
  ev=WaitWindowEvent()
  If ev <> 0 
    evg = EventGadget() 
    evt = EventType()
    
    If evt = #PB_EventType_LeftClick       
      
      Select evg 
        Case #B0 
          strinput + "0"
        Case #B1 
          strinput + "1"
        Case #B2 
          strinput + "2"
        Case #B3 
          strinput + "3"
        Case #B4
          strinput + "4"
        Case #B5
          strinput + "5"
        Case #B6
          strinput + "6"
        Case #B7 
          strinput + "7"
        Case #B8
          strinput + "8"
        Case #B9 
          strinput + "9"
        Case #BPLUS
          strinput + "+"
        Case #BMIN 
          strinput + "-"
        Case #BMul
          strinput + "*"
        Case #BDIV 
          strinput + "/"
        Case #BDOT
          strinput +"."
        Case #B1X 
          strinput = "1/(" + strinput + ")"
        Case #Bsqrt
          strinput + "sqrt" 
        Case #BL  
          strinput + "("
        Case #BR
          strinput + ")"
        Case #BPer 
          Define ct,strval.s,sop.s
          ct=Len(strinput)
          While *rpn\IsNumeric(Mid(strinput,ct,1)) And ct > 0
            ct-1
          Wend  
          strval = Right(strinput,Len(strinput)-ct)
          sop = Mid(strinput,ct,1)
          strinput = Left(strinput,ct)
          If sop <> "*" And sop <> "/" 
            strinput + "(" + strval + "*(" + strval + "/100))"
          Else 
            strinput + "(" + strval + "/100)"  
          EndIf   
          strinput = *rpn\eval(strinput)  
        Case #BPM 
          strinput = "-(" + strinput + ")"
        Case #BC
          strinput = ""
        Case #BCE 
          strinput =""
          memory = ""
        Case #BMS
          memory = strinput 
        Case #BMP
          memory = *rpn\eval(strinput + "+" + memory) 
        Case #BMR 
          strinput + memory
        Case #BMC
          memory = ""
        Case #BEQ 
          If strinput =""
            strinput = GetGadgetText(#output)
          EndIf 
          If strinput <> ""
            strinput = *rpn\eval(strinput)
          EndIf   
      EndSelect 
      If evg
        SetGadgetText(#output,strinput)
      EndIf
    EndIf 
  EndIf 
Until ev = #PB_Event_CloseWindow 

CompilerEndIf

Michael Vogel · Post by **Michael Vogel** » Fri Oct 11, 2019 6:26 am

Hm, just did a quick look, but I fear I must spend a little bit more time now...

I tried to get the result of 6 x (3 - 2), which should be 6, but the calculator (and the eval function) returns -6

As said, mut have a deeper look (thought I would be able to enter it in RPN style: 6 # 3 # 2 - x)

Post by **idle** » Fri Oct 11, 2019 6:53 am

yes something went wrong, the problem is that "-" is both unary and binary
so it's a little tricky, don't know if I've fixed it or not but I've updated the posts
with your example.

Mistrel · Post by **Mistrel** » Fri Oct 11, 2019 7:58 am

I wrote something similar a couple of years ago. RPN notation is pretty cool and does have some modern use cases. It's a fun exercise that I think every programmer should try at least once; kind of like fizzbuzz but harder.

Post by **idle** » Fri Oct 11, 2019 8:30 am

Mistrel wrote:I wrote something similar a couple of years ago. RPN notation is pretty cool and does have some modern use cases. It's a fun exercise that I think every programmer should try at least once; kind of like fizzbuzz but harder.

I obviously enjoyed it, I wrote it over a few early mornings when I couldn't sleep.

PureBasic Forums - English

RPN Interpreter Eval function

RPN Interpreter Eval function

Re: RPN interpretor 0.42

Re: RPN interpretor 0.5

Re: RPN interpretor 0.5

Re: RPN interpretor 0.52

Re: RPN interpretor 0.52

Re: RPN interpretor 0.52

Re: RPN interpretor 0.52

Re: RPN interpretor 0.52

Re: RPN interpretor 0.52

Re: RPN Interpreter Eval function

Re: RPN Interpreter Eval function

Re: RPN Interpreter Eval function

Re: RPN Interpreter Eval function

Re: RPN Interpreter Eval function