11
\$\begingroup\$

Delegate

This class module defines what I'm calling, in this context, a Delegate - here a function that can take a number of parameters, evaluate a result, and return a value. Close enough to the actual "delegate" thing I find.

Example usage

Set x = Delegate.Create("(x) => MsgBox(""Hello, "" & x & ""!"")")
x.Execute "Mug"

The Execute call will generate this code in a dedicated code module found in the Reflection project (I know, it should be indented... but hey it's generated code!):

Public Function AnonymousFunction(ByVal x As Variant) As Variant
AnonymousFunction = MsgBox("Hello, " & x & "!")
End Function

Then it will call it (here with parameter value "Mug"), resulting in this:

Hello, Mug!

And this would output VbMsgBoxResult.vbOK, which has a value of 1:

Debug.Print x.Execute("Mug")

Now that's all nice, but I didn't write this class to display "Hello" message boxes; with it I can create a Delegate instance, and pass it as a parameter to a function, say, this member of some Enumerable class:

Public Function Where(predicate As Delegate) As Enumerable

    Dim result As New Collection

    Dim element As Variant
    For Each element In this.Encapsulated
        If predicate.Execute(element) Then result.Add element
    Next

    Set Where = Enumerable.FromCollection(result)

End Function

I've always wanted to be able to do this. Enough talk, here's the code that enables this sorcery!


Option Explicit

Private Type TDelegate
    Body As String
    Parameters As New Collection
End Type

Private Const methodName As String = "AnonymousFunction"
Private this As TDelegate

Friend Property Get Body() As String
    Body = this.Body
End Property

Friend Property Let Body(ByVal value As String)
    this.Body = value
End Property

Public Function Create(ByVal expression As String) As Delegate
    
    Dim result As New Delegate
    
    Dim regex As New RegExp
    regex.Pattern = "\((.*)\)\s\=\>\s(.*)"
    
    Dim regexMatches As MatchCollection
    Set regexMatches = regex.Execute(expression)
    
    If regexMatches.Count = 0 Then
        Err.Raise 5, "Delegate", "Invalid anonymous function expression."
    End If
    
    Dim regexMatch As Match
    For Each regexMatch In regexMatches
        If regexMatch.SubMatches(0) = vbNullString Then
            
            result.Body = methodName & " = " & Right(expression, Len(expression) - 6)
        
        Else
            Dim params() As String
            params = Split(regexMatch.SubMatches(0), ",")
            
            Dim i As Integer
            For i = LBound(params) To UBound(params)
                result.AddParameter Trim(params(i))
            Next
            
            result.Body = methodName & " = " & regexMatch.SubMatches(1)
            
        End If
        
    Next
    
    Set Create = result
    
End Function

Public Function Execute(ParamArray params()) As Variant
    
    On Error GoTo CleanFail
    
    Dim paramCount As Integer
    paramCount = UBound(params) + 1
    
    GenerateAnonymousMethod
    'cannot break beyond this point
    
    Select Case paramCount
        
        Case 0
            Execute = Application.Run(methodName)
        Case 1
            Execute = Application.Run(methodName, params(0))
        Case 2
            Execute = Application.Run(methodName, params(0), params(1))
        Case 3
            Execute = Application.Run(methodName, params(0), params(1), params(2))
        Case 4
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3))
        Case 5
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4))
        Case 6
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5))
        Case 7
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6))
        Case 8
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7))
        Case 9
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7), params(8))
        Case 10
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7), params(8), _
                                                  params(9))
        
        Case Else
            Err.Raise 5, "Execute", "Too many parameters."
        
    End Select
    
CleanExit:
    DestroyAnonymousMethod
    Exit Function
    
CleanFail:
    Resume CleanExit
End Function

Friend Sub AddParameter(ByVal paramName As String)
    this.Parameters.Add "ByVal " & paramName & " As Variant"
End Sub

Private Sub GenerateAnonymousMethod()
    
    Dim component As VBComponent
    Set component = Application.VBE.VBProjects("Reflection").VBComponents("AnonymousCode")
    
    Dim params As String
    If this.Parameters.Count > 0 Then
        params = Join(Enumerable.FromCollection(this.Parameters).ToArray, ", ")
    End If
    
    Dim signature As String
    signature = "Public Function " & methodName & "(" & params & ") As Variant" & vbNewLine
    
    Dim content As String
    content = vbNewLine & signature & this.Body & vbNewLine & "End Function" & vbNewLine
    
    component.CodeModule.DeleteLines 1, component.CodeModule.CountOfLines
    component.CodeModule.AddFromString content
    
End Sub

Private Sub DestroyAnonymousMethod()

    Dim component As VBComponent
    Set component = Application.VBE.VBProjects("Reflection").VBComponents("AnonymousCode")

    component.CodeModule.DeleteLines 1, component.CodeModule.CountOfLines

End Sub

The regular expression is pretty permissive; I'm basically allowing anything between parentheses, followed by =>, and then anything goes. I'd like a regex that enforces an optional comma-separated list of parameters between the parentheses, at least.

The reason I'd want a stiffer regex, is because it's my only chance to catch and prevent syntax errors that would generate uncompilable code, like..

Set x = Delegate.Create("(this is a bad parameter) => MsgBox(""Hello, "" & x & ""!"")")

Which generates this uncompilable code:

Public Function AnonymousFunction(ByVal this is a bad parameter As Variant) As Variant
AnonymousFunction = MsgBox("Hello, " & x & "!")
End Function

The actual anonymous function doesn't get generated until the Execute function is called, and then the anonymous function gets destroyed before Execute exits - this way one could have 20 Delegate objects with as many different anonymous functions waiting to be executed. The flipside is an obvious performance hit, especially with usages such as the Where method shown above - the same method would get created, executed and destroyed 200 times if the encapsulated collection has 200 elements.

Appending the expression body to the function's name induces a limitation - the "body" may only be a one-liner. I can live with that, but I wonder if there wouldn't be a way to make it smarter.

\$\endgroup\$
8
  • 2
    \$\begingroup\$ haven't tested a but I think a quick fix for the indentation could be as simple as content = vbNewLine & signature & vbTab & this.Body & vbNewLine & "End Function" & vbNewLine \$\endgroup\$
    – user28366
    Oct 14, 2014 at 9:54
  • 1
    \$\begingroup\$ That will work, but I'd rather find a way to support an inline/anonymous method with more than a single instruction - I might have to implement a return statement for this to work; honestly indenting code that can't even be seen/debugged isn't a real concern ;) \$\endgroup\$ Oct 14, 2014 at 13:24
  • 3
    \$\begingroup\$ That switch statement is why I hate ParamArray \$\endgroup\$
    – cheezsteak
    Oct 14, 2014 at 19:43
  • 2
    \$\begingroup\$ @ptwales funny, I thought I'd blame it on the 30 optional parameters of Application.Run... \$\endgroup\$ Oct 14, 2014 at 19:54
  • 1
    \$\begingroup\$ I thought application.Run took a ParamArray, nope it takes 30 optional parameters... \$\endgroup\$
    – cheezsteak
    Oct 14, 2014 at 19:56

2 Answers 2

7
\$\begingroup\$

NOTE - if you decide to stick with paramArray() it wouldn't be a bad idea to check the boundaries of the paramArray() before going any further -> into Select case in the Execute(). Application.Run() is capable to take up to 30 parameters so a quick check that your Ubound(params)) < 30 would probably be sufficient.

ButAlso!:

Something ... super tiny ;)

but why take a paramArray() in the Execute() since currently Execute() can only proceed with 10 arguments? (could do with up to 30 due to Application.Run() limit of 30 optional arguments)

Application.Run can take 30 Optional Parameters so I am just thinking that possibly a better idea would be to take up to 10 (or 30) optional parameters rather than a whole paramArray().

The function's definition may not look too pretty with all those Optional Parameters but it would allow you for a (IMO) better function's body.

I suspect that you wouldn't have to drastically change anything in the way you call Execute() but I haven't tested so this may still need verification.

So...something along these lines:

'//
'// Application.Run() is limited to up to 30 optional arguments
'//
'// firstParameter may actually not needed to be passed because it's a global constant
'// I have used it here "just in case" for now
'//
Public Function Execute(methodName As String, _
                        Optional Arg1 As Variant, Optional Arg2 As Variant, Optional Arg3 As Variant, _
                        Optional Arg4 As Variant, Optional Arg5 As Variant, Optional Arg6 As Variant, _
                        Optional Arg7 As Variant, Optional Arg8 As Variant, Optional Arg9 As Variant, _
                        Optional Arg10 As Variant, Optional Arg11 As Variant, Optional Arg12 As Variant, _
                        Optional Arg13 As Variant, Optional Arg14 As Variant, Optional Arg15 As Variant, _
                        Optional Arg16 As Variant, Optional Arg17 As Variant, Optional Arg18 As Variant, _
                        Optional Arg19 As Variant, Optional Arg20 As Variant, Optional Arg21 As Variant, _
                        Optional Arg22 As Variant, Optional Arg23 As Variant, Optional Arg24 As Variant, _
                        Optional Arg25 As Variant, Optional Arg24 As Variant, Optional Arg27 As Variant, _
                        Optional Arg28 As Variant, Optional Arg29 As Variant, Optional Arg30 As Variant _
                        ) As Variant

    On Error GoTo CleanFail

    GenerateAnonymousMethod
    'cannot break beyond this point

    Execute = Application.Run(methodName, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, _
                              Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
                              Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, arg26, Arg27, Arg28, Arg29, Arg30)

CleanExit:
    DestroyAnonymousMethod
    Exit Function

CleanFail:
    Resume CleanExit
End Function

Ok, so you will need to modify the AddParameter() too...because Variant can be Missing

Friend Sub AddParameter(ByVal paramName As String)
    this.Parameters.Add "Optional ByVal " & paramName & " As Variant = vbNullString"
End Sub

This reduces all the Select Case 1-30 to a single:

Execute = Application.Run(methodName, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, _
                              Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
                              Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, arg26, Arg27, Arg28, Arg29, Arg30)

A super easy repro to get an idea just in case the above is a bit overwhelming

Sub Main()
    ExecuteExt
    ExecuteExt "hello"
    ExecuteExt "hello", "world"
End Sub

' your execute without the select
Function ExecuteExt(Optional ByVal Arg1 As Variant, Optional ByVal Arg2 As Variant)
    ExecuteExt = Application.Run("PrintArgs", Arg1, Arg2)
End Function

' this would be the generated anonymous method
Sub PrintArgs(Optional ByVal Arg1 As Variant = vbNullString, Optional ByVal Arg2 As Variant = vbNullString)
    Debug.Print Arg1, Arg2
End Sub
\$\endgroup\$
5
\$\begingroup\$

You're right. You need a better regex, but not exactly for the reason you mentioned. The one you're using is indeed very permissive. It misses many of the cases that need to be checked for.

Use the following rules when you name procedures, constants, variables, and arguments in a Visual Basic module:

  • You must use a letter as the first character.
  • You can't use a space, period (.), exclamation mark (!), or the characters @, &, $, # in the name.
  • Name can't exceed 255 characters in length.

Visual Basic Naming Rules - Office 2013 Language Reference

This pattern is a bit more restrictive than need be, but I think it will certainly cover the cases laid out above.

\(([a-zA-Z_]*)\)\s\=\>\s(.*)
  • Match a literal open paren
  • Group
    • Match Any Letter Or underscore
    • Repeat
  • Match a literal close paren
  • match a space
  • equals sign
  • greater than
  • space
  • Group
    • Match any

But consider the following possible delegate functions

(x) => MsgBox("Hello, " & x & "!")  
(x)=> MsgBox("Hello, " & x & "!")  
(x) =>MsgBox("Hello, " & x & "!")  
(x)=>MsgBox("Hello, " & x & "!")

Only the first one will pass the validation because you're checking for space around the lambda operator. Considering that these will (by necessity) be passed as strings, the user will not have the benefit of the IDE fixing the spacing for them. All of these should be allowed to pass through validation.

The solution is to make the spaces optional with the question mark operator. So, the final regex pattern I came up with looked like this. It doesn't address the validation of the inline function after the lambda at all, but some of the concepts here should help you do some of that.

\(([a-zA-Z_]*)\)(\s)?\=\>(\s)?(.*)

Refiddle here

but that sucks too. Like you pointed out in the comments, this pattern would be closest to spec on argument naming.

\(([a-zA-Z][a-zA-Z0-9_]*)\)(\s)?\=\>(\s)?(.*)

Open Paren; A Letter; Any letter, digit, or underscore; close paren; optional space; lambda; optional space; anything goes.

\$\endgroup\$
3
  • 1
    \$\begingroup\$ Won't that pattern allow an identifier to start with an underscore? [a-zA-Z][a-zA-Z0-9_]* would be closer to specs I think ;) \$\endgroup\$ Oct 14, 2014 at 19:13
  • \$\begingroup\$ Absolutely! Good call! \$\endgroup\$
    – RubberDuck
    Oct 14, 2014 at 19:15
  • 1
    \$\begingroup\$ The main problem with this regex is that it only allows a single argument. The OP says (and the code verifies) that the regex should "enforce an optional comma-separated list of parameters between the parentheses", ie whatever is found in the first capture group will be turned into an array of parameters using Split(params, ","). I decided to use a single space as my split character, so the regex I ended up using was: \(([a-zA-Z ]*)\)\s?\=\>\s?(.*) \$\endgroup\$ Feb 23, 2018 at 19:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.