// Extending Discriminated Unions Modularly - or try as hard as we can ... // Program by Chuck Liang, Hofstra University Computer Science, 2017,2018 // This program deals with the problem of how to modularly extend a recursive // discriminated union type definition and the functions defined on it. It // experiments with the following technqiues: //1. Marker interfaces: dummy interfaces that can be implemented later // by different types. This idea was taken from an article found here: // http://theburningmonk.com/2012/03/f-extending-discriminated-unions-using-marker-interfaces/ // However, the example in this article does not deal with recursive type // definitions, such as found in the expression tree example. //2. Active patterns can be used to hide the somewhat ugly code of // of matching against types and type casting. What this doesn't solve // is the loss of static type safety guarantees. This is the price of // of type casting, and the price of OOP in general. // "Partial" active patterns can be used to extend existing patterns, // but this techniques can only be used to define one pattern at a time. // Without partial patterns we would need to use try-catch clauses. //3. Aspect-oriented style code interception can inject the code to // match against active patterns and catch missed cases. This // can be emulated in F# by using mutable lambda terms to define functions, // and by simulating the dynamic scoping of globally bound functions. //4. Code generation is experimented with that tries to automatically // generate the "glue" code needed to deal with modularly extended // types. This is the kind of thing that "attributes" and compiler // directives do: they modify and generate code. open System;; type Gexpr = interface end;; // this defines a marker interface, like interface Gexpr {} in java // expressions trees with just numbers and addition type expr = | Num of int | Plus of Gexpr*Gexpr interface Gexpr;; // the interface declaration means that an expr is also a Gexpr // oops, forgot multiplication: type expr2 = | Times of Gexpr*Gexpr interface Gexpr;; // This won't compile: //let rec evaluate = function // | Num(n) -> n // | Plus(x,y) -> evaluate(x) + evaluate(y) // | Times(x,y) -> evaluate(x) * evaluate(y);; // BECAUSE the types of Num, Plus are expr but Times is expr2. Although // both expr and expr2 are Gexpr, F# does not do this kind of type inference // because it would entail a loss of static type safety: in the worst case // everything would be typed as object (obj in F#). // Create a new type of exception for unknown patterns (no longer used) type unknowncase = inherit Exception val exp:Gexpr member this.get = exp new(t) = { inherit Exception(); exp=t};; // Active pattern encapsulates type testing and casting: let (|GNum|GPlus|GTimes|) (e:Gexpr) = match e with | :? expr -> match (e :?> expr) with | Num(x) -> GNum(x) | Plus(y,z) -> GPlus(y,z) | :? expr2 -> match (e :?> expr2) with | Times(u,v) -> GTimes(u,v) | e -> raise (unknowncase(e));; // "Active" pattern means each time we try to match against these patterns, // this code (match e with ...) is executed. // a function must use the active patterns to match (GNum instead of Num) let rec printG = function | GNum(n) -> string(n) | GPlus(GNum(x),GNum(y)) -> string(x) + "+" + string(y) | GPlus(x,y) -> "(" + printG(x) + " + " + printG(y) + "(" | GTimes(x,y) -> printG(x) + "*" + printG(y);; let e = Plus(Times(Num(2),Num(3)),Num(5));; printfn "%s" (printG(e));; printfn "%s" (printG(Plus(Num(2),Num(7))));; ////////// EVAL // make function mutable so we can "inject behavior" into it later. let mutable eval = fun (e:Gexpr) -> 1; // dummy for mutable recursive function eval <- fun (e:Gexpr) -> match e with | GNum(n) -> n | GPlus(x,y) -> eval(x) + eval(y) | GTimes(x,y) -> eval(x) * eval(y);; printfn "eval = %d" (eval(e));; // Now add yet another kind of expression: type expr3 = | Neg of Gexpr interface Gexpr;; // unary minus operator // Partial active pattern avoids try-catch, but only works for singleton cases let (|GNeg|_|) (e:Gexpr) = // allows matches with other cases on failure match e with | :? expr3 -> match (e :?> expr3) with | Neg(x) -> Some(GNeg(x)) | _ -> None;; //no need to raise exception if using partial pattern // Without partial active pattern, we would need to catch the exception // when a match with one set of patterns fail, so we can match another. // When mixing partial and non-partial cases, the partial ones must be // matched first. let ff (e:Gexpr) = match e with | GNeg(GNum(u)) -> 4 // must put GNeg cases first to avoid try-catch | GNeg(GPlus(x,GNeg(y))) -> 99 // nested, mixed cases work... | GNeg(v) -> 3 | GNum(n) -> 0 | GPlus(x,y) -> 1 | GTimes(x,y) -> 2 | _ -> -1;; (* doesn't work - can't do without redefining whole thing ///// extend printG function using unknowncase exception let rec printGG e = try printG(e) with | :? unknowncase as ee -> match (ee.exp) with | GNeg(GNum(n)) -> "-" + string(n) | GNeg(v) -> "-" + printGG(v);; *) Console.WriteLine( ff(Neg(Num(3))));; Console.WriteLine( ff(Neg(Plus(Num(1),Num(3)))));; Console.WriteLine( ff(Num(3))); Console.WriteLine( ff(Neg(Plus(Num(1),Neg(Num(2))))));; //Console.WriteLine( printGG (Plus(Num(1),Neg(Num(3)))) );; // Extending eval with AOP-style code interception. let evalAdvice(target:unit->unit) = // execute target program under advice let seval = eval; // stack eval, simulate dynamic scoping eval <- fun ex -> match ex with | GNeg(x) -> -1 * eval(x) | _ -> seval(ex); target(); // execute target eval <- seval;; // restore original eval // the extension is "local" to code executed under advice. let main() = let ex = Plus(Num(4),Times(Neg(Num(3)),Num(2))) // evals to -2 printfn "extended eval = %d" (eval(Times(Neg(ex),Neg(Num(3)))));; evalAdvice(main);; // run "main" under advice // We need to simulate dynamic scoping to get this to work. Had we // just defined a new version of eval: // let rec evalnew ex = // try // match ex with // | GNeg(x) -> -1 * evalnew(x) // with // | _ -> eval(ex);; // Then the recursive calls to eval will never call evalnew. ///////// SOME CODE-GENERATING CODE! // "Friends don't let friends use self-modifying code. But it's fun..." ///////// code to generate code for a new active pattern set: // abstract structure representing meta-level information pertaining // to case, type and interface: // (subtype, (string name, string argnames)) //e.g. ("expr2", [("Times", "(x,y)"); ("Neg", "(x)")]) let APGEN cases ifacename = let mutable dec = "let (|" // start of first line for (sb,subcases) in cases do for (name,args) in subcases do dec <- dec + "G"+name+"|" dec <- dec + ") (e:"+ ifacename+ ") =\n match e with\n" for (subtype,subcases) in cases do dec <- dec + " | :? "+subtype+" ->\n" dec <- dec + " match (e :?> "+subtype+") with\n" for (name,args) in subcases do dec <- dec + " | "+name+args+" -> G"+name+args+"\n" dec <- dec + " | _ -> raise (Exception(\"unknown pattern\"));;\n" dec;; let mutable cases = [("expr",[("Num","(n)");("Plus","(x,y)")])];; cases <- ("expr2",[("Times","(x,y)")])::cases;; cases <- ("expr3",[("Neg","(x)")])::cases;; let gluecode = APGEN cases "Gexpr";; Console.WriteLine(gluecode);; // TAKE THAT F#!!!! (* outputs compilable code: let (|GNeg|GTimes|GNum|GPlus|) (e:Gexpr) = match e with | :? expr3 -> match (e :?> expr3) with | Neg(x) -> GNeg(x) | :? expr2 -> match (e :?> expr2) with | Times(x,y) -> GTimes(x,y) | :? expr -> match (e :?> expr) with | Num(n) -> GNum(n) | Plus(x,y) -> GPlus(x,y) | _ -> raise (Exception("unknown pattern"));; *) // This is what some compiler directives do: generate and inject code.