// Extending Discriminated Unions using Active Patterns and Code-Generation

open System;;

type Gexpr = interface end;; // marker interface

type expr = | Num of int | Plus of Gexpr*Gexpr  interface Gexpr;;

type expr2 = | Times of Gexpr*Gexpr  interface Gexpr;;


// 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)   // expect compiler warning
       | _ -> raise (Exception("don't know that one"));;


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


// add another:

type expr3 = | Neg of Gexpr  interface Gexpr;;

let (|GNeg|) (e:Gexpr) =
   match e with
     | :? expr3 ->
        match (e :?> expr3) with
          | Neg(x) -> GNeg(x)   // compiler warning again
     | _ -> raise (Exception("still don't know that one"));;

let ff (e:Gexpr) = 
  try match e with         // try-catch - no way to get around.
        | GNum(n) -> 0
        | GPlus(x,y) -> 1
        | GTimes(x,y) -> 2     
  with
    | _ ->
      match e with
        | GNeg(GNum(u)) -> 4
        | GNeg(v) -> 3;;

Console.WriteLine( ff(Neg(Num(3))));;
Console.WriteLine( ff(Neg(Plus(Num(1),Num(3)))));;
Console.WriteLine( ff(Num(3)));

// Use Neg, Num, Plus, Times to construct terms, but GNum, GNeg ... to match

//// TIME FOR SOME CODE-GENERATING CODE!
///////// 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"));;
*)

// problem: how about previous functions for interface Gexpr?
// They compiled, but they do not cover all cases - are they now wrong?