Functional Framework

Question

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

Answer 1

Implicit Variant Types You've been diligent with Type declarations, but in IFunction you have omitted the Variant type of the ParamArray:

Public Function func(ParamArray args()) As Variant

Use meaningful names

Your use of i, f and var are 3 examples of meaningless variable names. Consider more meaningful names.

Use independent loop bounds Your Loop uses i as the loop variable and the starting index:

For i = i To UBound(args)

That can be confusing to read, and difficult to debug. Consider using independent variables

Magic error numbers You've done half the work of creating custom error numbers:

vbObjectError + 1

But the 1 would ideally be defined as a constant instead of as a magic number in inline code.

Check bounds before using ReDim

Dim var() As Variant
ReDim var(0 To UBound(arr))

In this instance, the ReDim statement does away with the need for the Dim statement, but if args is an empty array, then you'll get a subscript out of range error when you try to ReDim with an upper bound of -1. It may be the cases that args will never be empty, but it is still good practice to check.