2 people like it.
Like the snippet!

Toy GMap using Infers

This is a toy implementation of GMap using the Infers library and could be improved in several significant ways. For example, Infers is more than powerful enough that GMap could be optimized to generate functions that do not traverse parts of the datatype that do not contain values to map.

 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:

open Infers

type GM<'w, 'p> = ('p -> 'p) -> 'w -> 'w
type GMap<'w, 'p> = {gm: GM<'w, 'p>}

type [<InferenceRules>] GMap () =
  member g.same ()                  : GMap<'p, 'p> = {gm = id}
  member g.notSame (gm: GM<'w, 'p>) : GMap<'w, 'p> = {gm = gm}

  member g.int    () : GM<int,    'p> = fun _ -> id
  member g.string () : GM<string, 'p> = fun _ -> id
  member g.bool   () : GM<bool,   'p> = fun _ -> id

  member g.option (wG: GMap<'w, 'p>) : GM<option<'w>, 'p> = wG.gm >> Option.map
  member g.pair (vG: GMap<'v, 'p>, wG: GMap<'w, 'p>) : GM<'v * 'w, 'p> =
    fun p2p (v, w) -> (vG.gm p2p v, wG.gm p2p w)
  member g.list (wG: GMap<'w, 'p>) : GM<list<'w>, 'p> =
    wG.gm >> List.map

  // A bit of boilerplate (could be mostly eliminated)
  static member make () : GM<'w, 'p> =
    match Engine.TryGenerate (GMap ()) with
     | None -> failwithf "GMap: Unsupported type %A" typeof<'w>
     | Some gmap -> gmap.gm
  static member Get () = StaticMap<GMap>.Memoize GMap.make

// User interface
let gmap (p2p: 'p -> 'p) : 'w -> 'w = GMap.Get () p2p

// Examples
do gmap ((+) 1) [("vesa", 1)] |> printfn "%A"
do gmap (fun (x: string) -> x.ToUpper ()) [("vesa", 1)] |> printfn "%A"

namespace Infers

type GM<'w,'p> = ('p -> 'p) -> 'w -> 'w

Full name: Script.GM<_,_>

type GMap<'w,'p> =
{gm: GM<'w,'p>;}

Full name: Script.GMap<_,_>

GMap.gm: GM<'w,'p>

Multiple items
type GMap =
  new : unit -> GMap
  member bool : unit -> GM<bool,'p>
  member int : unit -> GM<int,'p>
  member list : wG:GMap<'w,'p> -> GM<'w list,'p>
  member notSame : gm:GM<'w,'p> -> GMap<'w,'p>
  member option : wG:GMap<'w,'p> -> GM<'w option,'p>
  member pair : vG:GMap<'v,'p> * wG:GMap<'w,'p> -> GM<('v * 'w),'p>
  member same : unit -> GMap<'p,'p>
  member string : unit -> GM<string,'p>
  static member Get : unit -> 'a
  ...

Full name: Script.GMap

--------------------
type GMap<'w,'p> =
  {gm: GM<'w,'p>;}

Full name: Script.GMap<_,_>

--------------------
new : unit -> GMap

val g : GMap

member GMap.same : unit -> GMap<'p,'p>

Full name: Script.GMap.same

val id : x:'T -> 'T

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

member GMap.notSame : gm:GM<'w,'p> -> GMap<'w,'p>

Full name: Script.GMap.notSame

val gm : GM<'w,'p>

Multiple items
member GMap.int : unit -> GM<int,'p>

Full name: Script.GMap.int

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

Full name: Microsoft.FSharp.Core.int

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

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

Multiple items
member GMap.string : unit -> GM<string,'p>

Full name: Script.GMap.string

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

Full name: Microsoft.FSharp.Core.string

Multiple items
member GMap.bool : unit -> GM<bool,'p>

Full name: Script.GMap.bool

--------------------
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool

Multiple items
member GMap.option : wG:GMap<'w,'p> -> GM<'w option,'p>

Full name: Script.GMap.option

--------------------
type 'T option = Option<'T>

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

val wG : GMap<'w,'p>

type 'T option = Option<'T>

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

module Option

from Microsoft.FSharp.Core

val map : mapping:('T -> 'U) -> option:'T option -> 'U option

Full name: Microsoft.FSharp.Core.Option.map

member GMap.pair : vG:GMap<'v,'p> * wG:GMap<'w,'p> -> GM<('v * 'w),'p>

Full name: Script.GMap.pair

val vG : GMap<'v,'p>

val p2p : ('p -> 'p)

val v : 'v

val w : 'w

GMap.gm: GM<'v,'p>

Multiple items
member GMap.list : wG:GMap<'w,'p> -> GM<'w list,'p>

Full name: Script.GMap.list

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

Full name: Microsoft.FSharp.Collections.list<_>

type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>

Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>

val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map

static member GMap.make : unit -> GM<'w,'p>

Full name: Script.GMap.make

union case Option.None: Option<'T>

val failwithf : format:Printf.StringFormat<'T,'Result> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.failwithf

val typeof<'T> : System.Type

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

union case Option.Some: Value: 'T -> Option<'T>

val gmap : GMap<'w,'p>

static member GMap.Get : unit -> 'a

Full name: Script.GMap.Get

static member GMap.make : unit -> GM<'w,'p>

val gmap : p2p:('p -> 'p) -> ('w -> 'w)

Full name: Script.gmap

static member GMap.Get : unit -> 'a

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

val x : 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

System.String.ToUpper() : string
System.String.ToUpper(culture: System.Globalization.CultureInfo) : string

Raw view Test code New version

More information

Link:	http://fssnip.net/se
Posted:	9 years ago
Author:	Vesa Karvonen
Tags:	generic programming