Results 1 to 13 of 13

Thread: [VB6/VBA] Lambda Syntax - No script control or cheats!

  1. #1

    Thread Starter
    Member
    Join Date
    Apr 2019
    Posts
    63

    [VB6/VBA] Lambda Syntax - No script control or cheats!

    Lambda Expressions

    I've already posted this library elsewhere but figured that people on VBForums would find it useful too! This library has confirmed VB6 support!

    Up to date documentation can be found on github

    What is a lambda expression?

    A lambda expression/anonymous function is a function definition that is not bound to a name. Lambda expressions are usually "1st class citezens" which means they can be passed to other functions for evaluation.

    I personally believe this is best described with an example. Imagine we wanted to sort an array of sheets by their name. In VBA this would be relatively complex and require an understanding of how to sort data in the first place, as well as which algorithms to use. Lambda allows us to define 1 sorting function and then provide our lambda function to provide the ID to sort on:

    Example.bas Code:
    1. Sub Main
    2.     myArray = Array(Sheets(1),Sheets(2))
    3.     newArray = sort(myArray, stdLambda.Create("$1.name"))
    4. End Sub
    5.  
    6. Function sort(array as variant, accessor as stdICallable)
    7.     '... sorting code ...
    8.        elementID = accessor(element)
    9.     '... sorting code ...
    10. End Function

    Download

    The file can be found on github here:
    stdLambda.cls.

    stdICallable will also be required: stdICallable.cls

    How to use stdLambda

    The Create() constructor is the main way to create an instance of the stdLambda object.

    Example.bas Code:
    1. Sub test()
    2.     Dim cb as stdLambda
    3.     set cb = stdLambda.Create("1+1")
    4. End Sub

    To define a function which takes multiple arguments $# should be used where # is the index of the argument. E.G. $1 is the first argument, $2 is the 2nd argument and $n is the nth argument.

    Example.bas Code:
    1. Sub test()
    2.     Dim average as stdLambda
    3.     set average = stdLambda.Create("($1+$2)/2")
    4. End Sub

    You can also define functions which call members of objects. Use xxx#xxx() to call functions and xxx.xxx() to call properties.

    Example.bas Code:
    1. Sub test()
    2.     Debug.Print stdLambda.Create("$1.Name")(someObject)  'returns ThisWorkbook.Name
    3.     Call stdLambda.Create("$1#Save")(someObject)         'calls ThisWorkbook.Save
    4. End Sub

    The lambda syntax comes with many VBA functions which you are already used to...

    Example.bas Code:
    1. Sub test()
    2.     Debug.Print stdLambda.Create("Mid($1,1,5)")("hello world")        'returns "hello"
    3.     Debug.Print stdLambda.Create("$1 like ""hello*""")("hello world") 'returns true
    4. End Sub

    As well as an inline if statement:

    Example.bas Code:
    1. Sub test()
    2.     Debug.Print stdLambda.Create("if $1 then 1 else 2")(true)        'returns 1
    3.     Debug.Print stdLambda.Create("if $1 then 1 else 2")(false)       'returns 2
    4.  
    5.     'Note: this will only call someObj.CallMethod() and will not call someObj.CallMethod2() (unless 1st arg is supplied as false of course)
    6.     Debug.Print stdLambda.Create("if $1 then $2#CallMethod() else $2#CallMethod2()")(true,someObj)
    7. End Sub

    With stdLambda you are not limited to a single lines, you can also use multiple lines. Note the result of the last line in the lambda is returned:

    Example.bas Code:
    1. Call stdLambda.Create("2+2: 5*2").Run()
    2.  
    3. '... or ...
    4.  
    5. Call stdLambda.CreateMultiline(array( _
    6.   "2+2", _
    7.   "5*2", _
    8. )).Run()

    You can also use variables, much like in VB6:

    Example.bas Code:
    1. 'the last assignment is redundant, just used to show that assignments result in their value
    2. Debug.Print stdLambda.CreateMultiline(array( _
    3.   "count = $1", _
    4.   "footPrint = count * 2 ^ count" _
    5. )).Run(2) ' -> 8

    Finally you can use Function definitions if you want to use recursion:

    Example.bas Code:
    1. stdLambda.CreateMultiline(Array( _
    2.   "fun fib(v)", _
    3.   "  if v<=1 then", _
    4.   "    v", _
    5.   "  else ", _
    6.   "    fib(v-2) + fib(v-1)", _
    7.   "  end", _
    8.   "end", _
    9.   "fib($1)" _
    10. )).Run(20) '->6765

    Evaluating lambdas

    Use default member execution:

    Example.bas Code:
    1. Sub test()
    2.     Dim average as stdLambda
    3.     set average = stdLambda.Create("($1+$2)/2")
    4.     Debug.Print average(1,2)   '1.5
    5. End Sub

    Use Run method:

    Example.bas Code:
    1. Sub test()
    2.     Dim average as stdLambda
    3.     set average = stdLambda.Create("($1+$2)/2")
    4.     Debug.Print average.Run(1,2)   '1.5
    5. End Sub

    Use RunEx method, supplying an array of arguments:

    Example.bas Code:
    1. Sub test()
    2.     Dim average as stdLambda
    3.     set average = stdLambda.Create("($1+$2)/2")
    4.     Debug.Print average.RunEx(Array(1,2))   '1.5
    5. End Sub

    Sometimes it's useful to use an interface. In this case use stdICallable interface:

    Example.bas Code:
    1. Sub test(ByVal func as stdICallable)
    2.     func.Run(ThisWorkbook, 1, "hello world")
    3. End Sub

    An update as of 16/09/2020 added the Bind() method to stdLambda as well. The Bind() method creates a new ICallable that, when called, supplies the given sequence of arguments preceding any provided when the new function is called. This ultimately saves on expression compilation time.

    Example.bas Code:
    1. 'Expression created, argument bound.
    2. Dim cb as stdLambda: set cb = stdLambda.Create("$1 + $2").Bind(5)
    3. Debug.Print cb(1) '6
    4. Debug.Print cb(2) '7
    5. Debug.Print cb(3) '8
    6.  
    7. 'No compilation required, cached lambda is used with new bound argument
    8. set cb = stdLambda.Create("$1 + $2").Bind(6)
    9. Debug.Print cb(1) '7
    10. Debug.Print cb(2) '8
    11. Debug.Print cb(3) '9

    How it works

    Finally, how does the class work internally?

    Create first looks to see if a lambda already exists, if it does it is returned, else it calls Init which:
    • Tokenises the string using Regex
    • Calls parseBlock() which uses a top-down parsing algorithm to parse the entire block to an array/stack containing operations (i.e. compiles to byte code)


    Then when an expression is executed, Run calls evaluate which:

    • Loops over all operations, detects the type and subtype of the operation
    • Performs the operations function
    • After all operations have executed the 1st item in the stack is returned.


    Integration with the STD-VBA Library

    Thought i'd give a taste of one of the core reasons I built this library!

    Example.bas Code:
    1. 'Create an array
    2. Dim arr as stdArray
    3. set arr = stdArray.Create(1,2,3,4,5,6,7,8,9,10) 'Can also call CreateFromArray
    4.  
    5. 'More advanced behaviour when including callbacks! And VBA Lamdas!!
    6. Debug.Print arr.Map(stdLambda.Create("$1+1")).join          '2,3,4,5,6,7,8,9,10,11
    7. Debug.Print arr.Reduce(stdLambda.Create("$1+$2"))           '55 ' I.E. Calculate the sum
    8. Debug.Print arr.Reduce(stdLambda.Create("Max($1,$2)"))      '10 ' I.E. Calculate the maximum
    9. Debug.Print arr.Filter(stdLambda.Create("$1>=5")).join      '5,6,7,8,9,10
    10.  
    11. 'Execute property accessors with Lambda syntax
    12. Debug.Print arr.Map(stdLambda.Create("ThisWorkbook.Sheets($1)")) _
    13.                .Map(stdLambda.Create("$1.Name")).join(",")            'Sheet1,Sheet2,Sheet3,...,Sheet10
    14.  
    15. 'Execute methods with lambda:
    16. Call stdArray.Create(Workbooks(1),Workbooks(2)).forEach(stdLambda.Create("$1#Save")
    17.  
    18. 'Sort objects by date, and then print names concatenated with comma
    19. Debug.Print stdArray.Create(ObjA,ObjB,ObjC,ObjD,ObjE).sort(stdLambda.Create("$1.Date")).map(stdLambda.Create("$1.Name")).join(",")
    20.  
    21. 'We even have if statement!
    22. With stdLambda.Create("if $1 then ""lisa"" else ""bart""")
    23.   Debug.Print .Run(true)                                              'lisa
    24.   Debug.Print .Run(false)                                             'bart
    25. End With


    Long term goals

    The intermediate representation is good, but it would be even better if we could compile to machine code... I'm pretty sure this is even more difficult, but in the pursuit of speed that's maybe where we'll have to go!

    Happy Coding!
    ~Sancarn
    Last edited by sancarn; Jul 10th, 2021 at 12:29 PM. Reason: Adding link to up to date docs and changing title

  2. #2
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    Wow, where did this come from :-)) Probably from the wonderful world of VBA 7 where cross-pollination with modern languages and new ideas is still strong!

    Btw, in the ancient VB6 world we do have x86 machine code generated lambdas (kind of) but unfortunately there is no x64 implementation currently.

    I might try to implement C emitting backend (OTCC subset) for your lambda syntax based on your current frontend.

    cheers,
    </wqw>

  3. #3

    Thread Starter
    Member
    Join Date
    Apr 2019
    Posts
    63

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    Quote Originally Posted by wqweto View Post
    Wow, where did this come from :-)) Probably from the wonderful world of VBA 7 where cross-pollination with modern languages and new ideas is still strong!
    Over the past year I've been simultaneously working on a "VBA-Like" to "VBA" transpiler with the intention of making something akin to BabelJS but for VBA. Was also hoping that might be able to compile to VB6 too and thus simultaneously "elevate" the version of VB6. Anyhow that experience and some help from a friend, allowed me to write a first version (which evaluated the tree at runtime...). It really all developed from there, with 2nd and 3rd versions implementing more operations. In an attempt to try to improve performance TarVK took it and added the compiler and evaluator here

    Quote Originally Posted by wqweto View Post
    Btw, in the ancient VB6 world we do have x86 machine code generated lambdas (kind of) but unfortunately there is no x64 implementation currently.
    Wow! Wish I had known that before I made this library lol... I had initially hoped to do more in machine code, but at the time didn't have the knowledge or compiler tooling to make that work...

    Quote Originally Posted by wqweto View Post
    I might try to implement C emitting backend (OTCC subset) for your lambda syntax based on your current frontend
    This would be cool, an alternative approach would be to re-implement the evaluator in compiled C for both x86 and x64. At least I believe this should provide the fastest runtime. Although it may be less fun for you! :P Anyhow any help you can provide would be much appreciated of course
    Last edited by sancarn; Sep 18th, 2020 at 04:22 AM.

  4. #4
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    how to use this class in excel?

    Sub test()
    Dim str As String
    str = "(($1)^2+($2)^2))^0.5"
    Dim c As stdLambda
    Set c = stdLambda.Create(str)
    Debug.Print c(3, 4)
    End Sub

    Error: Unexpected token, found: rBracket but expected: lBracket
    Last edited by loquat; Jun 21st, 2021 at 04:56 AM.

  5. #5
    Smooth Moperator techgnome's Avatar
    Join Date
    May 2002
    Posts
    34,532

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    It tells you what's wrong... you have a mismatched closing parens...
    Code:
    str = "(($1)^2+($2)^2))^0.5"
    -tg
    * I don't respond to private (PM) requests for help. It's not conducive to the general learning of others.*
    * I also don't respond to friend requests. Save a few bits and don't bother. I'll just end up rejecting anyways.*
    * How to get EFFECTIVE help: The Hitchhiker's Guide to Getting Help at VBF - Removing eels from your hovercraft *
    * How to Use Parameters * Create Disconnected ADO Recordset Clones * Set your VB6 ActiveX Compatibility * Get rid of those pesky VB Line Numbers * I swear I saved my data, where'd it run off to??? *

  6. #6
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    thanks a lot, this problem solved
    but new problem occur:
    i wrote Lambda function in normal module:
    Code:
    Public Function Lambda(ByVal strParams As String)
        Set Lambda = stdLambda.Create(strParams)
    End Function
    and when i write formula like this: =lambda("(($1)^2+($2)^2)^0.5")(3,4)
    it throws "Argument 0 not supplied to Lambda."

  7. #7
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    and maybe this stdLambda can be updated like the office365 done
    they can define a lambda formula like this: =LAMBDA(x,y,(x^2+y^2)^0.5)(3,4)
    so our lambda arguments is "x,y,(x^2+y^2)^0.5"
    will be more flexible i think
    Last edited by loquat; Jun 22nd, 2021 at 01:11 AM.

  8. #8
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    597

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    Quote Originally Posted by loquat View Post
    and maybe this stdLambda can be updated like the office365 done
    they can define a lambda formula like this: =LAMBDA(x,y,(x^2+y^2)^0.5)(3,4)
    so our lambda arguments is "x,y,x^2+y^2)^0.5"
    will be more flexible i think
    "x,y,x^2+y^2)^0.5" error repeats...@loquat

  9. #9
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    Quote Originally Posted by DaveDavis View Post
    "x,y,x^2+y^2)^0.5" error repeats...@loquat
    yes have fix my instructions

  10. #10

    Thread Starter
    Member
    Join Date
    Apr 2019
    Posts
    63

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    Quote Originally Posted by loquat View Post
    thanks a lot, this problem solved
    but new problem occur:
    i wrote Lambda function in normal module:
    Code:
    Public Function Lambda(ByVal strParams As String)
        Set Lambda = stdLambda.Create(strParams)
    End Function
    and when i write formula like this: =lambda("(($1)^2+($2)^2)^0.5")(3,4)
    it throws "Argument 0 not supplied to Lambda."
    Hi @loquat you can't use stdLambda in an Excel formula. Formulae does not support Objects. It is designed strictly for VB6/VBA usage only. If you really must use it within excel formulae then you will have to redefine the syntax usage as follows:

    Code:
    Function lambda(ByVal sLambda as string, ParamArray params()) as Variant
      Application.Volatile true
      Dim vArr: vArr = params
      lambda = stdLambda.Create(sLambda).RunEx(vArr)
    End Function
    With usage like:

    Code:
    =lambda("(($1)^2+($2)^2)^0.5",3,4)
    However please note, this will not be performant at all. And you are better not using stdLambda for this purpose.


    Quote Originally Posted by loquat View Post
    and maybe this stdLambda can be updated like the office365 done
    they can define a lambda formula like this: =LAMBDA(x,y,(x^2+y^2)^0.5)(3,4)
    so our lambda arguments is "x,y,(x^2+y^2)^0.5
    I don't personally see why this is at all more flexible, apart from being easier to read, but the syntax the Excel team used is frankly awful in my opinion. I'd prefer arrow function syntax, e.g.

    Code:
    stdLambda.Create("(x,y)=>(x^2+y^2)^0.5")
    This is definitely doable with the current system, but will take some time to figure out Happy to accept PRs to improve the library though!
    Last edited by sancarn; Jul 9th, 2021 at 05:35 PM.

  11. #11
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: [VBA] Lambda Syntax - No script control or cheats! Happy for ports to VB6

    Quote Originally Posted by sancarn View Post
    Hi @loquat you can't use stdLambda in an Excel formula. Formulae does not support Objects. It is designed strictly for VB6/VBA usage only. If you really must use it within excel formulae then you will have to redefine the syntax usage as follows:
    Code:
    Function lambda(ByVal sLambda as string, ParamArray params()) as Variant
      Application.Volatile true
      Dim vArr: vArr = params
      lambda = stdLambda.Create(sLambda).RunEx(vArr)
    End Function
    With usage like:
    Code:
    =lambda("(($1)^2+($2)^2)^0.5",3,4)
    That is Ok for now, thanks

    Quote Originally Posted by sancarn View Post
    However please note, this will not be performant at all. And you are better not using stdLambda for this purpose.
    Yes I know

    Quote Originally Posted by sancarn View Post
    I don't personally see why this is at all more flexible, apart from being easier to read, but the syntax the Excel team used is frankly awful in my opinion. I'd prefer arrow function syntax, e.g.
    Code:
    stdLambda.Create("(x,y)=>(x^2+y^2)^0.5")
    This is definitely doable with the current system, but will take some time to figure out Happy to accept PRs to improve the library though!
    LAMBDA("x,y,(x^2+y^2)^0.5",3,4)
    or
    LAMBDA("(x,y)=>(x^2+y^2)^0.5",3,4)
    would be Ok at all, because i think they are easier to read than $1 $2 $11 $12

  12. #12
    Addicted Member sergeos's Avatar
    Join Date
    Apr 2009
    Location
    Belarus
    Posts
    162

    Re: [VB6/VBA] Lambda Syntax - No script control or cheats!

    Entschuldigung Sie Bitte!

    How possible use under VBA?
    my steps is:
    1) add in project two classes (stdLambda.cls, stdICallable.cls)
    2) comment some service header data (i think this is for VB6)
    'VERSION 1.0 CLASS
    'BEGIN
    ' MultiUse = -1 'True
    'End
    'Attribute VB_Name = "stdLambda"
    'Attribute VB_GlobalNameSpace = False
    'Attribute VB_Creatable = False
    'Attribute VB_PredeclaredId = True
    'Attribute VB_Exposed = False

    3) add test module
    4) in the module type test sub
    Code:
    Sub test()
        Dim cb As New stdLambda
        Set cb = stdLambda.Create("1+1")
    End Sub
    5) after debugging this peace of code i'm getting err
    stdLambda => variable not defined (on second line)
    Ten Years After - 01 You Give Me Loving

  13. #13

    Thread Starter
    Member
    Join Date
    Apr 2019
    Posts
    63

    Re: [VB6/VBA] Lambda Syntax - No script control or cheats!

    Quote Originally Posted by sergeos View Post
    Entschuldigung Sie Bitte!

    How possible use under VBA?
    my steps is:
    1) add in project two classes (stdLambda.cls, stdICallable.cls)
    2) comment some service header data (i think this is for VB6)
    'VERSION 1.0 CLASS
    'BEGIN
    ' MultiUse = -1 'True
    'End
    'Attribute VB_Name = "stdLambda"
    'Attribute VB_GlobalNameSpace = False
    'Attribute VB_Creatable = False
    'Attribute VB_PredeclaredId = True
    'Attribute VB_Exposed = False

    3) add test module
    4) in the module type test sub
    Code:
    Sub test()
        Dim cb As New stdLambda
        Set cb = stdLambda.Create("1+1")
    End Sub
    5) after debugging this peace of code i'm getting err
    stdLambda => variable not defined (on second line)
    Hi Sergios,

    Do not copy and paste! Installation instructions:

    * In your VBA project, right click on your classes folder and select import file.
    * Import stdLambda.cls
    * Import stdICallable.cls
    * Ensure both of these arrive as class modules. If these appear as regular code modules then one of the files is corrupt (line endings need to be crlf rather than lf (issue with github)).
    * For a test module do:

    VB6 Code:
    1. Sub test()
    2.   Dim cb as stdLambda
    3.   set cb = stdLambda.create("1+1")
    4.   Debug.Print cb()
    5. End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width