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
2 Answers 2
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.)
-
\$\begingroup\$ Please don't consider it a full review. I don't understand linked lists or immutability all that well. \$\endgroup\$RubberDuck– RubberDuck2014年11月06日 20:31:17 +00:00Commented 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\$cheezsteak– cheezsteak2014年11月07日 16:24:48 +00:00Commented 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\$RubberDuck– RubberDuck2014年11月07日 16:28:02 +00:00Commented Nov 7, 2014 at 16:28
-
\$\begingroup\$ ++ the documentation and sample use case would be really helpful I think. \$\endgroup\$user28366– user283662014年11月10日 10:25:16 +00:00Commented Nov 10, 2014 at 10:25
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?
-
\$\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\$RubberDuck– RubberDuck2014年11月10日 10:34:43 +00:00Commented 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\$user28366– user283662014年11月10日 10:54:42 +00:00Commented 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\$cheezsteak– cheezsteak2014年11月10日 14:36:10 +00:00Commented Nov 10, 2014 at 14:36
Friend
members ;) \$\endgroup\$Friend
. \$\endgroup\$