Generic Tuple functions

tuple.fsx

// Based on http://nut-cracker.azurewebsites.net/blog/2011/11/07/functions-for-n-tuples/

// Warning: This script has long compile times
// but as from F# 4.1 will work fine
// due to this fix: https://github.com/Microsoft/visualfsharp/pull/1682 in the compiler

open System
type Infinite<'a> = Infinite of 'a
    
module TupleInternalValues =

    type Uncons = Uncons with
        static member ($) (Uncons, Infinite x1              ) = (x1, Infinite x1)
        static member ($) (Uncons, x1:Tuple<_>              ) = (x1.Item1, ())
        static member ($) (Uncons, (x1,x2)                  ) = (x1, Tuple x2)
        static member ($) (Uncons, (x1,x2,x3)               ) = (x1, (x2,x3))
        static member ($) (Uncons, (x1,x2,x3,x4)            ) = (x1, (x2,x3,x4))
        static member ($) (Uncons, (x1,x2,x3,x4,x5)         ) = (x1, (x2,x3,x4,x5))
        static member ($) (Uncons, (x1,x2,x3,x4,x5,x6)      ) = (x1, (x2,x3,x4,x5,x6))
        static member ($) (Uncons, (x1,x2,x3,x4,x5,x6,x7)   ) = (x1, (x2,x3,x4,x5,x6,x7))
        static member ($) (Uncons, (x1,x2,x3,x4,x5,x6,x7,x8)) = (x1, (x2,x3,x4,x5,x6,x7,x8))
 
    type Cons = Cons with
        static member ($) (Cons, ()                    ) = fun x -> Tuple x
        static member ($) (Cons, x1:Tuple<_>           ) = fun x -> (x,x1.Item1)
        static member ($) (Cons, (x1,x2)               ) = fun x -> (x,x1,x2)
        static member ($) (Cons, (x1,x2,x3)            ) = fun x -> (x,x1,x2,x3)
        static member ($) (Cons, (x1,x2,x3,x4)         ) = fun x -> (x,x1,x2,x3,x4)
        static member ($) (Cons, (x1,x2,x3,x4,x5)      ) = fun x -> (x,x1,x2,x3,x4,x5)
        static member ($) (Cons, (x1,x2,x3,x4,x5,x6)   ) = fun x -> (x,x1,x2,x3,x4,x5,x6)
        static member ($) (Cons, (x1,x2,x3,x4,x5,x6,x7)) = fun x -> (x,x1,x2,x3,x4,x5,x6,x7)
 
    let inline (|Cons|) tuple   = Uncons $ tuple
    let inline cons (head,tail) = Cons $ tail <| head


    type GMap = GMap with
        static member inline (?<-) (GMap, f, ())                        = ()
        static member inline (?<-) (GMap, f, x1:Tuple<_>)               = Tuple(f $ x1.Item1)
        static member inline (?<-) (GMap, f, (x1,x2))                   = (f $ x1,f $ x2)
        static member inline (?<-) (GMap, f, (x1,x2,x3))                = (f $ x1,f $ x2,f $ x3)
        static member inline (?<-) (GMap, f, (x1,x2,x3,x4))             = (f $ x1,f $ x2,f $ x3,f $ x4)
        static member inline (?<-) (GMap, f, (x1,x2,x3,x4,x5))          = (f $ x1,f $ x2,f $ x3,f $ x4,f $ x5)
        static member inline (?<-) (GMap, f, (x1,x2,x3,x4,x5,x6))       = (f $ x1,f $ x2,f $ x3,f $ x4,f $ x5,f $ x6)
        static member inline (?<-) (GMap, f, (x1,x2,x3,x4,x5,x6,x7))    = (f $ x1,f $ x2,f $ x3,f $ x4,f $ x5,f $ x6,f $ x7)
        static member inline (?<-) (GMap, f, (x1,x2,x3,x4,x5,x6,x7,x8)) = (f $ x1,f $ x2,f $ x3,f $ x4,f $ x5,f $ x6,f $ x7,f $ x8)

    type Rev = Rev with
        static member inline ($) (Rev, Cons(h,t)) = fun ac -> ($) Rev t (cons(h, ac))
        static member        ($) (Rev, ()       ) = id        
            
    type Map = Map with
        static member inline ($) (Map, Cons(h,t)) = fun fn -> cons(fn h, ($) Map t fn)
        static member        ($) (Map, ()       ) = ignore        

    type Ap = Ap with
        static member inline ($) (Ap, Cons(hf,tf)) = fun (Cons(hx,tx)) -> cons(hf hx, ($) Ap tf tx)
        static member        ($) (Ap, ()         ) = ignore
        
    type Fold = Fold with
        static member inline ($) (Fold, Cons(h,t)) = fun fn z -> ($) Fold t fn (fn z h)
        static member        ($) (Fold, ()       ) = fun fn z -> z        

    type THead = THead with static member inline ($) (i:THead, tuple) = ($) Uncons tuple |> fst
    type TTail = TTail with static member inline ($) (i:TTail, tuple) = ($) Uncons tuple |> snd

    let inline mapHead x = (?<-) GMap THead x
    let inline mapTail x = (?<-) GMap TTail x

    type Transpose = Transpose with
        static member inline ($) (Transpose, matHead: ^a when ^a : not struct) =
            fun (mat, acc) ->
                let matRest  = mapTail mat
                let matFirst = mapHead mat
                let nextAcc = ($) Cons acc matFirst
                let headMatRest, _ = Uncons $ matRest
                ($) Transpose headMatRest (matRest, nextAcc)
        static member inline ($) (Transpose, ()) = fun (_, acc) -> acc
        

open TupleInternalValues

module Tuple =
    let inline head   tuple = ($) Uncons tuple |> fst
    let inline tail   tuple = ($) Uncons tuple |> snd
    let inline uncons tuple = ($) Uncons tuple

    let inline rev tuple            = ($) Rev tuple ()
    let inline append tuple1 tuple2 = ($) Rev (rev tuple1) tuple2
    let inline map fn tuple         = ($) Map tuple fn
    
    let inline fold fn z tuple = ($) Fold tuple fn z

    let inline transpose mat = (mat, ()) |> (Transpose $ head mat) |> rev

    
    let inline cons head tail = ($) Cons tail head
    let inline gmap f x = (?<-) GMap f x
    let inline applySingle f1f2f3_fn x = ($) Ap f1f2f3_fn (Infinite x)

    // derive some common functions
    let inline fst tuple = head tuple
    let inline snd tuple = tail tuple |> fst
    let inline trd tuple = tail tuple |> snd 

    let inline vectorFunction f1f2f3_fn x = map ((|>) x) f1f2f3_fn
    
let inline (<*>) fnTuple tuple = ($) Ap fnTuple tuple    


// Examples

// map a function to a tupled values of the same type
let m1 = Tuple.map string (Tuple 5)               // val m1 : Tuple<string> = ("5")
let m2 = Tuple.map string (5, 10)                 // val m2 : string * string = ("5", "10")
let m3 = Tuple.map ((+)1) (5, 10)                 // val m3 : int * int * int = (6, 11)

// apply tupled values pairwise to a tuple of functions
let a1 = (string, String.length) <*> (4, "world") // val a1 : string * int = ("4", 5)
let inline fa2 x = (string, (+) 10) <*> x         // val inline fa2 :   ^a -> string * int ...
let a2 = fa2 (true, 1)                            // val a2 : string * int = ("True", 11)

// apply a single value to each element of a tuple of functions
let v1 = Tuple.applySingle (Tuple ((+) 1)) 20     // val v1 : Tuple<int> = (21)
let v2 = Tuple.applySingle (string, (+) 1) 15     // val v2 : string * int = ("15", 16)

// fold tupled values of the same type
let f1 = Tuple.fold (+) 0 (Tuple 5)               // val f1 : int = 5
let f2 = Tuple.fold (+) 0 (5, 10)                 // val f2 : int = 15
let f3 = Tuple.fold (+) "" ("hello ", "world")    // val f3 : string = "hello world"

// transpose a tuple
let t3x2 = Tuple.transpose ((true, '2'), (3, 4.), (5u, "six"))
// val t3x2 : (bool * int * uint32) * (char * float * string) = ((true, 3, 5u), ('2', 4.0, "six"))

// map a 'function-as-type' to a tuple
type ToString = ToString with static member inline ($) (ToString, x) = string x
let t2 = Tuple.gmap ToString (1, true)            // val t2 : string * string = ("1", "True")

// reverse a tuple
let r2 = Tuple.rev (true, "2")      // val r2 : string * bool = ("2", true)
let r3 = Tuple.rev (true, "2", 3)   // val r3 : int * string * bool = (3, "2", true)

Is there any way to extend Cons to work with arity >8 / nested tuples?

Not really, actually there is a way to make it work but without "calculating" the resulting type. This means that the client code has to supply the type like this:

let x:(int *int *int *int) = cons (1,2) (3,4)

(this case has less that 8 just to make it more readable).

Thanks. That's what I thought. I was hoping there exists a member that was an inverse of 'Rest' that merged nested tuples while maintaining type.

Here you can get more details about why this is currently not possible dotnet/fsharp#9586 (comment)