Transform expressions into Excel formulae

open Mono.Reflection

/// Get reflected definition from a closure obj with Mono.Reflection
let defForObj() =
    let cache = System.Collections.Generic.Dictionary<_, _>()
    fun obj ->
        let ty = obj.GetType()
        if cache.ContainsKey ty then cache.[ty]
        else
            let methods = ty.GetMethods()

            // find closure's invoke
            let invoke = 
                methods |> Array.tryFind (fun mi -> mi.DeclaringType = ty && mi.Name = "Invoke")
            let def = 
                match invoke with
                | Some mi -> 
                    // invoke methods does have a body, so we don't check it for null 
                    // (but e.g. GetType doesn't)
                    mi.GetInstructions() 
                    |> Seq.tryFind (fun instr -> instr.OpCode = Emit.OpCodes.Call)
                    |> Option.bind (fun instr -> 
                        instr.Operand :?> System.Reflection.MethodInfo // original function info
                        |> Expr.TryGetReflectedDefinition)
                | _ -> None
            cache.Add(ty, def)
            def

/// Get reflected definition for method info 
let defForMethodInfo() =(...)

/// Simplified SpecificCall
let inline (|Func|_|) expr =(...)

/// Info for the transformation steps
type Info = {
    Scope: Map<string, Expr>
    Prior: int
    RightOperand: bool
}

/// Generate a formula pattern for an expression
/// column number - index of var in the env; '#' is a temp placeholder for a row number
let generatePattern expr env =     
    Defaults
    
    // check if we need to add the parens
    let inline addParens (info: Info) currPrior = 
        info.Prior < currPrior || (info.Prior = currPrior && info.RightOperand)

    // let x = ...; let f x y = ...; f 1 x
    // inside f x is Value(1), y is outer x value 
    let updateScope names parms scope =
        Seq.zip names parms
        |> Seq.fold (fun sc -> function
            | name, Var var -> replace name sc.[var.Name] sc
            | name, param -> replace name param sc) scope

    // print binary ops: (x op y)
    let rec inline printBinaryOp op x y curr (info: Info) = 
        let left = transform { info with Prior = curr; RightOperand = false } x
        let right = transform { info with Prior = curr; RightOperand = true } y
        let res = left + op + right in if addParens info curr then "(" + res +  ")" else res

    // print functions: name(arg1, arg2, ...)
    and inline printFunc name args info  =
        let argValues: string[] = List.map (transform !!info) args |> List.toArray
        sprintf "%s(%s)" name (String.Join (", ", argValues))

    // apply function with given parameters
    and applyFunc (var: Var, parms) info =(...)

    // transform an expression into pattern
    and transform (info: Info) = function
        | Func <@@ (+) @@> [x; y] -> printBinaryOp "+" x y 3 info
        | Func <@@ (-) @@> [x; y] -> printBinaryOp "-" x y 3 info
        | Func <@@ (*) @@> [x; y] -> printBinaryOp "*" x y 2 info
        | Func <@@ (/) @@> [x; y] -> printBinaryOp "/" x y 2 info
        | Func <@@ ( ** ) @@> [x; y] -> printBinaryOp "^" x y 1 info 
        | Func <@@ (~-) @@> [x] -> "-" + transform { info with Prior = 0 } x
        | Func <@@ (~+) @@> [x] -> transform { info with Prior = 0 } x
        | Func <@@ decimal @@> [x] 
        | Func <@@ double @@> [x] 
        | Func <@@ float @@> [x] -> string (transform { info with Prior = 0 } x)

        | Func <@@ mduration @@> args -> printFunc "MDURATION" args info
        | Func <@@ accrint @@> args -> printFunc "ACCRINT" args info
        | Lambdas (_, e) -> transform !!info e

        // let a, b, ... = 1, 2, ...
        // Note: nested tuples and tuples as return values are not supported
        | Let (_, NewTuple vs, e) -> 
            let res, newScope = Update the scope
            transform { info with Scope = newScope } res

        | Let (var, value, e) -> 
            transform { info with Scope = replace var.Name value info.Scope } e

        | Value (v, _) -> string v
        // try to replace a varname with its column index
        | Var var -> 
            match Map.tryFind var.Name info.Scope with
            | Some replacement -> transform info replacement
            | _ -> var.Name
        // args.[i] means reference to the (i+1)th column
        | Call(None, mi, _::[Value (i, _)]) when mi.DeclaringType.Name = "IntrinsicFunctions" 
                                              && mi.Name = "GetArray" -> 
            let ind = unbox i in "R#C" + string (ind + 1)
        
        // replace MakeDecimal with a value
        | Call(None, mi, Value (v, _)::_) when mi.DeclaringType.Name = "IntrinsicFunctions" 
                                            && mi.Name = "MakeDecimal"  -> 
            string v
        // try to inline a method call
        | Call(None, mi, ps) ->
            let names = mi.GetParameters() |> Array.map (fun p -> p.Name)
            let newScope = updateScope names ps info.Scope
            
            match tryGetReflectedDef mi with
            | Some impl ->
                let rec getCall e =
                    match e with
                    | Lambda(_, Lambda (_, e)) -> getCall e // skip parameters
                    | call -> call
                transform { info with Scope = newScope } (getCall impl)
                
            | _ -> failwith (sprintf "Can't get reflected definition for %s" mi.Name)
        // DateTime ctor -> Excel DATE function: DATE(year, month, day)
        | NewObject(ci, Value(y,_)::Value(m,_)::Value(d,_)::_) 
                                                when ci.DeclaringType.Name="DateTime"-> 
            sprintf "DATE(%A, %A, %A)" y m d    

        | Application ((Application args) as f, value) -> 
            collect params for the chain of function applications
            applyFunc (collectParams [value] f) info

        | Application (Var f, value) ->  applyFunc (f, [value]) info

        | LetRecursive _ -> failwith "Recursive functions are not supported"
        | expr -> failwith (sprintf "Unknown expression type: %A" expr)

    "=" + transform { Prior = defaultPrior; Scope = scope; RightOperand = false } expr

(Patterns example)

module Test =
    [<ReflectedDefinition>]
    [<MethodImpl(MethodImplOptions.NoInlining)>]
    let sum (a: decimal) b = a + b
  
    [<ReflectedDefinition>]
    [<MethodImpl(MethodImplOptions.NoInlining)>]
    let mdurationMonth m c y f basis = 
        (mduration (DateTime(2012, 1, 7)) m c y f basis) * 12M

    let run export = 
        let getReflectedDefinition = defForObj()

        let data: obj [][] = (Some data)

        // the vars with such names will be replaced with R{rownum}C{var index + 1}
        let dataColumns = ["a"; "b"; "s"; "m"; "c"; "y"; "f"; "basis"]
        let funcs: obj list = [sum; mdurationMonth]

        // transform quotation into a pattern & split by the rownum replacement '#'
        let unquote = 
            Option.bind (fun expr -> 
                try 
                    Some ((generatePattern expr dataColumns).Split [|'#'|])
                with _ -> None)

        // reflected definitions -> formulae
        let formulae = funcs
                        |> List.map (getReflectedDefinition >> unquote)
                        |> List.filter Option.isSome
                        |> List.map Option.get
        
        data |> Array.iteri (export formulae)

/// Export data with given pattern
let export exportValue exportFunc (patterns: string[] list) row (items: _[]) =(...)

// Standard output
Test.run (export 
            (fun (row, fst) col item -> printfn "Cells.[%d, %d]<-%A" row (col+fst) item)
            (fun (row, fst) col formula -> 
                printfn "Cells.[%d, %d].Formula <- \"%s\"" row (col+fst) formula))

let app = new ApplicationClass()
let workbook = app.Workbooks.Add(XlWBATemplate.xlWBATWorksheet)
let worksheet = workbook.Worksheets.[1] :?> Worksheet

// fill the cells
Test.run (export 
            (fun (row,fst) col item -> worksheet.Cells.[row, col+fst] <- item)
            (fun (row,fst) col formula -> 
                (worksheet.Cells.[row, col+fst] :?> Range).Formula <- formula))

app.ReferenceStyle <- XlReferenceStyle.xlA1

(Close workbook and release objects)