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.
Re: Simple programmable stack machine in VB.Net
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