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 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>

More information

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