[Done] 6.40a1 Purifier
Posted: Tue Jan 27, 2026 11:31 pm
issue with the purifier, can't identify what the problem is though, it crashes with an IMA write error address 0
line 226 of RPN_InfixToRPN function but works without the purifier.
line 226 of RPN_InfixToRPN function but works without the purifier.
Code: Select all
; Author: IDLE
; Date: 17,1,2026
; PB version: v6.30 windows
; Version 0.54
; Updated for Pb 6.30 Mk-Soft
; 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
Interface IRPN
Eval.s(expr.s)
IsNumeric(expr.s)
Free()
EndInterface
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
DataSection: VT_RPN:
Data.i @RPN_Eval()
Data.i @RPN_IsNumeric()
Data.i @RPN_Free()
EndDataSection
; ****
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
Debug *rpn\Eval("sqrt((5^2)+(7^2)+(11^2)+((8-2)^2))")
Debug Sqr(Pow(5,2)+Pow(7,2)+Pow(11,2)+Pow((8-2),2))
*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
Case #BBack
strinput = Left(strinput, Len(strinput) - 1)
EndSelect
If evg
SetGadgetText(#output,strinput)
EndIf
EndIf
EndIf
Until ev = #PB_Event_CloseWindow
CompilerEndIf