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 a term in the algebra
type IntExpr<'I,'R> = IntAlg<'I> -> 'R

let ``3 + 5`` : IntExpr<_,_> = fun alg -> alg.Add (alg.Lit 3) (alg.Lit 5)

// 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 ``3 + 5``

// 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 ``3 + 5``

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: 
34: 
35: 
36:

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 ``if false then 3 else 3 + 5`` : IntBoolExpr<_,_,_> =
    fun alg ->
        alg.IfThenElse
            (alg.Lit false)
            (alg.Lit 3)
            (``3 + 5`` 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' ``if false then 3 else 3 + 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' ``if false then 3 else 3 + 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,'R> = IntAlg<'I> -> 'R

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 ( 3 + 5 ) : alg:IntAlg<'a> -> 'a

Full name: Script.( 3 + 5 )

val alg : IntAlg<'a>

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

abstract member IntAlg.Lit : int -> '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 i : int

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,'a> -> 'a

Full name: Script.eval

val f : IntExpr<int,'a>

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,'a> -> 'a

Full name: Script.print

val f : IntExpr<string,'a>

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 ( if false then 3 else 3 + 5 ) : alg:IntBoolAlg<'a,'b> -> 'a

Full name: Script.( if false then 3 else 3 + 5 )

val alg : IntBoolAlg<'a,'b>

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

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

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 b : bool

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>

Next 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