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

More information

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