2 people like it.
Like the snippet!

Extensibility for the Masses

F# adaptation of a solution to the expression problem using object algebras, c.f. https://www.cs.utexas.edu/~wcook/Drafts/2012/ecoop2012.pdf

Base Definition and Implementations

 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:

// Int expression object algebra
type IntAlg<'I> =
    abstract Lit : int -> 'I
    abstract Add : 'I -> 'I -> 'I

// Church encoding of terms in the algebra
type IntExpr<'I> = IntAlg<'I> -> 'I
let lit i : IntExpr<'I> = fun alg -> alg.Lit i
let add l r : IntExpr<'I> = fun alg -> alg.Add (l alg) (r alg)

// Evaluator for the algebra
type IntEval() =
    interface IntAlg<int> with
        member __.Lit i = i
        member __.Add l r = l + r

let eval (f : IntExpr<_>) = f (IntEval())

eval (add (add (lit 3) (lit 5)) (lit -8))

// Pretty printer for the algebra
type IntPrint() =
    interface IntAlg<string> with
        member __.Lit i = string i
        member __.Add l r = sprintf "(%s + %s)" l r

let print (f : IntExpr<_>) = f (IntPrint())

print (add (add (lit 3) (lit 5)) (lit -8))

Extending Algebra and Operations

 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:

// Multi-Sorted algebra of int/boolean expressions 
type IntBoolAlg<'I, 'B> =
    inherit IntAlg<'I>
    abstract Lit : bool -> 'B
    abstract IfThenElse : 'B -> 'I -> 'I -> 'I

// Church encoding of expressions in the algebra
type IntBoolExpr<'I,'B,'R> = IntBoolAlg<'I,'B> -> 'R
let litB (b : bool) : IntBoolExpr<'I,'B,'B> = fun alg -> alg.Lit b
let ifThenElse c a b : IntBoolExpr<'I,'B,'I> =
    fun alg -> alg.IfThenElse (c alg) (a alg) (b alg)

// Extending the evaluator
type IntBoolEval() =
    inherit IntEval()
    interface IntBoolAlg<int, bool> with
        member __.Lit (b:bool) = b
        member __.IfThenElse b a c = if b then a else c

let eval' (f : IntBoolExpr<_,_,_>) = f (IntBoolEval())

eval' (ifThenElse (litB false) (lit 3) (add (lit 3) (lit 5)))

// Extending the pretty-printer
type IntBoolPrint() =
    inherit IntPrint()
    interface IntBoolAlg<string, string> with
        member __.Lit (b : bool) = sprintf "%b" b
        member __.IfThenElse b a c = sprintf "if %s then %s else %s" b a c

let print' (f : IntBoolExpr<_,_,_>) = f (IntBoolPrint())

print' (ifThenElse (litB false) (lit 3) (add (lit 3) (lit 5)))

abstract member IntAlg.Lit : int -> 'I

Full name: Script.IntAlg`1.Lit

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 IntAlg.Add : 'I -> 'I -> 'I

Full name: Script.IntAlg`1.Add

type IntExpr<'I> = IntAlg<'I> -> 'I

Full name: Script.IntExpr<_>

type IntAlg<'I> =
  interface
    abstract member Add : 'I -> 'I -> 'I
    abstract member Lit : int -> 'I
  end

Full name: Script.IntAlg<_>

val lit : i:int -> alg:IntAlg<'I> -> 'I

Full name: Script.lit

val i : int

val alg : IntAlg<'I>

abstract member IntAlg.Lit : int -> 'I

val add : l:(IntAlg<'I> -> 'I) -> r:(IntAlg<'I> -> 'I) -> alg:IntAlg<'I> -> 'I

Full name: Script.add

val l : (IntAlg<'I> -> 'I)

val r : (IntAlg<'I> -> 'I)

abstract member IntAlg.Add : 'I -> 'I -> 'I

Multiple items
type IntEval =
interface IntAlg<int>
new : unit -> IntEval

Full name: Script.IntEval

--------------------
new : unit -> IntEval

override IntEval.Lit : i:int -> int

Full name: Script.IntEval.Lit

val __ : IntEval

override IntEval.Add : l:int -> r:int -> int

Full name: Script.IntEval.Add

val l : int

val r : int

val eval : f:IntExpr<int> -> int

Full name: Script.eval

val f : IntExpr<int>

Multiple items
type IntPrint =
interface IntAlg<string>
new : unit -> IntPrint

Full name: Script.IntPrint

--------------------
new : unit -> IntPrint

Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string

override IntPrint.Lit : i:int -> string

Full name: Script.IntPrint.Lit

val __ : IntPrint

override IntPrint.Add : l:string -> r:string -> string

Full name: Script.IntPrint.Add

val l : string

val r : string

val sprintf : format:Printf.StringFormat<'T> -> 'T

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

val print : f:IntExpr<string> -> string

Full name: Script.print

val f : IntExpr<string>

type IntBoolAlg<'I,'B> =
  interface
    inherit IntAlg<'I>
    abstract member IfThenElse : 'B -> 'I -> 'I -> 'I
    abstract member Lit : bool -> 'B
  end

Full name: Script.IntBoolAlg<_,_>

abstract member IntBoolAlg.Lit : bool -> 'B

Full name: Script.IntBoolAlg`2.Lit

type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool

abstract member IntBoolAlg.IfThenElse : 'B -> 'I -> 'I -> 'I

Full name: Script.IntBoolAlg`2.IfThenElse

type IntBoolExpr<'I,'B,'R> = IntBoolAlg<'I,'B> -> 'R

Full name: Script.IntBoolExpr<_,_,_>

val litB : b:bool -> alg:IntBoolAlg<'I,'B> -> 'B

Full name: Script.litB

val b : bool

val alg : IntBoolAlg<'I,'B>

abstract member IntAlg.Lit : int -> 'I
abstract member IntBoolAlg.Lit : bool -> 'B

val ifThenElse : c:(IntBoolAlg<'I,'B> -> 'B) -> a:(IntBoolAlg<'I,'B> -> 'I) -> b:(IntBoolAlg<'I,'B> -> 'I) -> alg:IntBoolAlg<'I,'B> -> 'I

Full name: Script.ifThenElse

val c : (IntBoolAlg<'I,'B> -> 'B)

val a : (IntBoolAlg<'I,'B> -> 'I)

val b : (IntBoolAlg<'I,'B> -> 'I)

abstract member IntBoolAlg.IfThenElse : 'B -> 'I -> 'I -> 'I

Multiple items
type IntBoolEval =
  inherit IntEval
  interface IntBoolAlg<int,bool>
  new : unit -> IntBoolEval

Full name: Script.IntBoolEval

--------------------
new : unit -> IntBoolEval

override IntBoolEval.Lit : b:bool -> bool

Full name: Script.IntBoolEval.Lit

val __ : IntBoolEval

override IntBoolEval.IfThenElse : b:bool -> a:int -> c:int -> int

Full name: Script.IntBoolEval.IfThenElse

val a : int

val c : int

val eval' : f:IntBoolExpr<int,bool,'a> -> 'a

Full name: Script.eval'

val f : IntBoolExpr<int,bool,'a>

Multiple items
type IntBoolPrint =
  inherit IntPrint
  interface IntBoolAlg<string,string>
  new : unit -> IntBoolPrint

Full name: Script.IntBoolPrint

--------------------
new : unit -> IntBoolPrint

override IntBoolPrint.Lit : b:bool -> string

Full name: Script.IntBoolPrint.Lit

val __ : IntBoolPrint

override IntBoolPrint.IfThenElse : b:string -> a:string -> c:string -> string

Full name: Script.IntBoolPrint.IfThenElse

val b : string

val a : string

val c : string

val print' : f:IntBoolExpr<string,string,'a> -> 'a

Full name: Script.print'

val f : IntBoolExpr<string,string,'a>

Previous Version Raw view Test code New version

More information

Link:	http://fssnip.net/7Sx
Posted:	7 years ago
Author:	Eirik Tsarpalis
Tags:	object algebra , expression problem