2 people like it.

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 New version

More information

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