First Class Functions
So, VBA doesn't support functions as first class objects - no passing functions as arguments or storing them in variables.
I eventually found a way to implement function pointers using AddressOf and DispCallFunc, but it was rather dangerous - if you pass the wrong number or type of parameters, you risk hanging/crashing VBA. To get around the problem of types, I made everything a ByRef Variant - any parameters provided can be converted to Variants for passing and then cast back to whatever types they should be inside the function. However, passing incorrect numbers of parameters was still a huge problem because there is no way to detect it, and as soon as DispCallFunc tries to dereference a null pointer, VBA goes BOOM.
Since I wasn't going to have type safety anyway (at least not natively), I started wondering how I could implement function pointers through classes and interfaces. VBA has a parameter keyword "ParamArray" that allows you to define variadic functions.
I created an interface, IFunction, to encapsulate this behavior.
IFunction
'This function is set as the default member of the interface. This means instead of writing f.func(...), you can write f(...)'
Public Function func(ParamArray args()) As Variant
'Do some kind of validation of the arguments'
'Logic!'
End Function
Public Function funcByArray(args As Variant) As Variant
'Do some kind of validation of the arguments'
'Logic!'
End Function
The "func" function needs to be set as the default member of the class by exporting it to a text file, adding the line Attribute func.VB_UserMemId = 0
just below the Public Function func...
line, then reimporting. A class which implements this interface can be "run" as a function, but also passed as an object.
An IFunction can be called as if it were a function, ClassName(arg1, arg2, arg3)
, which passes the parameters to the default func
member.
I created a helper functions to make this more "safe". Since the function definitions are variadic, there needs to be a way to verify that the correct number and types of parameters have been supplied - to do this, I created "AssertArgs(args() As Variant, argTypes() As Long)". This requires some explanation. In VBA, there is a native function "VarType" that returns a number which uniquely identifies the type of the value it is called on. There is an enum of constants to compare them against: vbObject, vbDouble, vbString, vbLong, etc. This allows me to loop through the arg() array, comparing the types against the values in argTypes(), and of course I can compare the lengths of those arrays. Also, in VBA, the native function "Array(...)" allows the creation of a Variant array from the arguments (it wouldn't be too hard to create if it didn't exist, but it's convenient becuase most VBA programmers would already know how to use it). This means that the AssertArgs function can be called in the main method of an IFunction like so...
AssertArgs args, Array(vbString, vbLong)
...to validate that two parameters were supplied, with the first a string and the second a long.
In order to properly return Variant result of a function without knowing in advance whether it is an Object or a value type, I created an AssignVar(varDest, varSrc)
function to use the proper Set/Let assignment syntax at runtime.
Here is the full set of helper functions that enable this behavior:
mdlIFunctionHelpers
Private Declare Function VariantChangeType Lib "OleAut32.dll" (dest As Variant, Src As Variant, ByVal wFlags As Integer, ByVal vt As Integer) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
'https://www.winehq.org/pipermail/wine-cvs/2014-March/101150.html'
Public Const S_OK As Long = 0
Public Const DISP_E_BADVARTYPE As Long = &H80020008
Public Const DISP_E_OVERFLOW As Long = &H8002000A
Public Const DISP_E_TYPEMISMATCH As Long = &H80020005
Public Const E_INVALIDARG As Long = &H80070057
Public Const E_OUTOFMEMORY As Long = &H8007000E
Public Const vbParamArray = &H1234
'AssertArgs is how you validate parameter types in IFunctions. It is called as the first line of an IFunction implementation.
'
'For example, a function which takes two double arguments would be validated like so:
'
' AssertArgs args, Array(vbaDouble, vbaDouble)
'
Public Sub AssertArgs(args As Variant, argTypes As Variant)
If UBound(argTypes) <> UBound(args) Then
If Not argTypes(UBound(argTypes)) = vbParamArray Then
'wrong number args'
Err.Raise vbObjectError + 1, "", "Incorrect number of parameters!"
End If
End If
For i = 0 To UBound(argTypes)
If argTypes(i) = vbParamArray Then
Exit Sub
Else
'If the requested parameter is to be a variant, no need to cast since the parameter list is always an array of variants'
If Not argTypes(i) = vbVariant And VarType(args(i)) <> argTypes(i) Then
errcode = VariantChangeType(args(i), args(i), 0, argTypes(i))
If Not errcode = S_OK Then
Err.Raise errcode, , GetWinErrorString(errcode)
End If
End If
End If
Next
End Sub
Public Function fcall(f As IFunction, ParamArray args() As Variant) As Variant
AssignVar fcall, f.funcByArray(CVar(args))
End Function
Public Sub AssignVar(varDest As Variant, varSrc As Variant)
If VarType(varSrc) = vbObject Then
Set varDest = varSrc
Else
varDest = varSrc
End If
End Sub
Private Function GetWinErrorString(ByVal ErrorCode As Long) As String
Dim sMessage As String, MessageLength As Long
sMessage = Space$(256)
MessageLength = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, _
ErrorCode, 0&, sMessage, 256&, 0&)
If MessageLength > 0 Then
GetWinErrorString = Left(sMessage, MessageLength)
Else
GetWinErrorString = "Unknown Error."
End If
End Function
In VBA, it is possible to set a flag on a class to indicate that it is a named instance of itself. So for an example class called AddFive, "AddFive" is a self-instancing instance of the AddFive class. This lets me immediately use "AddFive" as a parameter to a function expecting an IFunction without having to instance it first (since I'm assuming the IFunctions have no associated state).
Below is the example "AddFive" IFunction class below, which simply accepts a Double, adds 5 to it, then returns the result.
AddFive
Option Explicit
Implements IFunction
Private Function ActualFunc(args As Variant) As Variant
AssertArgs args, Array(vbDouble)
ActualFunc = args(0) + 5
End Function
'*****************************************************************'
Public Function func(ParamArray args() As Variant) As Variant
AssignVar func, ActualFunc(CVar(args))
End Function
Public Function funcByArray(args As Variant) As Variant
AssignVar funcByArray, ActualFunc(args)
End Function
Private Function IFunction_func(ParamArray args() As Variant) As Variant
AssignVar IFunction_func, ActualFunc(CVar(args))
End Function
Private Function IFunction_funcByArray(args As Variant) As Variant
AssignVar IFunction_funcByArray, ActualFunc(args)
End Function
The final two things necessary to get this class to behave like a function have to be done by exporting the class to a text file, making the following changes in notepad and then reimporting it.
1 Change the value for the VB_PredeclaredId
attribute at the top of the class to True
:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True'
END
Attribute VB_Name = "IFunction"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
(...rest of code)
2 Make func
the default member by adding Attribute func.VB_UserMemId = 0
right after the function declaration:
(code...)
'This function is set as the default member of the interface. This means instead of writing f.func(...), you can write f(...)'
Public Function func(ParamArray args()) As Variant
Attribute func.VB_UserMemId = 0
'Do some kind of validation of the arguments'
'Logic!'
End Function
(...rest of code)
You can test it like so:
mdlMain
Public Sub Main()
MsgBox AddFive(37)
End Sub
(If you get "Run-time error '438': Object doesn't support this property or method", go back and ensure that steps 1 & 2 of the notepad text manipulation are correct and that the class was reimported correctly)
Higher Order Functions
With passable function objects complete, this allowed me to define "Map(f As IFunction, arr() As Variant)" and "Reduce(f As IFunction, arr() As Variant)". Map applies f to each value in arr, assuming f is defined as "f(val As Variant) As Variant" creating and returning the new array of values. Similarly, Reduce assumes that f is defined as "f(val1 As Variant, val2 As Variant) As Variant" which allows the reduction of an array to a single value.
Take two example self-instancing IFunction classes:
AddFive -AssertArgs(args, Array(vbNumber)) -returns args(0) + 5
Sum -AssertArgs(args, Array(vbNumber, vbNumber)) -returns args(0) + args(1)
I can now write:
Map(AddFive, Array(1, 2, 3, 4, 5))
which returns (6, 7, 8, 9, 10) and I can write:
Reduce(Sum, Array(1, 2, 3, 4, 5))
which returns 15.
This is interesting, and definitely allows for some cool possibilities. For example, suppose I have a sorting function that I use to order a list of Employee objects. Suppose further that Employee objects have three attributes: Name, Age, Salary. If I hardcode the sort to work by Name, I can't change it to sort by Age or Salary without recompiling. However, if my sort function accepts a "comparison" function as well as the list to be sorted, I can change the comparison at runtime!
Following is the code for Sum, Map and Reduce. Note: you MUST perform steps 1 & 2 as above in order to call these "functions" directly.
Sum
Option Explicit
Implements IFunction
Private Function ActualFunc(args As Variant) As Variant
AssertArgs args, Array(vbDouble, vbDouble) 'Actual parameter description and validation
ActualFunc = args(0) + args(1)
End Function
'***********************************************************************
Public Function func(ParamArray args() As Variant) As Variant
AssignVar func, ActualFunc(CVar(args))
End Function
Public Function funcByArray(args As Variant) As Variant
AssignVar funcByArray, ActualFunc(args)
End Function
Private Function IFunction_func(ParamArray args() As Variant) As Variant
AssignVar IFunction_func, ActualFunc(CVar(args))
End Function
Private Function IFunction_funcByArray(args As Variant) As Variant
AssignVar IFunction_funcByArray, ActualFunc(CVar(args))
End Function
Map
Option Explicit
Implements IFunction
Private Function ActualFunc(args As Variant) As Variant
AssertArgs args, Array(vbObject, vbArray Or vbVariant)
'Validate vbObject is IFunction
Dim f As IFunction
Set f = args(0)
Dim arr() As Variant
arr = args(1)
Dim i As Long
Dim var() As Variant
ReDim var(0 To UBound(arr))
For i = 0 To UBound(arr)
'The "CVar" is a workaround for a VBA Compiler bug - see mdlBugExample
var(i) = f.func(CVar(arr(i)))
Next
ActualFunc = var
End Function
'*************************************************************************************
Public Function func(ParamArray args() As Variant) As Variant
AssignVar func, ActualFunc(CVar(args))
End Function
Public Function funcByArray(args As Variant) As Variant
AssignVar funcByArray, ActualFunc(args)
End Function
Private Function IFunction_func(ParamArray args() As Variant) As Variant
AssignVar IFunction_func, ActualFunc(CVar(args))
End Function
Private Function IFunction_funcByArray(args As Variant) As Variant
AssignVar IFunction_funcByArray, ActualFunc(args)
End Function
Reduce
Option Explicit
Implements IFunction
Private Function ActualFunc(args As Variant) As Variant
Dim initializer As Variant
If UBound(args) = 2 Then
AssertArgs args, Array(vbObject, vbArray Or vbVariant, vbVariant)
initializer = args(2)
Else
AssertArgs args, Array(vbObject, vbArray Or vbVariant)
End If
'Validate vbObject is IFunction
Dim f As IFunction
Set f = args(0)
Dim arr() As Variant
arr = args(1)
Dim i As Long
Dim result As Variant
Dim var() As Variant
If UBound(args) > 0 Then
If IsMissing(initializer) Then
'The "CVar" is a workaround for a VBA Compiler bug - see mdlBugExample
result = f.func(CVar(arr(0)), CVar(arr(1)))
i = 2
Else
'The "CVar" is a workaround for a VBA Compiler bug - see mdlBugExample
result = f.func(initializer, CVar(arr(0)))
i = 1
End If
For i = i To UBound(args)
'The "CVar" is a workaround for a VBA Compiler bug - see mdlBugExample
result = f.func(result, CVar(arr(i)))
Next
Else
result = args(0)
End If
ActualFunc = result
End Function
'*************************************************************************************
Public Function func(ParamArray args() As Variant) As Variant
AssignVar func, ActualFunc(CVar(args))
End Function
Public Function funcByArray(args As Variant) As Variant
AssignVar funcByArray, ActualFunc(args)
End Function
Private Function IFunction_func(ParamArray args() As Variant) As Variant
AssignVar IFunction_func, ActualFunc(CVar(args))
End Function
Private Function IFunction_funcByArray(args As Variant) As Variant
AssignVar IFunction_funcByArray, ActualFunc(args)
End Function
VarType()
will trigger evaluation of an object's default member function if it can take 0 parameters; I had to useTypeOf _ is Object
and some jankyIf
statements. I went on to use the framework to implement closures and the Y combinator :D \$\endgroup\$'@IFunction(vbDouble)
and then you run some sort of precompiler on it that inserts the IFunction stuff andAssertArgs
. However, that would still be too much work for too little gain I think. \$\endgroup\$