Ok, we have almost everything on hand to write a clean and honest recursion-free factorial in VB, albeit with recursive types. I actually struggled with this for some time, the problem being that we have functions of Long to Long—call those of type df, then functions from df to df—call those of type dh, then functions from dh to df, and functions from dh to dh—mmm, ok this situation isn’t converging. If we needed two flashes and one rolling thunderstorm of genius to get this far, it was looking like we might need a cat-3 hurricane of genius to get past it. Fortunately, my colleague, Mark Shields, showed me the way out. I’m not sure I would ever have thought of this myself, but it’s a lovely technique and it’s now added permanently to my bag of tricks. The technique is to model the type system itself—in miniature, of course—with a Universal type U that can model either a Long or a function from U to U. Now, all the variety of function types are swept up under one, large, inclusive rug. To model a Long, we’ll have a MustOverride ReadOnly Property that returns the Long value, and to model a function we’ll model function application itself through a MustOverride function named [Of] that takes a U and returns a U (square brackets let us reuse a keyword for our own purposes, and Of is the keyword for generic types, which we’re not using here for simplicity. We could have called the function appliedTo, but [Of] turns out to be definitely prettier, as we shall see):
MustInherit Class U
MustOverride ReadOnly Property V() As Long
MustOverride Function [Of](ByVal u As U) As U
End Class
Of course, we COULD use generics, replacing Long with a type variable T, but that’s a tweak at best. Let’s move on. For the subtype of U representing Long, we just need [Of] to throw:
Class I
Inherits U
Private i0 As Long
Sub New(ByVal i As Long)
i0 = i
End Sub
Overrides ReadOnly Property V() As Long
Get
Return i0
End Get
End Property
Overrides Function [Of](ByVal x As U) As U
Throw New ApplicationException( _
"Sorry, can't apply a Long to an argument")
End Function
End Class
The subtype of U that represents functions should be MustInherit itself, and, of course, should throw on attempted access of the Long property, which just doesn’t obtain for functions:
MustInherit Class ?
Inherits U
Overrides ReadOnly Property V() As Long
Get
Throw New ApplicationException( _
"Sorry, can't get the value of a function")
End Get
End Property
End Class
Let’s start with the ultimate target for application of the y combinator. We called this f in the previous blogs on this theme. This is a function of two arguments, the first of which is the factorial function itself, the second of which is a Long number to which to apply factorial. Since we’re currying, we represent this as a function of a function that returns a function of a Long, represented in-turn by two subclasses of ?, remembering to make closures over free variables:
REM Currying: ? g -> (? n -> ...). This is our target for y.
Class f
Inherits ?
Overrides Function [Of](ByVal fact As U) As U
Return New OfN(fact)
End Function
End Class
REM ? n -> if n=0 return 1 else return n * fact(n - 1)
Class OfN
Inherits ?
Private fact As ?
Sub New(ByVal h As ?) REM inflate the closure
Me.fact = h
End Sub
Overrides Function [Of](ByVal N As U) As U
Dim i = N.V
If i = 0 Then
Return New I(1)
Else
Return New I(i * fact.[Of](New I(i - 1)).V)
End If
End Function
End Class
The money line is highlighted. Even though there is lots of machinery laying around, this is almost readable. Ok, now y itself, which we derived last time, with two auxiliary classes with closures, one for each of the lambda forms it uses internally:
REM y h = [? z -> h(? a -> z z a)] [? z -> h(? a -> z z a)]
Class Y
Inherits ?
Overrides Function [Of](ByVal h As U) As U
Dim z As New OfZ_hFree(h)
Return z.[Of](z)
End Function
End Class
REM [? z -> h(? a -> z z a)]
Class OfZ_hFree
Inherits ?
Private H As U
Sub New(ByVal H As U)
Me.H = H
End Sub
Overrides Function [Of](ByVal z As U) As U
Return H.[Of](New OfA_zFree(z))
End Function
End Class
REM (? a -> z z a)
Class OfA_zFree
Inherits ?
Private Z As U
Sub New(ByVal Z As U)
Me.Z = Z
End Sub
Overrides Function [Of](ByVal a As U) As U
Return Z.[Of](Z).[Of](a)
End Function
End Class
That’s it! We’re done, and we really just had to read off the mathematics. Wasn’t too hard once Mark showed me the road. By the way, if you change y so that it uses the following, divergent form, you can generate stack-overflows and check that we really do need the one with delayed application:
REM [? z -> h(z z)] : Loops forever
Class OfZ_hFree_diverges
Inherits ?
Private H As U
Sub New(ByVal H As U)
Me.H = H
End Sub
Overrides Function [Of](ByVal z As U) As U
Return H.[Of](z.[Of](z))
End Function
End Class
Ok, let’s call it and call it a day:
Module Module1
Sub Main()
Dim y = New Y()
Dim fact = y.[Of](New f)
Dim result = fact.[Of](New I(20))
Console.WriteLine("{0}", result.V)
Console.Write("Press any key to end the program...")
Console.ReadKey()
End Sub
End Module
