TypeShape: Practical Generic Programming in F#

Eirik Tsarpalis

https://eiriktsarpalis.github.io/typeshape

About Me

  • Mathematician
  • F#/.NET developer
  • Co-Author of MBrace
  • Working at Jet in Dublin

Datatype Generic Programming

"Programs parameterized by shapes of datatypes"

Scrap your Boilerplate

Example

1: 

val print : 'T -> string

1: 
2: 
3: 
4: 
5: 
6: 

> print false ;;
val it : string = "false"
> print 42
val it : string = "42"
> print [Some (false, 42)] ;;
val it : string = "[Some (false, 42)]"

Another Example

1: 
2: 
3: 
4: 

namespace Newtonsoft.Json

val serialize   : 'T -> string
val deserialize : string -> 'T

Yet Another Example

1: 
2: 
3: 
4: 

namespace FsCheck

module Arb =
    val generate<'T> : Gen<'T>

Yet Another Example

1: 

val mkComparer<'T> : unit -> IComparer<'T>

Implementing Print?

1: 

val print : 'T -> string

Implementing Print

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 

let rec print (value : 'T) : string =
    match value with
    | :? int as i -> string i
    | :? string as s -> s
    | :? ('a * 'b) as (a,b) -> sprintf "(%s, %s)" (print a) (print b)
    | :? ('a option) as None -> "None"
    | :? ('a option) as Some a -> sprintf "Some %s" (print a)
    | _ -> value.ToString()

That's Invalid .NET!

Reality?

Reality: Reflection

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 

let rec print (value : obj) =
    match value with
    | null -> "<null>"
    | :? int as i -> string i
    | :? string as s -> s
    | _ ->
        let t = value.GetType()
        let isGenTypeOf (gt : Type) =
            t.IsGenericType && gt = t.GetGenericTypeDefinition()
        if isGenTypeOf typedefof<_ option> then
            let value = t.GetProperty("Value").GetValue(value)
            sprintf "Some %s" (print value)
        elif isGenTypeOf typedefof<_ * _> then
            let v1 = t.GetProperty("Item1").GetValue(value)
            let v2 = t.GetProperty("Item2").GetValue(value)
            sprintf "(%s, %s)" (print v1) (print v2)
        else
            value.ToString()

Reflection: tedious, unsafe, ugly, slow.

TypeShape

  • Library for generic programming
  • Techniques originating from MBrace/FsPickler
  • Founded on .NET Generics

Demo

Interlude: Existential Types

Universal Quantifiers

1: 

val length : ∀'T. 'T list -> int


1: 
2: 
3: 

length [1;2;3]
length ["a";"b"]
length [(1,2);(3,4)]

Existential Quantifiers

1: 
2: 
3: 

type Cell<'T> = { Items : 'T list }

type Cell = ∃'T. Cell<'T>

Existential Packing

1: 
2: 
3: 

type Cell<'T> = { Items : 'T list }

type Cell = ∃'T. Cell<'T>


1: 

val pack : Cell<'a> -> Cell

Existential Packing

1: 
2: 

let c = pack { Items = [1;2] }     // Cell<int>    -> ∃'T. Cell<'T>
let c = pack { Items = ["a";"b"] } // Cell<string> -> ∃'T. Cell<'T>

Examples of Existential Packing in .NET?

1: 
2: 
3: 
4: 
5: 

open System.Threading.Tasks

type Task = ∃'T. Task<'T>

let pack (task : Task<'T>) = task :> Task

Encoding Existential Packing

1: 
2: 
3: 
4: 
5: 
6: 

type Cell = interface end

type Cell<'T> = { Items : 'T list }
with interface Cell

let pack (c : Cell<'T>) = c :> Cell

Existential Unpacking

1: 
2: 
3: 

let getLength (cell : Cell) =  
    let (cell : Cell<'T>) = unpack cell
    in List.length cell.Items

Again, not valid .NET code

Encoding Existential Unpacking in .NET?

Does this Work?

1: 

let unpack<'T> (c : Cell) = c :?> Cell<'T>

Nope!

  • Guessing the payload by passing a type argument.
  • Wrong guesses result in runtime errors!
  • Need to safely unpack the existential payload.

Existential Unpacking

1: 

val unpack<'R> : (∃'T. Cell<'T>) -> (∀'T. Cell<'T> -> 'R) -> 'R

Rank-2 types

  • The second argument is a Rank-2 lambda.
  • Polymorphic on the input type.

F# lambdas are not Rank-2.

F# funcs are not rank-2

F# Lambdas

1: 
2: 

type FSharpFunc<'T,'S> =
    abstract Invoke : 'T -> 'S

A Rank-2 encoding

1: 
2: 
3: 
4: 
5: 

type GFunc<'R> =
    abstract Invoke<'T> : 'T -> 'R

let test (f : GFunc<int>) =
    f.Invoke 42 + f.Invoke "42"

Encoding Existentials

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 

type Cell =
    abstract Accept : CellFunc<'R> -> 'R

and Cell<'T> = { Items : 'T list }
with 
    interface Cell with
      member cell.Accept f = f.Invoke<'T> cell

and CellFunc<'R> =
    abstract Invoke<'T> : Cell<'T> -> 'R

let pack (cell : Cell<'T>) = cell :> Cell
let unpack (cell : Cell) (f : CellFunc<'R>) : 'R = cell.Accept f

Using Unpack

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 

let getLength cell =
    unpack cell 
        { new CellFunc<int> with 
            member __.Invoke (cell : Cell<'T>) =
              List.length cell.Items }

let c1 : Cell = pack { Items = ["value"] }
let c2 : Cell = pack { Items = [1 .. 100] }

getLength c1
getLength c2

TypeShape as Existential Types

TypeShape

1: 
2: 
3: 

type TypeShape<'T> = TypeShape // phantom type

type TypeShape = ∃'T. TypeShape<'T>

TypeShape

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9: 

type ITypeVisitor<'R> =
    abstract Visit<'T> : unit -> 'R

type TypeShape =
    abstract Accept : ITypeVisitor<'R> -> 'R

type TypeShape<'T>() =
    interface TypeShape with
        override __.Accept v = v.Visit<'T>()

Generating Existentials

1: 
2: 
3: 

let mkShape (t : Type) =
    let tsty = typedefof<TypeShape<_>>.MakeGenericType [|t|]
    Activator.CreateInstance tsty :?> TypeShape

A Simple Example

1: 
2: 
3: 

mkShape(Type.GetType "System.Int32")
    .Accept { new ITypeVisitor<Type> with 
                member __.Visit<'T>() = typeof<'T> }

1: 

val it : Type = System.Int32

A Less Simple Example

1: 
2: 

type MyApi =
    static member MyMethod<'T>(?value : 'T) : 'T option = value

Objective: Implement the untyped version

1: 

val myMethodUntyped : value:obj -> obj

Using Reflection

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 

let invokeUntyped (value:obj) =
    // Step 1: get the underlying System.Type for the value
    let t = value.GetType()
    // Step 2: locate the required method and apply the type argument
    let methodInfo =
        typeof<MyApi>
            .GetMethod("MyMethod", BindingFlags.Public ||| BindingFlags.Static)
            .MakeGenericMethod [|t|]
 
    // Step 3: since the parameter is optional, it must be wrapped
    let optTy = typedefof<_ option>.MakeGenericType [|t|]
    let optCtor = optTy.GetConstructor [|t|]
    let optVal = optCtor.Invoke [|value|]
 
    /// Step 4: invoke the method with constructed optional parameter
    methodInfo.Invoke(null, [|optVal|])

Using TypeShape

1: 
2: 
3: 
4: 
5: 

let invokeUntyped' (value:obj) =
    let shape = mkShape(value.GetType())
    shape.Accept { new ITypeVisitor<obj> with
        member __.Visit<'T>() = MyApi.MyMethod(value :?> 'T) :> obj
    }

Other Shapes

Other Shapes

1: 
2: 
3: 
4: 
5: 

type ShapeTuple<'T1,'T2> = TypeShape<'T1 * 'T2>

type ShapeTuple = ∃'T1,'T2. ShapeTuple<'T1,'T2>

val (|ShapeTuple|_|) : System.Type -> ShapeTuple option

Other Shapes

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9: 

type ITupleVisitor<'R> =
    abstract Visit<'T1,'T2> : unit -> 'R

type ShapeTuple =
    abstract Accept : ITupleVisitor<'R> -> 'R

type ShapeTuple<'T1,'T2>() =
    interface ShapeTuple with
        member __.Accept v = v.Visit<'T1,'T2> ()

Other Shapes

1: 
2: 
3: 
4: 
5: 
6: 
7: 

let (|ShapeTuple|_|) (t : Type) =
    if t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<_ * _> then
        let typeArgs = t.GetGenericArguments()
        let ty = typedefof<ShapeTuple<_,_>>.MakeGenericType typeArgs
        Activator.CreateInstance ty :?> ShapeTuple |> Some
    else
        None

Other Shapes

1: 
2: 
3: 
4: 
5: 

type ShapeSet<'T when 'T : comparison> = TypeShape<Set<'T>>

type ShapeSet = ∃'T. ShapeSet<'T>

val (|ShapeSet|_|) : System.Type -> ShapeSet option

Other Shapes

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9: 

type ISetVisitor<'R> =
    abstract Visit<'T when 'T : comparison> : unit -> 'R

type ShapeSet =
    abstract Accept : ISetVisitor<'R> -> 'R

type ShapeSet<'T when 'T : comparison>() =
    interface ShapeSet with
     member __.Accept v = v.Visit<'T>()

Other Shapes

1: 
2: 
3: 
4: 
5: 
6: 
7: 

let (|ShapeSet|_|) (t : Type) =
    if t.IsGenericType && t.GetGenericTypeDefinition() = typeof<Set<_>> then
        let typeArgs = t.GetGenericArguments()
        let st = typedefof<ShapeSet<_>>.MakeGenericType typeArgs
        Activator.CreateInstance st :?> ShapeSet |> Some
    else
        None

Arbitrary Type Shapes

Code Lenses

1: 
2: 
3: 
4: 
5: 

type Lens<'T,'F> =
    {
        Get : 'T -> 'F
        Set : 'T -> 'F -> 'T
    }

Code Lenses

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9: 

type R = { A : int ; B : string }

let lensA : Lens<R, int> = 
    { Get = fun r -> r.A
    ; Set = fun r a -> { r with A = a }}

let lensB : Lens<R, string> =
    { Get = fun r -> r.B
    ; Set = fun r b -> { r with B = b }}

Field & Record Shapes

1: 
2: 
3: 
4: 
5: 

type ShapeField<'T> = ∃'F. Lens<'T,'F>

type ShapeRecord<'T> = ShapeField<'T> list

val (|ShapeRecord|_|) : TypeShape<'T> -> ShapeRecord<'T> option

Union Shapes

1: 
2: 
3: 

type ShapeUnion<'T> = ShapeRecord<'T> list

val (|ShapeUnion|_|) : TypeShape<'T> -> ShapeUnion<'T> option

Adding TypeShape to your project

1: 
2: 

# paket.dependencies
github eiriktsarpalis/TypeShape src/TypeShape/TypeShape.fs

Samples

https://github.com/eiriktsarpalis/TypeShape/

Thank You!