Immutable Linked List in VBA

Question

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

Answer 1

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.)

Answer 2

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?