Friday, March 2, 2012

Wrapping visitors with active patterns in F#

In the last post I showed how to interop F# and C# algebraic data types (ADT).

In C# you'll typically have ADTs or ADT-like structures expressed as a hierarchy of classes and the Visitor pattern to traverse/deconstruct them.

So the question is: what's the best way to use C#/VB.NET visitors in F#?

As an example, let's borrow a C# - F# comparison from Stackoverflow by Juliet Rosenthal, which models boolean operations:

public interface IExprVisitor<out T> {
    T Visit(TrueExpr expr);
    T Visit(And expr);
    T Visit(Nand expr);
    T Visit(Or expr);
    T Visit(Xor expr);
    T Visit(Not expr);
}

public abstract class Expr {
    public abstract t Accept<t>(IExprVisitor<t> visitor);
}

public abstract class UnaryOp : Expr {
    public Expr First { get; private set; }

    public UnaryOp(Expr first) {
        First = first;
    }
}

public abstract class BinExpr : Expr {
    public Expr First { get; private set; }
    public Expr Second { get; private set; }

    public BinExpr(Expr first, Expr second) {
        First = first;
        Second = second;
    }
}

public class TrueExpr : Expr {
    public override t Accept<t>(IExprVisitor<t> visitor) {
        return visitor.Visit(this);
    }
}

public class And : BinExpr {
    public And(Expr first, Expr second) : base(first, second) {}

    public override t Accept<t>(IExprVisitor<t> visitor) {
        return visitor.Visit(this);
    }
}

public class Nand : BinExpr {
    public Nand(Expr first, Expr second) : base(first, second) {}

    public override t Accept<t>(IExprVisitor<t> visitor) {
        return visitor.Visit(this);
    }
}

public class Or : BinExpr {
    public Or(Expr first, Expr second) : base(first, second) {}

    public override t Accept<t>(IExprVisitor<t> visitor) {
        return visitor.Visit(this);
    }
}

public class Xor : BinExpr {
    public Xor(Expr first, Expr second) : base(first, second) {}

    public override t Accept<t>(IExprVisitor<t> visitor) {
        return visitor.Visit(this);
    }
}

public class Not : UnaryOp {
    public Not(Expr first) : base(first) {}

    public override t Accept<t>(IExprVisitor<t> visitor) {
        return visitor.Visit(this);
    }
}

Let's say we want to write a function in F# to evaluate a boolean expression using these classes. We could use an object expression to create an inline visitor:

let rec eval (e: Expr) =
    e.Accept { new IExprVisitor<bool> with
                member x.Visit(e: TrueExpr) = true
                member x.Visit(e: And)      = eval(e.First) && eval(e.Second)
                member x.Visit(e: Nand)     = not(eval(e.First) && eval(e.Second))
                member x.Visit(e: Or)       = eval(e.First) || eval(e.Second)
                member x.Visit(e: Xor)      = eval(e.First) <> eval(e.Second)
                member x.Visit(e: Not)      = not(eval(e.First)) }

This is already more concise than the equivalent C# code, but we can do better. Once again, active patterns are the key. We only need one visitor to do the required plumbing:

module Expr = 
    open DiscUnionInteropCS

    type ExprChoice = Choice<unit, Expr * Expr, Expr * Expr, Expr * Expr, Expr * Expr, Expr>

    let private visitor = 
        { new IExprVisitor<ExprChoice> with
            member x.Visit(e: TrueExpr): ExprChoice = Choice1Of6 ()
            member x.Visit(e: And):      ExprChoice = Choice2Of6 (e.First, e.Second)
            member x.Visit(e: Nand):     ExprChoice = Choice3Of6 (e.First, e.Second)
            member x.Visit(e: Or):       ExprChoice = Choice4Of6 (e.First, e.Second)
            member x.Visit(e: Xor):      ExprChoice = Choice5Of6 (e.First, e.Second)
            member x.Visit(e: Not):      ExprChoice = Choice6Of6 e.First }

    let (|True|And|Nand|Or|Xor|Not|) (e: Expr) =
        e.Accept visitor

And now we can write eval more idiomatically and more concise:

let rec eval = 
    function
    | True          -> true
    | And(e1, e2)   -> eval(e1) && eval(e2)
    | Nand(e1, e2)  -> not(eval(e1) && eval(e2))
    | Or(e1, e2)    -> eval(e1) || eval(e2)
    | Xor(e1, e2)   -> eval(e1) <> eval(e2)
    | Not(e1)       -> not(eval(e1))

This also opens the doors for more complex pattern matching. See Juliet's post for an example.

No comments: