1 people like it.

Tagless Final Encodings

Derived from http://okmij.org/ftp/tagless-final/JFP.pdf

HKT Encoding

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 

type HKT = interface end

type App<'F, 't when 'F :> HKT> = private App of payload : obj

type App<'F, 't1, 't2 when 'F :> HKT> = App<'F, TCons<'t1, 't2>>
and  App<'F, 't1, 't2, 't3 when 'F :> HKT> = App<'F, TCons<'t1, 't2, 't3>>
and  App<'F, 't1, 't2, 't3, 't4 when 'F :> HKT> = App<'F, TCons<'t1, 't2, 't3, 't4>>

and  TCons<'T1, 'T2> = class end
and  TCons<'T1, 'T2, 'T3> = TCons<TCons<'T1, 'T2>, 'T3>
and  TCons<'T1, 'T2, 'T3, 'T4> = TCons<TCons<'T1, 'T2, 'T3>, 'T4>

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module HKT =
    let inline pack (value : 'Fa) : App<'F, 'a>
        when 'F : (static member Assign : App<'F, 'a> * 'Fa -> unit) =
        App value
        
    let inline unpack (App value : App<'F, 'a>) : 'Fa
        when 'F : (static member Assign : App<'F, 'a> * 'Fa -> unit) =
        value :?> _
        
    let inline (|Unpack|) app = unpack app

Defining our Language

 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: 

type Symantics<'F, 'T when 'F :> HKT> = S of (Algebra<'F> -> App<'F, 'T>)

and Algebra<'F when 'F :> HKT> =
    abstract Lit : 'T -> App<'F, 'T>
    abstract Add  : App<'F, int> -> App<'F, int> -> App<'F, int>
    abstract Leq : App<'F, 'a> -> App<'F, 'a> -> App<'F, bool> when 'a : comparison
    abstract IfThenElse : App<'F, bool> -> (unit -> App<'F, 'a>) -> (unit -> App<'F, 'a>) -> App<'F, 'a>

    abstract Lam : (App<'F, 'a> -> App<'F,'b>) -> App<'F, 'a -> 'b>
    abstract App : App<'F, 'a -> 'b> -> App<'F, 'a> -> App<'F, 'b>
    abstract Fix : App<'F, ('a -> 'b) -> 'a -> 'b> -> App<'F, 'a -> 'b> 

// Defining constructors for the language
let lit t = S(fun alg -> alg.Lit t)
let add (S t) (S t') = S(fun alg -> alg.Add (t alg) (t' alg))
let leq (S t) (S t') = S(fun alg -> alg.Leq (t alg) (t' alg))
let ifThenElse (S c) (S a) (S b) = S (fun alg -> alg.IfThenElse (c alg) (fun () -> a alg) (fun () -> b alg))

let lam f = S(fun alg -> alg.Lam (fun x -> let (S g) = f (S (fun _ -> x)) in g alg))
let app (S a) (S b) = S(fun alg -> alg.App (a alg) (b alg))
let fix (S F) = S(fun alg -> alg.Fix (F alg))

// evaluator
let inline eval alg (S f) = f alg |> HKT.unpack

//  Defining example terms
let g () = app (lam (fun x -> add x (lit 1))) (lit 1)

let fib () =
    fix(
        lam(fun f ->
            lam(fun x ->
                ifThenElse
                    (leq x (lit 1))
                    x
                    (add
                        (app f (add x (lit -2)))
                        (app f (add x (lit -1))))
            )
        )
    )

Evaluator Intepretation

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 

type Id =
    interface HKT
    static member Assign(_ : App<Id, 'a>, _ : 'a) = ()

type Evaluator() =
    interface Algebra<Id> with
        member __.Lit t = HKT.pack t
        member __.Add (HKT.Unpack a) (HKT.Unpack b) = HKT.pack (a + b)
        member __.Leq (HKT.Unpack a) (HKT.Unpack b) = HKT.pack (a <= b)
        member __.IfThenElse (HKT.Unpack c) a b = if c then a() else b()

        member __.Lam f = HKT.pack (HKT.unpack << f << HKT.pack)
        member __.App (HKT.Unpack a) (HKT.Unpack b) = HKT.pack(a b)
        member __.Fix (HKT.Unpack F) = let rec aux x = F aux x in HKT.pack aux

eval (Evaluator()) (g ()) // 2
eval (Evaluator()) (fib ()) 10 // 55

Staged Intepretation

 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: 

open FSharp.Quotations

type Expr =
    interface HKT
    static member Assign(_ : App<Expr, 'a>, _ : Expr<'a>) = ()

type StagedEvaluator() =
    let i = ref 0
    let run (f : Expr<'T> -> Expr<'S>) : Expr<'T -> 'S> =
        incr i
        let v = new Var(sprintf "_%d_" !i, typeof<'T>)
        let ev = Expr.Var v |> Expr.Cast
        let body = f ev
        Expr.Lambda(v, body) |> Expr.Cast

    interface Algebra<Expr> with
        member __.Lit t = HKT.pack <@ t @>
        member __.Add (HKT.Unpack a) (HKT.Unpack b) = HKT.pack <@ %a + %b @>
        member __.Leq (HKT.Unpack a) (HKT.Unpack b) = HKT.pack <@ %a <= %b @>
        member __.IfThenElse (HKT.Unpack c) a b = HKT.pack <@ if %c then %(HKT.unpack (a())) else %(HKT.unpack (b())) @>

        member __.Lam f = run (HKT.pack >> f >> HKT.unpack) |> HKT.pack
        member __.App (HKT.Unpack a) (HKT.Unpack b) = HKT.pack <@ (%a) %b @>
        member __.Fix (HKT.Unpack F) = HKT.pack <@ let rec aux x = (%F) aux x in aux @>
        
eval (StagedEvaluator()) (g ()) |> Swensen.Unquote.Operators.decompile
eval (StagedEvaluator()) (fib ()) |> Swensen.Unquote.Operators.decompile

Partial Evaluator

 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: 

type Partial<'a> = Value of App<Id, 'a> | Expr of App<Expr, 'a>

and PartialExpr =
    interface HKT
    static member Assign(_ : App<PartialExpr, 'a>, _ : Partial<'a>) = ()

let embed (p:Partial<'a>) = match p with Expr (HKT.Unpack e) -> e | Value (HKT.Unpack v) -> <@ v @>

type PartialEvaluator() =
    let e = Evaluator() :> Algebra<_>
    let s = StagedEvaluator() :> Algebra<_>
    // expression embedding API
    let (|EExpr|) (p : Partial<'a>) : App<Expr,'a> = embed p |> HKT.pack

    interface Algebra<PartialExpr> with
        member __.Lit t = HKT.pack(Value (HKT.pack t))
        member __.Add (HKT.Unpack a) (HKT.Unpack b) =
            match a, b with
            | Value a, Value b -> Value(e.Add a b)
            | EExpr a, EExpr b -> Expr(s.Add a b)
            |> HKT.pack

        member __.Leq (HKT.Unpack a) (HKT.Unpack b) =
            match a, b with
            | Value a, Value b -> Value(e.Leq a b)
            | EExpr a, EExpr b -> Expr(s.Leq a b)
            |> HKT.pack
            
        member __.IfThenElse (HKT.Unpack c) a b = 
            match c with
            | Value (HKT.Unpack true) -> a ()
            | Value (HKT.Unpack false) -> b ()
            | EExpr c' ->
                let a' () = let (HKT.Unpack (EExpr a)) = a () in a
                let b' () = let (HKT.Unpack (EExpr b)) = b () in b
                Expr(s.IfThenElse c' a' b') |> HKT.pack

        // TODO expand
        member __.Lam f = s.Lam (fun a -> let (HKT.Unpack (EExpr b)) = f (HKT.pack (Expr a)) in b) |> Expr |> HKT.pack
        member __.App (HKT.Unpack (EExpr a)) (HKT.Unpack (EExpr b)) = s.App a b |> Expr |> HKT.pack
        member __.Fix (HKT.Unpack (EExpr F)) = s.Fix F |> Expr |> HKT.pack

eval (PartialEvaluator()) (lam (fun x -> (ifThenElse (leq (lit 1) (lit 2)) (add (lit 1) (lit 2)) x))) // fun x -> 3
Multiple items
union case App.App: payload: obj -> App<'F,'t>

--------------------
type App<'F,'t (requires 'F :> HKT)> = private | App of payload: obj

Full name: Script.App<_,_>
type HKT

Full name: Script.HKT
type obj = System.Object

Full name: Microsoft.FSharp.Core.obj
type TCons<'T1,'T2>

Full name: Script.TCons<_,_>
Multiple items
type CompilationRepresentationAttribute =
  inherit Attribute
  new : flags:CompilationRepresentationFlags -> CompilationRepresentationAttribute
  member Flags : CompilationRepresentationFlags

Full name: Microsoft.FSharp.Core.CompilationRepresentationAttribute

--------------------
new : flags:CompilationRepresentationFlags -> CompilationRepresentationAttribute
type CompilationRepresentationFlags =
  | None = 0
  | Static = 1
  | Instance = 2
  | ModuleSuffix = 4
  | UseNullAsTrueValue = 8
  | Event = 16

Full name: Microsoft.FSharp.Core.CompilationRepresentationFlags
CompilationRepresentationFlags.ModuleSuffix: CompilationRepresentationFlags = 4
val pack : value:'Fa -> App<'F,'a> (requires 'F :> HKT and member Assign)

Full name: Script.HKTModule.pack
val value : 'Fa
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
val unpack : App<'F,'a> -> 'Fa (requires 'F :> HKT and member Assign)

Full name: Script.HKTModule.unpack
val value : obj
val app : App<'a,'b> (requires 'a :> HKT and member Assign)
type Symantics<'F,'T (requires 'F :> HKT)> = | S of (Algebra<'F> -> App<'F,'T>)

Full name: Script.Symantics<_,_>
Multiple items
module HKT

from Script

--------------------
type HKT

Full name: Script.HKT
union case Symantics.S: (Algebra<'F> -> App<'F,'T>) -> Symantics<'F,'T>
type Algebra<'F (requires 'F :> HKT)> =
  interface
    abstract member Add : App<'F,int> -> App<'F,int> -> App<'F,int>
    abstract member App : App<'F,('a -> 'b)> -> App<'F,'a> -> App<'F,'b>
    abstract member Fix : App<'F,(('a -> 'b) -> 'a -> 'b)> -> App<'F,('a -> 'b)>
    abstract member IfThenElse : App<'F,bool> -> (unit -> App<'F,'a>) -> (unit -> App<'F,'a>) -> App<'F,'a>
    abstract member Lam : (App<'F,'a> -> App<'F,'b>) -> App<'F,('a -> 'b)>
    abstract member Leq : App<'F,'a> -> App<'F,'a> -> App<'F,bool> (requires comparison)
    abstract member Lit : 'T -> App<'F,'T>
  end

Full name: Script.Algebra<_>
abstract member Algebra.Lit : 'T -> App<'F,'T>

Full name: Script.Algebra`1.Lit
abstract member Algebra.Add : App<'F,int> -> App<'F,int> -> App<'F,int>

Full name: Script.Algebra`1.Add
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<_>
abstract member Algebra.Leq : App<'F,'a> -> App<'F,'a> -> App<'F,bool> (requires comparison)

Full name: Script.Algebra`1.Leq
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
abstract member Algebra.IfThenElse : App<'F,bool> -> (unit -> App<'F,'a>) -> (unit -> App<'F,'a>) -> App<'F,'a>

Full name: Script.Algebra`1.IfThenElse
abstract member Algebra.Lam : (App<'F,'a> -> App<'F,'b>) -> App<'F,('a -> 'b)>

Full name: Script.Algebra`1.Lam
Multiple items
abstract member Algebra.App : App<'F,('a -> 'b)> -> App<'F,'a> -> App<'F,'b>

Full name: Script.Algebra`1.App

--------------------
type App<'F,'t (requires 'F :> HKT)> = private | App of payload: obj

Full name: Script.App<_,_>
abstract member Algebra.Fix : App<'F,(('a -> 'b) -> 'a -> 'b)> -> App<'F,('a -> 'b)>

Full name: Script.Algebra`1.Fix
val lit : t:'a -> Symantics<#HKT,'a>

Full name: Script.lit
val t : 'a
val alg : Algebra<#HKT>
abstract member Algebra.Lit : 'T -> App<'F,'T>
val add : Symantics<'a,int> -> Symantics<'a,int> -> Symantics<'a,int> (requires 'a :> HKT)

Full name: Script.add
val t : (Algebra<'a> -> App<'a,int>) (requires 'a :> HKT)
val t' : (Algebra<'a> -> App<'a,int>) (requires 'a :> HKT)
abstract member Algebra.Add : App<'F,int> -> App<'F,int> -> App<'F,int>
val leq : Symantics<'a,'b> -> Symantics<'a,'b> -> Symantics<'a,bool> (requires 'a :> HKT and comparison)

Full name: Script.leq
val t : (Algebra<'a> -> App<'a,'b>) (requires 'a :> HKT and comparison)
val t' : (Algebra<'a> -> App<'a,'b>) (requires 'a :> HKT and comparison)
abstract member Algebra.Leq : App<'F,'a> -> App<'F,'a> -> App<'F,bool> (requires comparison)
val ifThenElse : Symantics<'a,bool> -> Symantics<'a,'b> -> Symantics<'a,'b> -> Symantics<'a,'b> (requires 'a :> HKT)

Full name: Script.ifThenElse
val c : (Algebra<'a> -> App<'a,bool>) (requires 'a :> HKT)
val a : (Algebra<'a> -> App<'a,'b>) (requires 'a :> HKT)
val b : (Algebra<'a> -> App<'a,'b>) (requires 'a :> HKT)
abstract member Algebra.IfThenElse : App<'F,bool> -> (unit -> App<'F,'a>) -> (unit -> App<'F,'a>) -> App<'F,'a>
val lam : f:(Symantics<'a,'b> -> Symantics<'a,'c>) -> Symantics<'a,('b -> 'c)> (requires 'a :> HKT)

Full name: Script.lam
val f : (Symantics<'a,'b> -> Symantics<'a,'c>) (requires 'a :> HKT)
abstract member Algebra.Lam : (App<'F,'a> -> App<'F,'b>) -> App<'F,('a -> 'b)>
val x : App<#HKT,'b>
val g : (Algebra<'a> -> App<'a,'c>) (requires 'a :> HKT)
val app : Symantics<'a,('b -> 'c)> -> Symantics<'a,'b> -> Symantics<'a,'c> (requires 'a :> HKT)

Full name: Script.app
val a : (Algebra<'a> -> App<'a,('b -> 'c)>) (requires 'a :> HKT)
abstract member Algebra.App : App<'F,('a -> 'b)> -> App<'F,'a> -> App<'F,'b>
val fix : Symantics<'a,(('b -> 'c) -> 'b -> 'c)> -> Symantics<'a,('b -> 'c)> (requires 'a :> HKT)

Full name: Script.fix
val F : (Algebra<'a> -> App<'a,(('b -> 'c) -> 'b -> 'c)>) (requires 'a :> HKT)
abstract member Algebra.Fix : App<'F,(('a -> 'b) -> 'a -> 'b)> -> App<'F,('a -> 'b)>
val eval : alg:Algebra<'a> -> Symantics<'a,'b> -> 'c (requires 'a :> HKT and member Assign)

Full name: Script.eval
val alg : Algebra<'a> (requires 'a :> HKT and member Assign)
val f : (Algebra<'a> -> App<'a,'b>) (requires 'a :> HKT and member Assign)
val g : unit -> Symantics<#HKT,int>

Full name: Script.g
val x : Symantics<#HKT,int>
val fib : unit -> Symantics<#HKT,(int -> int)>

Full name: Script.fib
val f : Symantics<#HKT,(int -> int)>
type Id =
  interface HKT
  static member Assign : App<Id,'a> * 'a -> unit

Full name: Script.Id
static member Id.Assign : App<Id,'a> * 'a -> unit

Full name: Script.Id.Assign
Multiple items
type Evaluator =
  interface Algebra<Id>
  new : unit -> Evaluator

Full name: Script.Evaluator

--------------------
new : unit -> Evaluator
override Evaluator.Lit : t:'i -> App<Id,'i>

Full name: Script.Evaluator.Lit
val t : 'i
val __ : Evaluator
override Evaluator.Add : App<Id,int> -> App<Id,int> -> App<Id,int>

Full name: Script.Evaluator.Add
active recognizer Unpack: App<'a,'b> -> 'c

Full name: Script.HKTModule.( |Unpack| )
val a : int
val b : int
override Evaluator.Leq : App<Id,'h> -> App<Id,'h> -> App<Id,bool> (requires comparison)

Full name: Script.Evaluator.Leq
val a : 'h (requires comparison)
val b : 'h (requires comparison)
override Evaluator.IfThenElse : App<Id,bool> -> a:(unit -> App<Id,'g>) -> b:(unit -> App<Id,'g>) -> App<Id,'g>

Full name: Script.Evaluator.IfThenElse
val c : bool
val a : (unit -> App<Id,'g>)
val b : (unit -> App<Id,'g>)
override Evaluator.Lam : f:(App<Id,'e> -> App<Id,'f>) -> App<Id,('e -> 'f)>

Full name: Script.Evaluator.Lam
val f : (App<Id,'e> -> App<Id,'f>)
Multiple items
override Evaluator.App : App<Id,('c -> 'd)> -> App<Id,'c> -> App<Id,'d>

Full name: Script.Evaluator.App

--------------------
type App<'F,'t (requires 'F :> HKT)> = private | App of payload: obj

Full name: Script.App<_,_>
val a : ('c -> 'd)
val b : 'c
override Evaluator.Fix : App<Id,(('a -> 'b) -> 'a -> 'b)> -> App<Id,('a -> 'b)>

Full name: Script.Evaluator.Fix
val F : (('a -> 'b) -> 'a -> 'b)
val aux : ('a -> 'b)
val x : 'a
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Quotations
Multiple items
type Expr =
  interface HKT
  static member Assign : App<Expr,'a> * Expr<'a> -> unit

Full name: Script.Expr

--------------------
type Expr<'T> =
  inherit Expr
  member Raw : Expr

Full name: Microsoft.FSharp.Quotations.Expr<_>
static member Expr.Assign : App<Expr,'a> * Expr<'a> -> unit

Full name: Script.Expr.Assign
Multiple items
type StagedEvaluator =
  interface Algebra<Expr>
  new : unit -> StagedEvaluator

Full name: Script.StagedEvaluator

--------------------
new : unit -> StagedEvaluator
val i : int ref
Multiple items
val ref : value:'T -> 'T ref

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

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val run : ((Expr<'T> -> Expr<'S>) -> Expr<('T -> 'S)>)
val f : (Expr<'T> -> Expr<'S>)
val incr : cell:int ref -> unit

Full name: Microsoft.FSharp.Core.Operators.incr
val v : Var
Multiple items
type Var =
  interface IComparable
  new : name:string * typ:Type * ?isMutable:bool -> Var
  member IsMutable : bool
  member Name : string
  member Type : Type
  static member Global : name:string * typ:Type -> Var

Full name: Microsoft.FSharp.Quotations.Var

--------------------
new : name:string * typ:System.Type * ?isMutable:bool -> Var
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
val typeof<'T> : System.Type

Full name: Microsoft.FSharp.Core.Operators.typeof
val ev : Expr<'T>
static member Expr.Var : variable:Var -> Expr
static member Expr.Cast : source:Expr -> Expr<'T>
val body : Expr<'S>
static member Expr.Lambda : parameter:Var * body:Expr -> Expr
override StagedEvaluator.Lit : t:'i -> App<Expr,'i>

Full name: Script.StagedEvaluator.Lit
val __ : StagedEvaluator
override StagedEvaluator.Add : App<Expr,int> -> App<Expr,int> -> App<Expr,int>

Full name: Script.StagedEvaluator.Add
val a : Expr<int>
val b : Expr<int>
override StagedEvaluator.Leq : App<Expr,'h> -> App<Expr,'h> -> App<Expr,bool> (requires comparison)

Full name: Script.StagedEvaluator.Leq
val a : Expr<'h> (requires comparison)
val b : Expr<'h> (requires comparison)
override StagedEvaluator.IfThenElse : App<Expr,bool> -> a:(unit -> App<Expr,'g>) -> b:(unit -> App<Expr,'g>) -> App<Expr,'g>

Full name: Script.StagedEvaluator.IfThenElse
val c : Expr<bool>
val a : (unit -> App<Expr,'g>)
val b : (unit -> App<Expr,'g>)
override StagedEvaluator.Lam : f:(App<Expr,'e> -> App<Expr,'f>) -> App<Expr,('e -> 'f)>

Full name: Script.StagedEvaluator.Lam
val f : (App<Expr,'e> -> App<Expr,'f>)
Multiple items
override StagedEvaluator.App : App<Expr,('c -> 'd)> -> App<Expr,'c> -> App<Expr,'d>

Full name: Script.StagedEvaluator.App

--------------------
type App<'F,'t (requires 'F :> HKT)> = private | App of payload: obj

Full name: Script.App<_,_>
val a : Expr<('c -> 'd)>
val b : Expr<'c>
override StagedEvaluator.Fix : App<Expr,(('a -> 'b) -> 'a -> 'b)> -> App<Expr,('a -> 'b)>

Full name: Script.StagedEvaluator.Fix
val F : Expr<(('a -> 'b) -> 'a -> 'b)>
namespace Swensen
namespace Swensen.Unquote
module Operators

from Swensen.Unquote
val decompile : expr:Expr -> string

Full name: Swensen.Unquote.Operators.decompile
type Partial<'a> =
  | Value of App<Id,'a>
  | Expr of App<Expr,'a>

Full name: Script.Partial<_>
union case Partial.Value: App<Id,'a> -> Partial<'a>
Multiple items
union case Partial.Expr: App<Expr,'a> -> Partial<'a>

--------------------
type Expr =
  interface HKT
  static member Assign : App<Expr,'a> * Expr<'a> -> unit

Full name: Script.Expr

--------------------
type Expr<'T> =
  inherit Expr
  member Raw : Expr

Full name: Microsoft.FSharp.Quotations.Expr<_>
type PartialExpr =
  interface HKT
  static member Assign : App<PartialExpr,'a> * Partial<'a> -> unit

Full name: Script.PartialExpr
static member PartialExpr.Assign : App<PartialExpr,'a> * Partial<'a> -> unit

Full name: Script.PartialExpr.Assign
val embed : p:Partial<'a> -> Expr<'a>

Full name: Script.embed
val p : Partial<'a>
val e : Expr<'a>
val v : 'a
Multiple items
type PartialEvaluator =
  interface Algebra<PartialExpr>
  new : unit -> PartialEvaluator

Full name: Script.PartialEvaluator

--------------------
new : unit -> PartialEvaluator
val e : Algebra<Id>
val s : Algebra<Expr>
override PartialEvaluator.Lit : t:'i -> App<PartialExpr,'i>

Full name: Script.PartialEvaluator.Lit
val __ : PartialEvaluator
override PartialEvaluator.Add : App<PartialExpr,int> -> App<PartialExpr,int> -> App<PartialExpr,int>

Full name: Script.PartialEvaluator.Add
val a : Partial<int>
val b : Partial<int>
val a : App<Id,int>
val b : App<Id,int>
active recognizer EExpr: Partial<'a> -> App<Expr,'a>
val a : App<Expr,int>
val b : App<Expr,int>
override PartialEvaluator.Leq : App<PartialExpr,'h> -> App<PartialExpr,'h> -> App<PartialExpr,bool> (requires comparison)

Full name: Script.PartialEvaluator.Leq
val a : Partial<'h> (requires comparison)
val b : Partial<'h> (requires comparison)
val a : App<Id,'h> (requires comparison)
val b : App<Id,'h> (requires comparison)
val a : App<Expr,'h> (requires comparison)
val b : App<Expr,'h> (requires comparison)
override PartialEvaluator.IfThenElse : App<PartialExpr,bool> -> a:(unit -> App<PartialExpr,'g>) -> b:(unit -> App<PartialExpr,'g>) -> App<PartialExpr,'g>

Full name: Script.PartialEvaluator.IfThenElse
val c : Partial<bool>
val a : (unit -> App<PartialExpr,'g>)
val b : (unit -> App<PartialExpr,'g>)
val c' : App<Expr,bool>
val a' : (unit -> App<Expr,'g>)
val a : App<Expr,'g>
val b' : (unit -> App<Expr,'g>)
val b : App<Expr,'g>
override PartialEvaluator.Lam : f:(App<PartialExpr,'e> -> App<PartialExpr,'f>) -> App<PartialExpr,('e -> 'f)>

Full name: Script.PartialEvaluator.Lam
val f : (App<PartialExpr,'e> -> App<PartialExpr,'f>)
val a : App<Expr,'e>
val b : App<Expr,'f>
Multiple items
override PartialEvaluator.App : App<PartialExpr,('c -> 'd)> -> App<PartialExpr,'c> -> App<PartialExpr,'d>

Full name: Script.PartialEvaluator.App

--------------------
type App<'F,'t (requires 'F :> HKT)> = private | App of payload: obj

Full name: Script.App<_,_>
val a : App<Expr,('c -> 'd)>
val b : App<Expr,'c>
override PartialEvaluator.Fix : App<PartialExpr,(('a -> 'b) -> 'a -> 'b)> -> App<PartialExpr,('a -> 'b)>

Full name: Script.PartialEvaluator.Fix
val F : App<Expr,(('a -> 'b) -> 'a -> 'b)>
val x : Symantics<PartialExpr,int>
Raw view Test code New version

More information

Link:http://fssnip.net/7Wq
Posted:5 years ago
Author:Eirik Tsarpalis
Tags: tagless-final

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.