Simple programmable stack machine in VB.Net

Code:

---

Imports System.Runtime.CompilerServices

Public Class Form1
    '**********************************************************
    'This application demonstrates how we can use delegates and anonymous functions
    'to create a programmaable stack machine without having to create a language
    'parser or do lexical analysis etc. Effectively the host language, in this case
    'VB.Net, IS your scripting language. It's not just limited to stack machines. You can
    'create any kind of programmable computer within your program. It's particularly useful
    'in video game systems as it allows you to create programmable entities
    'in a generalized engine. What this means is that you can create a sophisticated game world
    'while keeping the engine itself isolated and relatively simple.
    '**********************************************************
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        Dim pt1 = New PointF(0, 0)
        Dim pt2 = New PointF(25, 26)


        'Calculate distance using our stack machine
        Debug.WriteLine(CalcDist(pt1, pt2))

        'We use this to verify our stack machine
        'program produces the correct result
        Debug.WriteLine(Math.Sqrt(((pt2.X - pt1.X) ^ 2) + (pt2.Y - pt1.Y) ^ 2))

    End Sub

    Private Function CalcDist(ByVal pt1 As PointF, ByVal pt2 As PointF) As Single
        'This function calculates the distance between two points
        'using a programmable stack machine for expression evaluation
        '*****************************************************************
        Dim l As New List(Of SMInst)

        '(x2-x1)^2
        l.Add(Sub(sm) sm.OP_Push(pt2.X))
        l.Add(Sub(sm) sm.OP_Push(pt1.X))
        l.Add(Sub(sm) sm.OP_SUB())
        l.Add(Sub(sm) sm.OP_Push(2))
        l.Add(Sub(sm) sm.OP_POW())

        '(y2-y1)^2
        l.Add(Sub(sm) sm.OP_Push(pt2.Y))
        l.Add(Sub(sm) sm.OP_Push(pt1.Y))
        l.Add(Sub(sm) sm.OP_SUB())
        l.Add(Sub(sm) sm.OP_Push(2))
        l.Add(Sub(sm) sm.OP_POW())

        'Add the results of both calculations
        l.Add(Sub(sm) sm.OP_Add())

        'Get the square root of the result
        l.Add(Sub(sm) sm.OP_SQR())

        Return Eval(l)
    End Function

    Private Function Eval(ByVal program As IEnumerable(Of SMInst)) As Single
        Dim sm As New StackMachine

        sm.ExecuteProgram(program)

        Return sm.OP_Pop()
    End Function
End Class

'Stack machine instruction
Public Delegate Sub SMInst(ByVal sm As StackMachine)

Public Class StackMachine

    Private _stack As New Stack(Of Single)

    Public Sub ExecuteProgram(ByVal program As IEnumerable(Of SMInst))
        For Each instruction As SMInst In program
            instruction.Invoke(Me)
        Next
    End Sub

    Public Sub OP_Push(ByVal operand As Single)
        _stack.Push(operand)
    End Sub

    Public Function OP_Pop() As Single
        Return _stack.Pop()
    End Function

    Public Sub OP_SQR()
        OP_Push(Math.Sqrt(OP_Pop()))
    End Sub

    Public Sub OP_Add()
        _stack.Push(OP_Pop() + OP_Pop())
    End Sub
    Public Sub OP_SUB()
        Dim r = OP_Pop()
        Dim l = OP_Pop()
        OP_Push(l - r)
    End Sub
    Public Sub OP_DIV()
        Dim r = OP_Pop()
        Dim l = OP_Pop()
        OP_Push(l / r)
    End Sub

    Public Sub OP_MUL()
        _stack.Push(OP_Pop() * OP_Pop())
    End Sub
    Public Sub OP_POW()
        Dim r = OP_Pop()
        Dim l = OP_Pop()
        OP_Push(l ^ r)
    End Sub

End Class


---

See comment on top of the code for a description of what this is about.

Looks pretty much the same in VB6:

mdlStackMachine

Code:

---

Option Explicit

Private Type Point
    X As Double
    Y As Double
End Type

Private Sub Main()
Dim pt1 As Point, pt2 As Point
    pt1.X = 1: pt1.Y = 1: pt2.X = 4: pt2.Y = 5
    Debug.Print CalcDist(pt1, pt2), Sqr((pt2.X - pt1.X) ^ 2 + (pt2.Y - pt1.Y) ^ 2)
End Sub

Private Function CalcDist(pt1 As Point, pt2 As Point) As Double
Dim Ops As New Collection
    With Ops
        .Add NewOp(OP_PUSH, pt2.X)
        .Add NewOp(OP_PUSH, pt1.X)
        .Add NewOp(OP_SUB)
        .Add NewOp(OP_PUSH, 2)
        .Add NewOp(OP_POW)
 
        .Add NewOp(OP_PUSH, pt2.Y)
        .Add NewOp(OP_PUSH, pt1.Y)
        .Add NewOp(OP_SUB)
        .Add NewOp(OP_PUSH, 2)
        .Add NewOp(OP_POW)
       
        .Add NewOp(OP_ADD)
       
        .Add NewOp(OP_SQR)
    End With
    With New cStackMachine
        .ExecuteProgram Ops: CalcDist = .OpPop
    End With
End Function

Private Function NewOp(OP As OP_LIST, Optional Operand As Double) As cOP
    With New cOP
        Set NewOp = .This(OP, Operand)
    End With
End Function

---

cStackMachine

Code:

---

Option Explicit

Private m_Stack As Collection

Friend Sub ExecuteProgram(Program As Collection)
Dim OP As cOP
    For Each OP In Program: OP.Execute Me: Next OP
End Sub

Friend Sub OpPush(Operand As Double)
    m_Stack.Add Operand
End Sub

Friend Function OpPop() As Double
    OpPop = m_Stack(m_Stack.Count): m_Stack.Remove m_Stack.Count
End Function

Friend Sub OpSqr()
    OpPush Sqr(OpPop)
End Sub

Friend Sub OpAdd()
    OpPush OpPop + OpPop
End Sub

Friend Sub OpSub()
    OpPush -(OpPop - OpPop)
End Sub

Friend Sub OpDiv()
    OpPush 1 / OpPop * OpPop
End Sub

Friend Sub OpMul()
    OpPush OpPop * OpPop
End Sub

Friend Sub OpPow()
Dim Exponent As Double
    Exponent = OpPop: OpPush OpPop ^ Exponent
End Sub

Private Sub Class_Initialize()
    Set m_Stack = New Collection
End Sub

---

cOP

Code:

---

Option Explicit

Public Enum OP_LIST
    OP_PUSH
    OP_POP
    OP_SQR
    OP_ADD
    OP_SUB
    OP_DIV
    OP_MUL
    OP_POW
End Enum

Private m_OP As OP_LIST, m_Operand As Double

Friend Sub Execute(StackMachine As cStackMachine)
    With StackMachine
        Select Case m_OP
            Case OP_PUSH: .OpPush m_Operand
            Case OP_POP: .OpPop
            Case OP_SQR: .OpSqr
            Case OP_ADD: .OpAdd
            Case OP_SUB: .OpSub
            Case OP_DIV: .OpDiv
            Case OP_MUL: .OpMul
            Case OP_POW: .OpPow
        End Select
    End With
End Sub

Friend Function This(OP As OP_LIST, Optional Operand As Double) As cOP
    m_OP = OP: m_Operand = Operand: Set This = Me
End Function

---

Quote:

---

Output: 5 5

---