1 people like it.

HList with Mapper and Folder

Extended from: http://www.fssnip.net/d2

 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: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84: 
85: 
86: 
87: 
88: 
89: 
90: 
91: 
type HList = interface end
and HNil = HNil with
    static member inline (|*|) (f, HNil) = f $ HNil
    interface HList
and HCons<'a, 'b when 'b :> HList> = HCons of 'a * 'b with
    static member inline (|*|) (f, HCons(x, xs)) = f $ HCons(x, xs) 
    interface HList 


type Peano = interface end
and Zero = Zero with
    static member inline (|*|) (f, Zero) = f $ Zero
    interface Peano
and Succ<'a when 'a :> Peano> = Succ of 'a  with
    static member inline (|*|) (f, Succ(x)) = f $ Succ(x) 
    interface Peano 

type Bool = interface end
and True = True with
    interface Bool
and False = False with
    interface Bool

let inline (^+^) head tail = HCons(head, tail)

// Examples
let first = 1 ^+^ '1' ^+^ HNil
let second =  "1" ^+^ true ^+^ HNil
let third = "one" ^+^ 123 ^+^ HNil

let inline head (HCons(h,t)) = h
let inline tail (HCons(h,t)) = t

tail third // HCons (123,HNil)
(tail >> tail) third // HNil
(tail >> tail >> tail) third // compiler error

type Append = Append with
    static member ($) (Append, HNil) = id
    static member inline ($) (Append, HCons(x, xs)) = fun list ->
        HCons (x, (Append |*| xs) list)

let result = (Append $ first) second // HCons (1,HCons ('1',HCons ("1",HCons (true,HNil))))

type Length = Length with
    static member ($) (Length, HNil) = Zero
    static member inline ($) (Length, HCons(x, xs)) = Succ (Length |*| xs) 

let length = Length $ result // Succ (Succ (Succ (Succ Zero)))

type Count = Count with
    static member ($) (Count, HNil) = 0
    static member inline ($) (Count, HCons(x, xs)) = 1 + (Count |*| xs) 

let count = Count $ result // 4

// Mapper Construct for HList
type Mapper<'a> = Mapper of 'a with
    static member ($) (Mapper(M), HNil) = HNil
    static member inline ($) (Mapper(M), HCons(x, xs)) = HCons(M $ x, (Mapper(M) |*| (xs)))

// Map Example
type ZeroMap = ZeroMap with
    static member inline ($) (ZeroMap, s: string) = ""
    static member inline ($) (ZeroMap, i: int) = 0

Mapper(ZeroMap) $ third //HCons<string,HCons<int,HNil>> = HCons ("",HCons (0,HNil))
Mapper(ZeroMap) $ second // Compiler error because bool isn't defined on ZeroMap

let ZeroMapper = Mapper(ZeroMap) 
ZeroMapper $ third //HCons<string,HCons<int,HNil>> = HCons ("",HCons (0,HNil))

// Folder Construct for HList
type Folder<'a, 'v> = Folder of 'a * 'v with
    static member ($) (Folder(F, v), HNil) = v
    static member inline ($) (Folder(F, v), HCons(x, xs)) = Folder(F, F $ (v,x)) |*| xs

// Example of converting to strings and folding them up
type StrFolder = StrFolder with
    static member inline ($) (StrFolder, (s1: string, s2: string)) = s1 + s2 
    static member inline ($) (StrFolder, (s1: string, i2: int)) = s1 + (string i2)

Folder(StrFolder, "") $ third // "one123"
Folder(StrFolder, "") $ second // Compiler error because string * bool is not defined on StrFolder

// Example of reversing and HList with a Folder
type RevFolder = RevFolder with
    static member inline ($) (RevFolder, (HNil, v)) = HCons(v, HNil)
    static member inline ($) (RevFolder, (HCons(x, xs), v)) = HCons(v, HCons(x, xs))

Folder(RevFolder, HNil) $ third // HCons (123,HCons ("one",HNil))
Multiple items
union case HNil.HNil: HNil

--------------------
type HNil =
  | HNil
  interface HList
  static member ( |*| ) : f:'a * HNil:HNil -> '_arg5 (requires member ( $ ))

Full name: Script.HNil
val f : 'a (requires member ( $ ))
type HList

Full name: Script.HList
Multiple items
union case HCons.HCons: 'a * 'b -> HCons<'a,'b>

--------------------
type HCons<'a,'b (requires 'b :> HList)> =
  | HCons of 'a * 'b
  interface HList
  static member ( |*| ) : f:'a0 * HCons<'b1,'c> -> '_arg8 (requires member ( $ ) and 'c :> HList)

Full name: Script.HCons<_,_>
val f : 'a (requires member ( $ ) and 'c :> HList)
val x : 'b
val xs : #HList
type Peano

Full name: Script.Peano
Multiple items
union case Zero.Zero: Zero

--------------------
type Zero =
  | Zero
  interface Peano
  static member ( |*| ) : f:'a * Zero:Zero -> '_arg5 (requires member ( $ ))

Full name: Script.Zero
Multiple items
union case Succ.Succ: 'a -> Succ<'a>

--------------------
type Succ<'a (requires 'a :> Peano)> =
  | Succ of 'a
  interface Peano
  static member ( |*| ) : f:'a0 * Succ<'b> -> '_arg8 (requires member ( $ ) and 'b :> Peano)

Full name: Script.Succ<_>
val f : 'a (requires member ( $ ) and 'b :> Peano)
val x : #Peano
type Bool

Full name: Script.Bool
Multiple items
union case True.True: True

--------------------
type True =
  | True
  interface Bool

Full name: Script.True
type False =
  | False
  interface Bool

Full name: Script.False
Multiple items
union case False.False: False

--------------------
type False =
  | False
  interface Bool

Full name: Script.False
val head : 'a
val tail : #HList
val first : HCons<int,HCons<char,HNil>>

Full name: Script.first
val second : HCons<string,HCons<bool,HNil>>

Full name: Script.second
val third : HCons<string,HCons<int,HNil>>

Full name: Script.third
val head : HCons<'a,#HList> -> 'a

Full name: Script.head
val h : 'a
val t : #HList
val tail : HCons<'a,'b> -> 'b (requires 'b :> HList)

Full name: Script.tail
Multiple items
union case Append.Append: Append

--------------------
type Append =
  | Append
  static member ( $ ) : Append:Append * HNil:HNil -> ('a -> 'a)
  static member ( $ ) : Append:Append * HCons<'a,'b> -> ('c -> HCons<'a,'d>) (requires 'b :> HList and member ( |*| ) and 'd :> HList)

Full name: Script.Append
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val x : 'a
val xs : 'b (requires 'b :> HList and member ( |*| ) and 'd :> HList)
Multiple items
val list : 'c

--------------------
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val result : HCons<int,HCons<char,HCons<string,HCons<bool,HNil>>>>

Full name: Script.result
Multiple items
union case Length.Length: Length

--------------------
type Length =
  | Length
  static member ( $ ) : Length:Length * HNil:HNil -> Zero
  static member ( $ ) : Length:Length * HCons<'a,'b> -> Succ<'_arg7> (requires 'b :> HList and member ( |*| ) and '_arg7 :> Peano)

Full name: Script.Length
val xs : 'b (requires 'b :> HList and member ( |*| ) and '_arg7 :> Peano)
val length : Succ<Succ<Succ<Succ<Zero>>>>

Full name: Script.length
Multiple items
union case Count.Count: Count

--------------------
type Count =
  | Count
  static member ( $ ) : Count:Count * HNil:HNil -> int
  static member ( $ ) : Count:Count * HCons<'a,'b> -> int (requires 'b :> HList and member ( |*| ))

Full name: Script.Count
val xs : 'b (requires 'b :> HList and member ( |*| ))
val count : int

Full name: Script.count
Multiple items
union case Mapper.Mapper: 'a -> Mapper<'a>

--------------------
type Mapper<'a> =
  | Mapper of 'a
  static member ( $ ) : Mapper<'a0> * HNil:HNil -> HNil
  static member ( $ ) : Mapper<'a0> * HCons<'b,'c> -> HCons<'_arg7,'_arg10> (requires member ( $ ) and 'c :> HList and member ( |*| ) and '_arg10 :> HList)

Full name: Script.Mapper<_>
val M : 'a
val M : 'a (requires member ( $ ))
val x : 'b (requires member ( $ ))
val xs : 'c (requires 'c :> HList and member ( |*| ) and member ( $ ) and '_arg10 :> HList)
Multiple items
union case ZeroMap.ZeroMap: ZeroMap

--------------------
type ZeroMap =
  | ZeroMap
  static member ( $ ) : ZeroMap:ZeroMap * s:string -> string
  static member ( $ ) : ZeroMap:ZeroMap * i:int -> int

Full name: Script.ZeroMap
val s : string
Multiple items
val string : value:'T -> string

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

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
val i : int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

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

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val ZeroMapper : Mapper<ZeroMap>

Full name: Script.ZeroMapper
Multiple items
union case Folder.Folder: 'a * 'v -> Folder<'a,'v>

--------------------
type Folder<'a,'v> =
  | Folder of 'a * 'v
  static member ( $ ) : Folder<'a0,'b> * HNil:HNil -> 'b
  static member ( $ ) : Folder<'a0,'b> * HCons<'c,'d> -> '_arg7 (requires member ( $ ) and 'd :> HList and member ( |*| ))

Full name: Script.Folder<_,_>
val F : 'a
val v : 'b
val F : 'a (requires member ( $ ))
val x : 'c
val xs : 'd (requires 'd :> HList and member ( |*| ) and member ( $ ))
Multiple items
union case StrFolder.StrFolder: StrFolder

--------------------
type StrFolder =
  | StrFolder
  static member ( $ ) : StrFolder:StrFolder * (string * string) -> string
  static member ( $ ) : StrFolder:StrFolder * (string * int) -> string

Full name: Script.StrFolder
val s1 : string
val s2 : string
val i2 : int
Multiple items
union case RevFolder.RevFolder: RevFolder

--------------------
type RevFolder =
  | RevFolder
  static member ( $ ) : RevFolder:RevFolder * (HNil * 'a) -> HCons<'a,HNil>
  static member ( $ ) : RevFolder:RevFolder * (HCons<'a,'b> * 'c) -> HCons<'c,HCons<'a,'b>> (requires 'b :> HList)

Full name: Script.RevFolder
val v : 'a
val v : 'c

More information

Link:http://fssnip.net/pu
Posted:9 years ago
Author:Rick Minerich
Tags: hlist , types