2 people like it.

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