7 people like it.

# A parametric fixpoint combinator

Writing functions that recursively generate lambdas from a given parameter is a useful practice, but things get trickier when you need the output functions themselves to be mutually recursive. This is my attempt at creating a fix-point combinator that transparently handles this requirement. It also gives memoization for free as a side-effect.

 ``` 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: ``` ``````open System.Collections.Generic type Dictionary<'K,'V> with member d.TryFind(k : 'K) = let v = ref Unchecked.defaultof<_> if d.TryGetValue(k, v) then Some v.Value else None let rec Y F x = F (Y F) x // needs nicer name! let Y2 (F : ('Seed -> 'a -> 'b) -> 'Seed -> 'a -> 'b) = let dict = new Dictionary<'Seed, ('a -> 'b) ref> () let F' (self : ('Seed -> 'a -> 'b)) (s : 'Seed) = match dict.TryFind s with | None -> let fp = ref (fun _ -> failwith "Cannot handle recursive calls in this context!") dict.Add(s, fp) let f = F self s fp := f f | Some f -> (fun a -> f.Value a) Y F' // example : computing the maximum depth of F# DUs open System open System.Reflection open Microsoft.FSharp.Reflection let maxDepth<'T> = let f = Y2 (fun self (t : Type) -> printfn "Precomputing depth counter for %A" t if FSharpType.IsUnion t then let reader = FSharpValue.PreComputeUnionTagReader t // recursively precompute children let fieldDepth (f : PropertyInfo) = let depthF = self f.PropertyType in fun o -> f.GetValue(o, [||]) |> depthF let ucis = FSharpType.GetUnionCases(t) |> Seq.map(fun u -> u.Tag, u.GetFields() |> Array.map fieldDepth) |> Map.ofSeq fun (o : obj) -> let depths = ucis.[reader o] |> Array.map (fun f -> f o) if Seq.isEmpty depths then 0 else (Seq.max depths) + 1 else fun _ -> 0) typeof<'T> fun (x : 'T) -> f (x :> obj) type Peano = Zero | Succ of Peano let rec int2Peano = function 0 -> Zero | n -> Succ(int2Peano(n-1)) // Peano is recursive, would stack overflow if used regular Y combinator let d = maxDepth d <| Some (int2Peano 41) ``````
namespace System
namespace System.Collections
namespace System.Collections.Generic
Multiple items
type Dictionary<'TKey,'TValue> =
new : unit -> Dictionary<'TKey, 'TValue> + 5 overloads
member Add : key:'TKey * value:'TValue -> unit
member Clear : unit -> unit
member Comparer : IEqualityComparer<'TKey>
member ContainsKey : key:'TKey -> bool
member ContainsValue : value:'TValue -> bool
member Count : int
member GetEnumerator : unit -> Enumerator<'TKey, 'TValue>
member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
member Item : 'TKey -> 'TValue with get, set
...
nested type Enumerator
nested type KeyCollection
nested type ValueCollection

Full name: System.Collections.Generic.Dictionary<_,_>

--------------------
Dictionary() : unit
Dictionary(capacity: int) : unit
Dictionary(comparer: IEqualityComparer<'TKey>) : unit
Dictionary(dictionary: IDictionary<'TKey,'TValue>) : unit
Dictionary(capacity: int, comparer: IEqualityComparer<'TKey>) : unit
Dictionary(dictionary: IDictionary<'TKey,'TValue>, comparer: IEqualityComparer<'TKey>) : unit
val d : Dictionary<'TKey,'TValue>
member Dictionary.TryFind : k:'TKey -> 'TValue option

Full name: Script.TryFind
val k : 'TKey
val v : 'TValue ref
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
module Unchecked

from Microsoft.FSharp.Core.Operators
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
Dictionary.TryGetValue(key: 'TKey, value: byref<'TValue>) : bool
union case Option.Some: Value: 'T -> Option<'T>
property Ref.Value: 'TValue
union case Option.None: Option<'T>
val Y : F:(('a -> 'b) -> 'a -> 'b) -> x:'a -> 'b

Full name: Script.Y
val F : (('a -> 'b) -> 'a -> 'b)
val x : 'a
val Y2 : F:(('Seed -> 'a -> 'b) -> 'Seed -> 'a -> 'b) -> ('Seed -> 'a -> 'b) (requires equality)

Full name: Script.Y2
val F : (('Seed -> 'a -> 'b) -> 'Seed -> 'a -> 'b) (requires equality)
val dict : Dictionary<'Seed,('a -> 'b) ref> (requires equality)
val F' : (('Seed -> 'a -> 'b) -> 'Seed -> 'a -> 'b) (requires equality)
val self : ('Seed -> 'a -> 'b) (requires equality)
val s : 'Seed (requires equality)
member Dictionary.TryFind : k:'TKey -> 'TValue option
val fp : ('a -> 'b) ref
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
Dictionary.Add(key: 'Seed, value: ('a -> 'b) ref) : unit
val f : ('a -> 'b)
val f : ('a -> 'b) ref
val a : 'a
property Ref.Value: 'a -> 'b
namespace System.Reflection
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Reflection
val maxDepth<'T> : ('T -> int)

Full name: Script.maxDepth
val f : (obj -> int)
val self : (Type -> obj -> int)
val t : Type
type Type =
inherit MemberInfo
member Assembly : Assembly
member AssemblyQualifiedName : string
member Attributes : TypeAttributes
member BaseType : Type
member ContainsGenericParameters : bool
member DeclaringMethod : MethodBase
member DeclaringType : Type
member Equals : o:obj -> bool + 1 overload
member FindInterfaces : filter:TypeFilter * filterCriteria:obj -> Type[]
member FindMembers : memberType:MemberTypes * bindingAttr:BindingFlags * filter:MemberFilter * filterCriteria:obj -> MemberInfo[]
...

Full name: System.Type
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
type FSharpType =
static member GetExceptionFields : exceptionType:Type * ?bindingFlags:BindingFlags -> PropertyInfo []
static member GetFunctionElements : functionType:Type -> Type * Type
static member GetRecordFields : recordType:Type * ?bindingFlags:BindingFlags -> PropertyInfo []
static member GetTupleElements : tupleType:Type -> Type []
static member GetUnionCases : unionType:Type * ?bindingFlags:BindingFlags -> UnionCaseInfo []
static member IsExceptionRepresentation : exceptionType:Type * ?bindingFlags:BindingFlags -> bool
static member IsFunction : typ:Type -> bool
static member IsModule : typ:Type -> bool
static member IsRecord : typ:Type * ?bindingFlags:BindingFlags -> bool
static member IsTuple : typ:Type -> bool
...

Full name: Microsoft.FSharp.Reflection.FSharpType
static member FSharpType.IsUnion : typ:Type * ?allowAccessToPrivateRepresentation:bool -> bool
static member FSharpType.IsUnion : typ:Type * ?bindingFlags:BindingFlags -> bool
val reader : (obj -> int)
type FSharpValue =
static member GetExceptionFields : exn:obj * ?bindingFlags:BindingFlags -> obj []
static member GetRecordField : record:obj * info:PropertyInfo -> obj
static member GetRecordFields : record:obj * ?bindingFlags:BindingFlags -> obj []
static member GetTupleField : tuple:obj * index:int -> obj
static member GetTupleFields : tuple:obj -> obj []
static member GetUnionFields : value:obj * unionType:Type * ?bindingFlags:BindingFlags -> UnionCaseInfo * obj []
static member MakeFunction : functionType:Type * implementation:(obj -> obj) -> obj
static member MakeRecord : recordType:Type * values:obj [] * ?bindingFlags:BindingFlags -> obj
static member MakeTuple : tupleElements:obj [] * tupleType:Type -> obj
static member MakeUnion : unionCase:UnionCaseInfo * args:obj [] * ?bindingFlags:BindingFlags -> obj
...

Full name: Microsoft.FSharp.Reflection.FSharpValue
static member FSharpValue.PreComputeUnionTagReader : unionType:Type * ?allowAccessToPrivateRepresentation:bool -> (obj -> int)
static member FSharpValue.PreComputeUnionTagReader : unionType:Type * ?bindingFlags:BindingFlags -> (obj -> int)
val fieldDepth : (PropertyInfo -> 'a -> int)
val f : PropertyInfo
type PropertyInfo =
inherit MemberInfo
member Attributes : PropertyAttributes
member CanWrite : bool
member Equals : obj:obj -> bool
member GetAccessors : unit -> MethodInfo[] + 1 overload
member GetConstantValue : unit -> obj
member GetGetMethod : unit -> MethodInfo + 1 overload
member GetHashCode : unit -> int
member GetIndexParameters : unit -> ParameterInfo[]
member GetOptionalCustomModifiers : unit -> Type[]
...

Full name: System.Reflection.PropertyInfo
val depthF : (obj -> int)
property PropertyInfo.PropertyType: Type
val o : 'a
PropertyInfo.GetValue(obj: obj, index: obj []) : obj
PropertyInfo.GetValue(obj: obj, invokeAttr: BindingFlags, binder: Binder, index: obj [], culture: Globalization.CultureInfo) : obj
val ucis : Map<int,(obj -> int) []>
static member FSharpType.GetUnionCases : unionType:Type * ?allowAccessToPrivateRepresentation:bool -> UnionCaseInfo []
static member FSharpType.GetUnionCases : unionType:Type * ?bindingFlags:BindingFlags -> UnionCaseInfo []
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val u : UnionCaseInfo
property UnionCaseInfo.Tag: int
member UnionCaseInfo.GetFields : unit -> PropertyInfo []
type Array =
member Clone : unit -> obj
member CopyTo : array:Array * index:int -> unit + 1 overload
member GetEnumerator : unit -> IEnumerator
member GetLength : dimension:int -> int
member GetLongLength : dimension:int -> int64
member GetLowerBound : dimension:int -> int
member GetUpperBound : dimension:int -> int
member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
member Initialize : unit -> unit
member IsFixedSize : bool
...

Full name: System.Array
val map : mapping:('T -> 'U) -> array:'T [] -> 'U []

Full name: Microsoft.FSharp.Collections.Array.map
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
interface IEnumerable
interface IComparable
interface IEnumerable<KeyValuePair<'Key,'Value>>
interface ICollection<KeyValuePair<'Key,'Value>>
interface IDictionary<'Key,'Value>
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
member Add : key:'Key * value:'Value -> Map<'Key,'Value>
member ContainsKey : key:'Key -> bool
override Equals : obj -> bool
member Remove : key:'Key -> Map<'Key,'Value>
...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val ofSeq : elements:seq<'Key * 'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.ofSeq
val o : obj
type obj = Object

Full name: Microsoft.FSharp.Core.obj
val depths : int []
val isEmpty : source:seq<'T> -> bool

Full name: Microsoft.FSharp.Collections.Seq.isEmpty
val max : source:seq<'T> -> 'T (requires comparison)

Full name: Microsoft.FSharp.Collections.Seq.max
val typeof<'T> : Type

Full name: Microsoft.FSharp.Core.Operators.typeof
val x : 'T
type Peano =
| Zero
| Succ of Peano

Full name: Script.Peano
union case Peano.Zero: Peano
union case Peano.Succ: Peano -> Peano
val int2Peano : _arg1:int -> Peano

Full name: Script.int2Peano
val n : int
val d : (Peano option -> int)

Full name: Script.d
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>