Generating and calling code on the fly

Question

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.

• user28366: 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
• Mathieu Guindon: 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 ;)
• cheezsteak: That switch statement is why I hate ParamArray
• Mathieu Guindon: @ptwales funny, I thought I'd blame it on the 30 optional parameters of Application.Run...
• cheezsteak: I thought application.Run took a ParamArray, nope it takes 30 optional parameters...

Answer 1

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

Answer 2

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.

• Mathieu Guindon: 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 ;)
• RubberDuck: Absolutely! Good call!
• Daniel McCracken: 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?(.*)