PureBasic Forums - English

Posted: **Thu Jan 09, 2025 7:05 pm**

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

Posted: **Thu Jan 09, 2025 10:16 pm**

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)".

Posted: **Fri Jan 10, 2025 5:33 pm**

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,

Posted: **Sat Jan 11, 2025 11:16 am**

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.

PureBasic Forums - English

RPN Processor Module 'reverse polish notation'

RPN Processor Module 'reverse polish notation'

Re: RPN Processor Module 'reverse polish notation'

Re: RPN Processor Module 'reverse polish notation'

Re: RPN Processor Module 'reverse polish notation'