RPN Processor Module 'reverse polish notation'

Share your advanced PureBasic knowledge/code with the community.
Post Reply
SMaag
Enthusiast
Enthusiast
Posts: 302
Joined: Sat Jan 14, 2023 6:55 pm
Location: Bavaria/Germany

RPN Processor Module 'reverse polish notation'

Post by SMaag »

Here is the first approach of my RPN Processor Module for calculationg math expressions in RPN form
RPN is 'reverse polish notation'. For some it is well known from HP calculators.

This is the first Brainstorming version. I publish it in this very early state because of the Function Graph calculator from Michael Vogel.
viewtopic.php?t=85968

Because converting mathematical expressions into a RPN form might be the solution for compiling math expressions into a form what can be processed fast and easy.
My RPN version supports user defined parameters in an esay way. So it is possible to calculate expressions like
y = ax² + bx +c

The compild RPN Programm has only one type of command. A ProcedureCall with a PointerParameter to a value.
So each operation in the compiled RPN Programm consists of 2 Pointer valus. For processing that we do not need
any If statment. Just calling a Procedure with one Parameter thats all!

Module RPN : it generally works, but I'm sure it is not Error free! It's my Brainstorming version

Code: Select all

; ===========================================================================
;  FILE : PbFw_Module_RPN.pb
;  NAME : Module RPN Calculator Emulation [RPN::]
;  DESC : RPN "Reverse polish notation" calculator functions
;  DESC : For emulating a RPN Calculator or to process 'compiled' RPN programs
;  DESC : 
; ===========================================================================
;
; AUTHOR   :  Stefan Maag
; DATE     :  2025/01/06
; VERSION  :  0.1 Brainstorming Version
; COMPILER :  PureBasic 6.0 and higher
;
; LICENCE  :  MIT License see https://opensource.org/license/mit/
;             or \PbFramWork\MitLicence.txt
; ===========================================================================
; ChangeLog: 
;{ 
;  
;}
;{ TODO:
;}
; ===========================================================================

;- --------------------------------------------------
;- Include Files
;  --------------------------------------------------

;XIncludeFile "PbFw_Module_PbFw.pb"         ; PbFw::     FrameWork control Module
; XIncludeFile ""

DeclareModule RPN   ; reverse polish notation
  EnableExplicit
  
  Enumeration ERPN_FUNCTION 0
    ; Fuctions without Parameter value
    #RPN_CLR
    #RPN_CLRALL
    #RPN_PUSH
    #RPN_POP
    #RPN_ADD
    #RPN_SUB
    #RPN_MUL
    #RPN_DIV
    
    ; Fuctions with Parameter value
    #RPN_LD
    #RPN_LD2
    #RPN_LD_ADD
    #RPN_LD_SUB
    #RPN_LD_MUL
    #RPN_LD_DIV
    #RPN_LD_MIN
    #RPN_LD_MAX
    #RPN_LD_SQ        ; Load Square : x²
    #RPN_LD_CUB       ; Load Cubic  : x³
    #RPN_LD_SQRT      ; SquareRoot
    
    ; Memory Functions
    #RPN_MCLR  ; Clear Memory
    #RPN_MADD  ; Add to Memory   
    #RPN_MRET  ; Return Memory to A1
    
    ; last Function
    #RPN_GET        ; GET has to be the last constant, because it is used to DIM Array RPN_ProcPtr(#RPN_GET) 
  EndEnumeration
  
  Structure TRPN_PROG_ELEMENT
    *pProc
    *pValue.Double
  EndStructure 
  
  Declare GetRpnProcPointer(ProcNo = #RPN_CLRALL)
  
  Declare.i CallRPN(RpnFctNo = #RPN_CLR, *value.Double=0)
  Declare.d GetResult()
  Declare.d RunRpnProg(Array RPN_PROC.TRPN_PROG_ELEMENT(1), NoOfElements.i=#PB_Default)
  
EndDeclareModule

Module RPN
  
  EnableExplicit
  ; RPN Processor Registers
  ; ----------
  ;    M            ; Memory Register for M+ Calculator function
  ; ----------
  ;    A2           ; Akku 2
  ; ----------
  ;    A1           ; Akku 1
  ; ----------
  
  Structure TRpnRegisters
    A1.d
    A2.d
    M.d
  EndStructure
  
  Global RPN.TRpnRegisters
  
  Global Dim RPN_ProcPtr.i(#RPN_GET)        ; the Array with the Pointers to all RPN_Functions
  
  ; This is the general Prototype function for calling any RPN_Function
  ; We same Prototype for all RPN_Functions, so we do not need any IF or SELECT statment to process
  ; compiled RPN programms. Any RPN Command in a compiled program consist of to values
  ; *pProc "Pointer to the RPN_Function : *pValue "Pointer to the Value as Double -> see the TRPN_PROG_ELEMENT Stuct
  ; A compiled RPN program is only an Array or a List of Pointers
  Prototype InvokeUpnFkt(*value.Double)
  Global InvokeUpnFkt.InvokeUpnFkt
  
  Global _RpnDummy.Double
  
  ;- ----------------------------------------
  ;- Public
  ;- ----------------------------------------
  
  Procedure.i GetRpnProcPointer(ProcNo = #RPN_CLRALL)
  
    ProcedureReturn RPN_ProcPtr(ProcNo)  
  EndProcedure
  
  Procedure CallRPN(RpnFctNo = #RPN_CLR, *value.Double=0)
    
    If *value = 0
      *value = _RpnDummy
    EndIf
    
    InvokeUpnFkt = RPN_ProcPtr(RpnFctNo)
    InvokeUpnFkt(*value)

  EndProcedure
  
  Procedure.d GetResult()
    ProcedureReturn RPN\A1
  EndProcedure
  
  Procedure.d RunRpnProg(Array RPN_PROC.TRPN_PROG_ELEMENT(1), NoOfElements.i=#PB_Default)
    ; process a RPN Program of multiple operations stored in an Array
    Protected res.d, I, N
    
    If NoOfElements = #PB_Default   ; #PB_Default = -1
      N = ArraySize(RPN_PROC())
    ElseIf NoOfElements > (ArraySize(RPN_PROC()) + 1)
      N = ArraySize(RPN_PROC())
    Else
      n = NoOfElements - 1
    EndIf
    
    For I = 0 To N
      InvokeUpnFkt = RPN_PROC(I)\pProc
      InvokeUpnFkt(RPN_PROC(I)\pValue)
    Next
 
    ProcedureReturn RPN\A1
  EndProcedure

  ;- ----------------------------------------
  ;- Private
  ;- ----------------------------------------
  
  Macro mac_DebugProc()
    Debug #PB_Compiler_Procedure
  EndMacro
  
  Macro mac_DebugProcWithPara(Para)
    Debug #PB_Compiler_Procedure + " : " + Para
  EndMacro
 
  Procedure CLR(*dummy)       ; Clear Akku1/2
    mac_DebugProc()
    With RPN
      \A1 = 0
      \A2 = 0
    EndWith   
  EndProcedure
  RPN_ProcPtr(#RPN_CLR) = @CLR()
  
  Procedure CLRALL(*dummy)       ; Clear Akku1/2 and Mem
    mac_DebugProc()
    With RPN
      \A1 = 0
      \A2 = 0
      \M = 0
    EndWith   
  EndProcedure
  RPN_ProcPtr(#RPN_CLRALL) = @CLRALL()

  Procedure PUSH(*dummy)      ; PUSH Akku1 to Akku2
    mac_DebugProc()
    With RPN
      \A2 = \A1
    EndWith      
  EndProcedure
  RPN_ProcPtr(#RPN_PUSH) = @PUSH()
  
  Procedure POP(*dummy)       ; POP Akku2 to Akku 1
    mac_DebugProc()
    With RPN
      \A1 = \A2
    EndWith      
  EndProcedure
  RPN_ProcPtr(#RPN_POP) = @POP()

  Procedure ADD(*dummy)       ; ADD A1 = A1 + A2
    With RPN
      \A1 = \A1 + \A2
      mac_DebugProcWithPara(\A1)
    EndWith      
  EndProcedure
  RPN_ProcPtr(#RPN_ADD) = @ADD()
  
  Procedure SUB(*dummy)       ; SUB A1=A2-A1
    With RPN
      \A1 = \A2 + \A1
      mac_DebugProcWithPara(\A1)
    EndWith      
  EndProcedure
  RPN_ProcPtr(#RPN_SUB) = @SUB()
  
  Procedure MUL(*dummy)
     With RPN
      \A1 = \A2 * \A1
      mac_DebugProcWithPara(\A1)
   EndWith      
  EndProcedure
  RPN_ProcPtr(#RPN_MUL) = @MUL()
  
  Procedure DIV(*dummy)
    With RPN
      \A1 = \A2 / \A1
      mac_DebugProcWithPara(\A1)
    EndWith      
  EndProcedure
  RPN_ProcPtr(#RPN_DIV) = @DIV()

  Procedure LD(*value.Double)     ; Load value to A1 and save old A1 in A2
   mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = *value\d
    EndWith      
  EndProcedure
  RPN_ProcPtr(#RPN_LD) = @LD()
 
  Procedure LD2(*value.Double)
    mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = *value\d
      \A1 = *value\d
    EndWith      
  EndProcedure
  RPN_ProcPtr(#RPN_LD2) = @LD2()
  
  Procedure LD_ADD(*value.Double)       ; LOAD & ADD : save A1 in A2 : A1 = A1 + value
    mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = \A1 + *value\d
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_ADD) = @LD_ADD()
  
  Procedure LD_SUB(*value.Double)       ; LOAD & SUB
   mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = \A1 - *value\d
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_SUB) = @LD_SUB()
  
  Procedure LD_MUL(*value.Double)       ; LOAD & MUL
    mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = \A1 * *value\d
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_MUL) = @LD_MUL()
  
  Procedure LD_DIV(*value.Double)       ; LOAD & DIV
    mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = \A1 / *value\d
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_DIV) = @LD_DIV()
  
  Procedure LD_MIN(*value.Double)       ; LOAD & MIN : A1 = Min(A1, value)
    mac_DebugProcWithPara(*value\d)
    With RPN
      If *value\d < \A1
        \A2 = \A1         ; greater Value in A1 to A2
        \A1 = *value\d    ; lower value as result to A1
      Else
        \A1 = \A2
        \A2 = *value\d
      EndIf     
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_MIN) = @LD_MIN()
  
  Procedure LD_MAX(*value.Double)       ; LOAD & MAX
    mac_DebugProcWithPara(*value\d)
    With RPN
      If *value\d > \A1
        \A2 = \A1         ; lower Value in A1 to A2
        \A1 = *value\d    ; greater value as result to A1
      Else
        \A1 = \A2
        \A2 = *value\d
      EndIf     
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_MAX) = @LD_MAX()
  
  Procedure LD_SQ(*value.Double)       ; LOAD SQuare
    mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = *value\d * *value\d
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_SQ) = @LD_SQ()

  Procedure LD_CUB(*value.Double)       ; LOAD & CUBic
    mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = *value\d * *value\d * *value\d
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_CUB) = @LD_CUB()
  
  Procedure LD_SQRT(*value.Double)       ; LOAD & SQRT SquareRoot
    mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = *value\d * *value\d * *value\d
    EndWith       
  EndProcedure
  RPN_ProcPtr(#RPN_LD_SQRT) = @LD_SQRT()
  
  Procedure MCLR(*dummy)                ; CLEAR Memory
    mac_DebugProc()
    With RPN
      \M = 0
     EndWith   
  EndProcedure
  RPN_ProcPtr(#RPN_MCLR) = @MCLR()
  
  Procedure MADD(*dummy)                ; M+ Function, Add to Memory
    With RPN
      \M = \M + \A1
      mac_DebugProcWithPara(\M)
     EndWith   
  EndProcedure
  RPN_ProcPtr(#RPN_MADD) = @MADD()
  
  Procedure MRET(*dummy)                ; MR Function, Return Memory to A1
    With RPN
      \A2 = \A1
      \A1 = \M
      mac_DebugProcWithPara(\A1)
     EndWith   
  EndProcedure
  RPN_ProcPtr(#RPN_MRET) = @MRET()

  Procedure GET(*Result.Double)       ; Get the Caculation Result : *Result\d = A1
    mac_DebugProcWithPara(*Result\d)
    With RPN
      *Result\d = \A1
    EndWith   
  EndProcedure
  RPN_ProcPtr(#RPN_GET) = @GET()

EndModule

CompilerIf #PB_Compiler_IsMainFile
 ; ----------------------------------------------------------------------
 ;  M O D U L E   T E S T   C O D E
 ; ---------------------------------------------------------------------- 
 
  EnableExplicit
  UseModule RPN
  
  Procedure CreateParableProg(Array RpnProg.TRPN_PROG_ELEMENT(1), *x, *a, *b, *c) ; creates the RPN Programm for a parabel function ax² + bx +c
    ; creates the compiled RPN Program for ; ax² + bx +c
    Protected I
    
    ; --------------------------------------------------
    ; !Thats the Programm Script we have to compile
    ; --------------------------------------------------   
    ; CLRALL    ; Clear Akku1/2 and Mem
    ;  --- ax² ---
    ; LD_SQ x     ; Load x² to A1
    ; LD_MUL a    ; Load & MUL a
    ; MADD        ; Add result to Mem
    ;  --- bx ---
    ; LD x
    ; LD_MUL b
    ; MRET        ; Return ax² from Mem
    ; ADD         ; Add to bx
    ; LD_ADD c    ; +c
    ; --------------------------------------------------
   
    Dim RpnProg(8)  ; we need 9 operations 0..9
    
    ; Create an entry for each operation in the RpnProg - Array
    ; CLRALL
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_CLRALL)  
    RpnProg(I)\pValue = 0
    I + 1
    ; LD_SQ x     ; Load x² to A1
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_LD_SQ)  
    RpnProg(I)\pValue = *x
    I + 1 
    ; LD_MUL a    ; Load & MUL a
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_LD_MUL)  
    RpnProg(I)\pValue = *a
    I + 1
    ; MADD        ; Add result to Mem
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_MADD)  
    RpnProg(I)\pValue = 0
    I + 1
    ; LD x
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_LD)  
    RpnProg(I)\pValue = *x
    I + 1
    ; LD_MUL b
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_LD_MUL)  
    RpnProg(I)\pValue = *b
    I + 1
    ; MRET        ; Return ax² from Mem
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_MRET)  
    RpnProg(I)\pValue = 0
    I + 1
    ; ADD         ; Add to bx
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_ADD)  
    RpnProg(I)\pValue = 0
    I + 1
    ; LD_ADD c    ; +c
    RpnProg(I)\pProc = GetRpnProcPointer(#RPN_LD_ADD)  
    RpnProg(I)\pValue = *c   
   
  EndProcedure
  
  Define.d y, x, a, b, c
  Define P.Double
  Define.i I
  
  Debug "--------------------------------------------------"
  Debug "  Test all Function calls"
  Debug "--------------------------------------------------"
 
  ; Fuctions with dummy Parameter
  CallRPN(#RPN_CLR)
  CallRPN(#RPN_CLRALL)
  CallRPN(#RPN_PUSH)
  CallRPN(#RPN_POP)
  CallRPN(#RPN_ADD)
  CallRPN(#RPN_SUB)
  CallRPN(#RPN_MUL)
  CallRPN(#RPN_DIV)
  
  ; Fuctions with Parameter value
  CallRPN(#RPN_LD, P)
  CallRPN(#RPN_LD2, P)
  CallRPN(#RPN_LD_ADD, P)
  CallRPN(#RPN_LD_SUB, P)
  CallRPN(#RPN_LD_MUL, P)
  CallRPN(#RPN_LD_DIV, P)
  CallRPN(#RPN_LD_MIN, P)
  CallRPN(#RPN_LD_MAX, P)
  CallRPN(#RPN_LD_SQ, P)
  CallRPN(#RPN_LD_CUB, P)
  CallRPN(#RPN_LD_SQRT, P)
  
  ; Memory Functions
  CallRPN(#RPN_MCLR, P)
  CallRPN(#RPN_MADD, P)
  CallRPN(#RPN_MRET, P)
  
  ; last Function
  CallRPN(#RPN_GET, P)
  
  Debug "--------------------------------------------------"
  Debug "  Test Loop(10) with x parameter "
  Debug "  y = x + c :  x = {1..10} c=1"
  Debug "--------------------------------------------------"

  For I = 1 To 10
    x = I 
    c = 1
    CallRPN(#RPN_LD, @c)
    CallRPN(#RPN_LD_ADD, @x)
    Debug "Result = " + StrD(GetResult())
    Debug ""
  Next
  
  Debug "--------------------------------------------------"
  Debug " Test compiled RPN Program for y = ax² + bx +c "
  Debug "--------------------------------------------------"

  Dim MyRpnProg.TRPN_PROG_ELEMENT(0)
  
  CreateParableProg(MyRpnProg(), @x, @a, @b, @c)
  
  a = 1 : b=1 : c = 0  ; -> y = x² + x
  
  For I = 1 To 10
    x=I
    y = RunRpnProg(MyRpnProg(), 99)  
    Debug "*******"
      Debug "y = " + StrD(y)  
    Debug "*******"
 Next 
  
CompilerEndIf
Top
User avatar
skywalk
Addict
Addict
Posts: 4211
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: RPN Processor Module 'reverse polish notation'

Post by skywalk »

Thanks for the post.
There are many eval programs within the forum.
You could also try using SQLite's built-in math.
Provided Fred compiled the sqlite3.lib with "-DSQLITE_ENABLE_MATH_FUNCTIONS"?
If not, you can compile your own dll and enable it with "UseSQLiteDatabase(#SQLITE_DLL_MYFNPATH$)".
Or you can build your own as an extension on the fly.
If you want algebra like "x^2", you would parse that as "pow(x,2)".
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
Top
marc_256
Addict
Addict
Posts: 835
Joined: Thu May 06, 2010 10:16 am
Location: Belgium
Contact:
Contact marc_256

Re: RPN Processor Module 'reverse polish notation'

Post by marc_256 »

Hallo Stefan,

This isn't correct ...

Code: Select all

 Procedure SUB(*dummy)       ; SUB A1=A2-A1
    With RPN
      \A1 = \A2 + \A1                                    <--------------------- \A1 = \A2 - \A1
      mac_DebugProcWithPara(\A1)
    EndWith      
  EndProcedure
  
  
  
Procedure LD_SQRT(*value.Double)       ; LOAD & SQRT SquareRoot
    mac_DebugProcWithPara(*value\d)
    With RPN
      \A2 = \A1
      \A1 = *value\d * *value\d * *value\d          <--------------- \A1 = Sqr (*value\d)
    EndWith
  EndProcedure
Marc,
- every professional was once an amateur - greetings from Pajottenland - Belgium -
PS: sorry for my english I speak flemish ...
Top
Axolotl
Addict
Addict
Posts: 802
Joined: Wed Dec 31, 2008 3:36 pm

Re: RPN Processor Module 'reverse polish notation'

Post by Axolotl »

SMaag wrote: Thu Jan 09, 2025 7:05 pm

Code: Select all

    ; last Function
    #RPN_GET        ; GET has to be the last constant, because it is used to DIM Array RPN_ProcPtr(#RPN_GET) 
  EndEnumeration 
  #RPN_Last = #PB_Compiler_EnumerationValue - 1     ; <= this is always the last constant in the enum above!!!
Hi SMaag,
thanks for sharing, just had a brief look and saw this comment above and would like to make a suggestion.
BTW: If you use code-pb and /code-pb instead of code and /code the source looks nicer IMHO.
Just because it worked doesn't mean it works.
PureBasic 6.04 (x86) and <latest stable version and current alpha/beta> (x64) on Windows 11 Home. Now started with Linux (VM: Ubuntu 22.04).
Top
Post Reply

Return to “Tricks 'n' Tips”