9
\$\begingroup\$

I made an immutable list class using the head-tail idiom. If I did this correctly, it implements persistent data structures. Unfortunately it doesn't scale well as VBA is not tail recursive. Note: I use a method called seq.Assign to handle assigning objects without using Set. I would like to copy the objects and preserve immutability but for now; if you build a List of mutable objects and mutate one of those objects it will mutate the contents of that list and any list built from that list.

Let's get some basics out of the way.

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "SList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True ' Client code cannot use `new` Keyword
Attribute VB_Exposed = True
Option Explicit

Private Members

Private TypedName As String
Private pHead As Variant
Private pTail As SList

TypeChecking

SList is also strongly typed using the following methods and boilerplate code

''
' TypeCheck:
Friend Sub TypeCheck(ByVal element As Variant, ByVal source As String)
 If TypedName = vbNullString Then TypedName = TypeName(element)
 If (TypeName(element) <> TypedName) Then RaiseTypeError element, source
End Sub
''
' RaiseTypeError:
Private Sub RaiseTypeError(ByVal badItem As Variant, ByVal method As String)
 Err.Raise 13, method, "Element is of type " & TypeName(badItem) & _
 ", not " & TypedName & "."
End Sub
Private Sub RaiseEmptyError(ByVal method As String)
 Err.Raise 9, TypeName(Me) & "." & method, method & " cannot be called on Empty List!"
End Sub
Private Sub RaiseOutOfRangeError(Byval method As String)
 Err.Raise 9, TypeName(Me) & "." & method, method & " Index is out of range!"
End Sub

Friend Methods (mutability)

These methods violate mutability and should only be used carefully in constructor functions.

Friend Property Let Head(ByVal x As Variant)
 TypeCheck x, "Head"
 seq.Assign pHead, x
End Property
Friend Property Set refEnd(ByRef that As SList)
 If pTail Is Nothing Then
 Set pTail = that
 ElseIf pTail.IsNil Then
 Set pTail = that
 Else
 Set pTail.refEnd = that
 End If
End Property

Note refEnd goes to the entire end of the list.

Iteration

The collection must be persistent in order to iterate over it. I chose to keep it static to confine it to this function but that is up for debate.

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
 Static tempCollection As Collection
 If tempCollection Is Nothing Then Set tempCollection = ToCollection
 Set NewEnum = tempCollection.[_NewEnum]
End Property

Constructors

Client Code will need to use these to create a new SList object

Basic

Public Function Nil() As SList
 Set Nil = New SList
End Function
Public Function Node(ByVal elem As Variant) As SList
 Set Node = Cons(elem, Nil)
End Function
Public Function Cons(ByVal hd As Variant, ByRef tl As SList) As SList
 If Not tl.IsNil Then tl.TypeCheck hd, "Cons"
 Dim made As New SList
 made.Head = hd
 Set made.refEnd = tl
 Set Cons = made
End Function

Convenience

Public Function Create(ParamArray args() As Variant) As SList
 Set Create = Copy(args)
End Function
Public Function Copy(ByVal sequence As Variant) As SList
 Dim result As SList
 Set result = Nil
 Dim element As Variant
 For Each element In sequence
 If result.IsNil Then
 Set result = Node(element)
 Else
 Set result.refEnd = Node(element)
 End If
 Next
 Set Copy = result
End Function

Copy is essential because I use it to copy existing instances as shown in the following Append and Concat.

Builders

I am unsure if my usage of Copy and refEnd as shortcuts is acceptable.

Public Function Prepend(ByVal elem As Variant) As SList
 TypeCheck elem, "Prepend"
 Set Prepend = Cons(elem, Me)
End Function
Public Function Append(ByVal elem As Variant) As SList
 TypeCheck elem, "Append"
 Set Append = Copy(Me)
 Set Append.refEnd = Node(elem)
End Function
Public Function Concat(ByVal that As SList) As SList
 TypeCheck that.Head, "Concat"
 Set Concat = Copy(that)
 Set Concat.refEnd = Me
End Function

Properties

Primitive

Public Property Get IsNil() As Boolean
 IsNil = IsEmpty(pHead)
End Property
Public Property Get Head() As Variant
 If IsNil Then
 RaiseEmptyError "Head"
 Else
 seq.Assign Head, pHead
 End If
End Property
Public Property Get Tail() As SList
 If IsNil Then
 RaiseEmptyError "Tail"
 Else
 Set Tail = pTail
 End If
End Property

Non Primitive

Public Property Get Last() As Variant
 If IsNil Then
 RaiseEmptyError "Last"
 ElseIf pTail.IsNil Then
 seq.Assign Last, pHead
 Else
 seq.Assign Last, pTail.Last
 End If
End Property
Public Property Get Init() As SList
 If IsNil Then
 RaiseEmptyError "Init"
 ElseIf pTail.IsNil Then
 Set Init = Nil
 Else
 Set Init = pTail.Init.Prepend(pHead)
 End If
End Property
Public Property Get Length() As Long
 If IsNil Then
 Length = 0
 Else
 Length = 1 + pTail.Length
 End If
End Property
Public Property Get Max() As Variant
 If IsNil Then
 Set Max = Nothing
 ElseIf pTail.IsNil Then
 seq.Assign Max, pHead
 Else
 Dim other As Variant
 seq.Assign other, pTail.Max
 seq.Assign Max, IIf(pHead > other, pHead, other)
 End If
End Property
Public Property Get Min() As Variant
 If IsNil Then
 Set Min = Nothing
 ElseIf pTail.IsNil Then
 seq.Assign Min, pHead
 Else
 Dim other As Variant
 seq.Assign other, pTail.Min
 seq.Assign Min, IIf(pHead < other, pHead, other)
 End If
End Property
Public Property Get Reverse() As SList
 If pTail.IsNil Then
 Set Reverse = Me
 Else
 Set Reverse = Node(pHead).Concat(pTail.Reverse)
 End If
End Property
Public Property Get ToArray() As Variant()
 Dim size As Long
 size = Length
 Dim a() As Variant
 ReDim a(size - 1) As Variant
 BuildArray a, 0
 ToArray = a
End Sub
 Friend Sub BuildArray(ByRef a() As Variant, ByVal index As Long)
 If Not IsNil Then
 a(index) = pHead
 pTail.BuildArray a, index + 1
 End If
 End Sub
Public Property Get ToCollection() As Collection
 Dim result As New Collection
 Dim elem As Variant
 For Each elem In ToArray
 result.Add elem
 Next elem
 Set ToCollection = result
End Property

Functions

Public Property Get Item(ByVal n As Long) As Variant
 If n = 0 Then
 seq.Assign Item, pHead
 ElseIf pTail.IsNil Then
 RaiseOutOfRangeError("Item")
 Else
 seq.Assign Item, pTail.Item(n - 1)
 End If
End Property
Public Function Take(ByVal n As Long) As SList
 If IsNil Or n <= 0 Then
 Set Take = Nil
 Else
 Set Take = pTail.Take(n - 1).Prepend(pHead)
 End If
End Function
Public Function TakeLeft(ByVal n As Long) As SList
 Set TakeLeft = Drop(Length - n)
End Function
Public Function Drop(ByVal n As Long) As SList
 If n <= 0 Or IsNil Then
 Set Drop = Me
 Else
 Set Drop = pTail.Drop(n - 1)
 End If
End Function
Public Function DropRight(ByVal n As Long) As SList
 Set DropRight = Take(Length - n)
End Function
Public Function DropAt(ByVal n As Long) As SList
 Set DropAt = Drop(n).Concat(Take(n - 1))
End Function
Public Function Contains(ByVal elem As Variant) As Boolean
 If IsNil Then
 Contains = False
 ElseIf elem = pHead Then
 Contains = True
 Else
 Contains = pTail.Contains(elem)
 End If
End Function
Public Function IndexOf(ByVal elem As Variant) As Long
 If pHead = elem Then
 IndexOf = 0
 ElseIf pTail.IsNil Then
 IndexOf = -1
 Else
 Dim index As Long
 index = pTail.IndexOf(elem)
 IndexOf = IIf(index = -1, -1, 1 + index)
 End If
End Function
Public Function LastIndexOf(ByVal elem As Variant) As Long
 LastIndexOf = (Length - 1) - Reverse.IndexOf(elem)
End Function
asked Nov 3, 2014 at 22:38
\$\endgroup\$
3
  • \$\begingroup\$ These methods violate mutability - only from within the same VBAProject; put this class in an Excel add-in (say, VBToolBox.xlam), and the client code that references it will not be able to call the Friend members ;) \$\endgroup\$ Commented Nov 3, 2014 at 22:43
  • 1
    \$\begingroup\$ Nicely laid out question ++ \$\endgroup\$ Commented Nov 4, 2014 at 1:38
  • 2
    \$\begingroup\$ @Mat'sMug that was the idea of making them Friend. \$\endgroup\$ Commented Nov 4, 2014 at 14:20

2 Answers 2

4
\$\begingroup\$

I like that you prefer to use VBA's built in runtime errors, but...

Private Sub RaiseEmptyError(ByVal method As String)
 Err.Raise 9, TypeName(Me) & "." & method, method & " cannot be called on Empty List!"
End Sub
Private Sub RaiseOutOfRangeError(Byval method As String)
 Err.Raise 9, TypeName(Me) & "." & method, method & " Index is out of range!"
End Sub

You're raising two different errors with the same error number. As someone using this list, I would probably want to handle those two errors differently, but I would need two different error numbers to do so. I encourage you to define a custom error for the list being empty. The out of range error is fine as it is.


The code is neat and clean as far as I can tell. Variables and Methods/Properties have meaningful and clear names mostly. You overshorted some of them and I'm a little confused by what the Nil Function is, but I suspect someone familiar with Python wouldn't be. (Okay, I'm not really, but I had to read the code to understand that it returns an empty list).

This could be cleared up with some documentation I suspect. A few comments explaining what each procedure does would go a long way. Perhaps even some Item.VB_Description attributes so they show up in intellisense too? That's always nice to have when you're working with an unfamiliar class or library. Of course, don't get carried away. You don't need to tell us what Contains does, but it would be nice to understand what Public Function Cons is. (Again, I know it's a constructor, but you could never tell that from it's name alone.)

answered Nov 6, 2014 at 20:30
\$\endgroup\$
4
  • \$\begingroup\$ Please don't consider it a full review. I don't understand linked lists or immutability all that well. \$\endgroup\$ Commented Nov 6, 2014 at 20:31
  • \$\begingroup\$ It's not a Python List which is really a mutable collection. This is supposed to be the generic list, common in functional programming languages. \$\endgroup\$ Commented Nov 7, 2014 at 16:24
  • \$\begingroup\$ Sorry. Bad assumption on my part. I know that a lot of your code is meant to mimic Python classes. Oops. \$\endgroup\$ Commented Nov 7, 2014 at 16:28
  • \$\begingroup\$ ++ the documentation and sample use case would be really helpful I think. \$\endgroup\$ Commented Nov 10, 2014 at 10:25
3
+100
\$\begingroup\$

I know it's just a comment but generally

Attribute VB_PredeclaredId = True ' Client code cannot use `new` Keyword

It doesn't mean that the client code cannot use the new keyword. Changing the attribute to true means that this class can also act like a regular standard coding module. Which makes it an imitation of a static class. The client code can still use the new keyword just fine:

Dim s As SList
Set s = New SList
' or
Dim sNew As New SList

Due to the fact that you actually can use the new keyword your Nil function becomes obsolete. For example in your Copy function you have this:

Dim result As SList
Set result = Nil

Which seems to be nothing else but a wrapper for Set result = new SList.

Also, your ToArray() throws a Subscript out of Range runtime error if SList is empty. You may want to handle that by checking either size variable or Length property is at least > 0. Your ToCollection would also be affected (would fail) since it uses ToArray call in the for each loop.

Trying to call a s.Item(0) throws a variable not declared error for the seq variable. Where is that dimensioned and initialized in your code?

answered Nov 10, 2014 at 9:32
\$\endgroup\$
3
  • \$\begingroup\$ I think the intent is to keep this in a "library" project, so it needs a factory method of some sort. Setting PredeclaredId=True allows for Nil to act as a proxy of sorts. \$\endgroup\$ Commented Nov 10, 2014 at 10:34
  • 2
    \$\begingroup\$ @RubberDuck maybe you're right. I based my review off I made an immutable list class. \$\endgroup\$ Commented Nov 10, 2014 at 10:54
  • \$\begingroup\$ seq.Assign is an external method to handle assigning an object or a datatype to a variant as explained in the first paragraph. if isObject(y) Then set x=y else x=y endif \$\endgroup\$ Commented Nov 10, 2014 at 14:36

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.