1 people like it.

A GADT in F#

Just an example of a GADT in F#.

 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: 
[<AutoOpen>]
module GadtModule =

    type 'a Gadt =
        private
        | Error of string
        | Int of int
        | Float of float
        | Box of obj

    let Error e : string Gadt = Error e
    let Int i : int Gadt = Int i
    let Float f : float Gadt = Float f
    let Box (gadt : 'a Gadt) : obj Gadt =
        match gadt with
        | Error _ as e -> Box (box e)
        | Float _ as f -> Box (box f)
        | Int _ as i -> Box (box i)
        | Box _ as x -> Box (box x)

    let (|Error|Float|Int|Box|) gadt =
        match gadt with
        | Error e -> Choice1Of4 e
        | Float f -> Choice2Of4 f
        | Int i -> Choice3Of4 i
        | Box x -> Choice4Of4 x

[<RequireQualifiedAccess>]
module Gadt =

    let addInt (left : int Gadt) (right : int Gadt) =
        match (left, right) with (Int i, Int j) -> Int (i + j) | _ -> failwith "Unexpected match failure."

    let addFloat (left : float Gadt) (right : float Gadt) =
        match (left, right) with (Float i, Float j) -> Float (i + j) | _ -> failwith "Unexpected match failure."

    let add (left : 'a Gadt) (right : 'b Gadt) : obj Gadt =
        match (box left, box right) with
        | (:? Gadt<string>, _) -> Box left
        | (_, :? Gadt<string>) -> Box right
        | ((:? Gadt<int> as i), (:? Gadt<int> as j)) -> Box (addInt i j)
        | ((:? Gadt<float> as i), (:? Gadt<float> as j)) -> Box (addFloat i j)
        | _ -> Box (Error "Incompatible types under addition.")

[<EntryPoint>]
let main _ =
    let a = Float 1.0
    let b = Float 2.0
    let c = Gadt.addFloat a b
    let d = Gadt.add a b
    printfn "%A" c
    printfn "%A" d
    0
Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute
type 'a Gadt =
  private | Error of string
          | Int of int
          | Float of float
          | Box of obj

Full name: Script.GadtModule.Gadt<_>
union case Gadt.Error: string -> 'a Gadt
Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string
union case Gadt.Int: int -> 'a Gadt
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<_>
union case Gadt.Float: float -> 'a Gadt
Multiple items
val float : value:'T -> float (requires member op_Explicit)

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

--------------------
type float = System.Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
union case Gadt.Box: obj -> 'a Gadt
type obj = System.Object

Full name: Microsoft.FSharp.Core.obj
val Error : e:string -> string Gadt

Full name: Script.GadtModule.Error
val e : string
val Int : i:int -> int Gadt

Full name: Script.GadtModule.Int
val i : int
val Float : f:float -> float Gadt

Full name: Script.GadtModule.Float
val f : float
val Box : gadt:'a Gadt -> obj Gadt

Full name: Script.GadtModule.Box
val gadt : 'a Gadt
val e : 'a Gadt
val box : value:'T -> obj

Full name: Microsoft.FSharp.Core.Operators.box
val f : 'a Gadt
val i : 'a Gadt
val x : 'a Gadt
union case Choice.Choice1Of4: 'T1 -> Choice<'T1,'T2,'T3,'T4>
union case Choice.Choice2Of4: 'T2 -> Choice<'T1,'T2,'T3,'T4>
union case Choice.Choice3Of4: 'T3 -> Choice<'T1,'T2,'T3,'T4>
val x : obj
union case Choice.Choice4Of4: 'T4 -> Choice<'T1,'T2,'T3,'T4>
Multiple items
type RequireQualifiedAccessAttribute =
  inherit Attribute
  new : unit -> RequireQualifiedAccessAttribute

Full name: Microsoft.FSharp.Core.RequireQualifiedAccessAttribute

--------------------
new : unit -> RequireQualifiedAccessAttribute
val addInt : left:int Gadt -> right:int Gadt -> int Gadt

Full name: Script.Gadt.addInt
val left : int Gadt
val right : int Gadt
Multiple items
val Int : i:int -> int Gadt

Full name: Script.GadtModule.Int

--------------------
active recognizer Int: 'a Gadt -> Choice<string,float,int,obj>

Full name: Script.GadtModule.( |Error|Float|Int|Box| )
val j : int
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val addFloat : left:float Gadt -> right:float Gadt -> float Gadt

Full name: Script.Gadt.addFloat
val left : float Gadt
val right : float Gadt
Multiple items
val Float : f:float -> float Gadt

Full name: Script.GadtModule.Float

--------------------
active recognizer Float: 'a Gadt -> Choice<string,float,int,obj>

Full name: Script.GadtModule.( |Error|Float|Int|Box| )
val i : float
val j : float
val add : left:'a Gadt -> right:'b Gadt -> obj Gadt

Full name: Script.Gadt.add
val left : 'a Gadt
val right : 'b Gadt
Multiple items
val Box : gadt:'a Gadt -> obj Gadt

Full name: Script.GadtModule.Box

--------------------
active recognizer Box: 'a Gadt -> Choice<string,float,int,obj>

Full name: Script.GadtModule.( |Error|Float|Int|Box| )
val i : int Gadt
val j : int Gadt
val i : float Gadt
val j : float Gadt
Multiple items
val Error : e:string -> string Gadt

Full name: Script.GadtModule.Error

--------------------
active recognizer Error: 'a Gadt -> Choice<string,float,int,obj>

Full name: Script.GadtModule.( |Error|Float|Int|Box| )
Multiple items
type EntryPointAttribute =
  inherit Attribute
  new : unit -> EntryPointAttribute

Full name: Microsoft.FSharp.Core.EntryPointAttribute

--------------------
new : unit -> EntryPointAttribute
val main : string [] -> int

Full name: Script.main
val a : float Gadt
val b : float Gadt
val c : float Gadt
Multiple items
module Gadt

from Script

--------------------
type 'a Gadt =
  private | Error of string
          | Int of int
          | Float of float
          | Box of obj

Full name: Script.GadtModule.Gadt<_>
val d : obj Gadt
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
Raw view New version

More information

Link:http://fssnip.net/7Xp
Posted:5 months ago
Author:Bryan Edds
Tags: gadt