RInterop.fs

namespace RProvider

open System
open System.Numerics
open System.Collections.Generic
open System.ComponentModel.Composition
open System.ComponentModel.Composition.Hosting
open System.Reflection
open System.IO
open System.Linq
open Microsoft.FSharp.Reflection

open RDotNet
open RDotNet.ActivePatterns
open RProvider.Internal
open RProvider.Internal.RInit
open RProvider.Internal.Configuration

/// This interface can be used for providing new convertors that can convert
/// custom .NET data types to R values. The converter is used whenever the
/// user calls an R function (such as `R.foo(...)`) with an arguments that
/// is of type `TInType`.
type IConvertToR<'TInType> =
    /// The method is called when the user calls any of the provided R
    /// functions with a value of type `'TInType` as an argument.
    ///
    /// ## Example
    /// To use this interface, you need to write a plugin (`YourPlugin.Plugin.dll`)
    /// that exports an implementation of this interface using MEF. The method
    /// `Convert` of the interface is called with the value of `'TInType` and should
    /// return an R symbolic expression.
    ///
    ///     [<Export(typeof<IConvertToR<IFrame>>)>]
    ///     type ConvertMyThingToR() =
    ///       interface IConvertToR<IFrame> with
    ///         member x.Convert(engine, input:MyThing) =
    ///           R.c(1,2,3) // TODO: Convert 'input' to R.
    ///
    abstract member Convert: REngine * 'TInType -> SymbolicExpression

/// This interface can be used for providing new convertors that can convert
/// R values to .NET types. The converter is used whenever the users calls the
/// `se.GetValue<'TOutType>()` on a `SymbolicExpression` value returned from R
/// provider.
type IConvertFromR<'TOutType> =
    /// The method is called when the user calls `GetValue<'TOutType>()` on a
    /// `SymbolicExpression` value returned from the R provider.
    ///
    /// ## Example
    /// To use this interface, you need to write a plugin (`YourPlugin.Plugin.dll`)
    /// that exports an implementation of this interface using MEF. The method
    /// `Convert` of the interface can return `None` when the conversion is not
    /// possible.
    ///
    ///     [<Export(typeof<IConvertFromR<MyType>>)>]
    ///     type ConvertMyThingFromR() =
    ///       interface IConvertFromR<MyThing> with
    ///       member x.Convert(symExpr) =
    ///         Some(new MyThing()) // TODO: Convert 'symExpr' from R.
    ///
    abstract member Convert: SymbolicExpression -> Option<'TOutType>

/// This interface can be used for providing a default converter that converts
/// R value to .NET `obj` values. The converter is used whenever the user calls the
/// `se.Value` member on `SymbolicExpression. This property should convert an R
/// value to the "most appropriate" .NET object.
type IDefaultConvertFromR =
    /// The method is called when the user accesses the `Value` property
    /// on a `SymbolicExpression` value returned from the R provider.
    abstract member Convert: SymbolicExpression -> Option<obj>

/// Contains helper functions for calling the functions generated by the R provider,
/// such as the `namedParams` function for specifying named parameters.
/// The module is automatically opened when you open the `RProvider` namespace.
[<AutoOpen>]
module Helpers =
    /// Construct a dictionary of named params to pass to an R function.
    ///
    /// ## Example
    /// For example, if you want to call the `R.plot` function with named parameters
    /// specifying `x`, `type`, `col` and `ylim`, you can use the following:
    ///
    ///     [ "x", box widgets;
    ///       "type", box "o";
    ///       "col", box "blue";
    ///       "ylim", box [0; 25] ]
    ///     |> namedParams |> R.plot
    ///
    let namedParams (s: seq<string * _>) = dict <| Seq.map (fun (n, v) -> n, box v) s

module internal RInteropInternal =
    type RParameter = string
    type HasVarArgs = bool

    [<Literal>]
    let RDateOffset = 25569.

    let private mefContainer =
        lazy
            (
            // Look for plugins co-located with RProvider.dll
            let assem = typeof<IConvertToR<_>>.Assembly

            let assemblyLocation =
                if String.IsNullOrEmpty assem.Location then AppContext.BaseDirectory else assem.Location

            Logging.logf "[DEBUG] MEF Container 1: RProvider.dll is at %s" assemblyLocation

            let dirs = getProbingLocations ()
            Logging.logf "[DEBUG] MEF Container 2: Probing locations = %A" dirs

            let catalogs: seq<Primitives.ComposablePartCatalog> =
                seq {
                    yield upcast new DirectoryCatalog(Path.GetDirectoryName assemblyLocation, "*.Plugin.dll")

                    for d in dirs do
                        yield upcast new DirectoryCatalog(d, "*.Plugin.dll")

                    yield upcast new AssemblyCatalog(assem)
                }

            Logging.logf "[DEBUG] MEF Container 3: Catalog count = %O" (catalogs.Count())
            new CompositionContainer(new AggregateCatalog(catalogs)))

    let internal toRConv = Dictionary<Type, REngine -> obj -> SymbolicExpression>()

    /// Register a function that will convert from a specific type to a value in R.
    /// Alternatively, you can build a MEF plugin that exports IConvertToR.
    /// registerToR is more suitable for experimentation in F# interactive.
    let registerToR<'inType> (conv: REngine -> 'inType -> SymbolicExpression) =
        let conv' rengine (value: obj) = unbox value |> conv rengine
        toRConv.[typeof<'inType>] <- conv'

    let internal convertToR<'inType> (engine: REngine) (value: 'inType) =
        let concreteType = value.GetType()
        let gt = typedefof<IConvertToR<_>>

        // Returns an ordered sequence of types that should be considered for the purpose of converting.
        // We look at interfaces introduced on the current type before traversing to the base type.
        let rec types (vt: Type) =
            seq {
                // First consider the type itself
                yield vt

                // Now consider interfaces implemented on this type that are not implemented on the base
                let baseInterfaces = if isNull vt.BaseType then Array.empty else vt.BaseType.GetInterfaces()

                for iface in vt.GetInterfaces() do
                    if not (baseInterfaces.Contains(iface)) then yield iface

                // Now consider the base type (plus its interfaces etc.)
                if not <| isNull vt.BaseType then yield! types vt.BaseType
            }

        // Try to get a converter for the given type
        let tryGetConverter (vt: Type) =
            // See if a MEF finds a converter for the type - these take precedence over built-ins
            let interfaceType = gt.MakeGenericType([| vt |])

            // If there are multiple plugins registered, we arbitrarily use the "first"
            match mefContainer.Value.GetExports(interfaceType, null, null).FirstOrDefault() with
            // Nothing from MEF, try to find a built-in
            | null ->
                match toRConv.TryGetValue(vt) with
                | (true, conv) -> Some conv
                | _ -> None

            // Use MEF converter
            | conv ->
                let convMethod = interfaceType.GetMethod("Convert")
                Some(fun engine value -> convMethod.Invoke(conv.Value, [| engine; value |]) :?> SymbolicExpression)

        match Seq.tryPick tryGetConverter (types concreteType) with
        | Some conv -> conv engine value
        | None -> failwithf "No converter registered for type %s or any of its base types" concreteType.FullName

    let internal convertFromRBuiltins<'outType> (sexp: SymbolicExpression) : Option<'outType> =
        let retype (x: 'b) : Option<'a> = x |> box |> unbox |> Some
        let at = typeof<'outType>

        match sexp with
        | CharacterVector (v) when at = typeof<string list> -> retype <| List.ofSeq (v)
        | CharacterVector (v) when at = typeof<string []> -> retype <| v.ToArray()
        | CharacterVector (v) when at = typeof<string> -> retype <| v.Single()
        | ComplexVector (v) when at = typeof<Complex list> -> retype <| List.ofSeq (v)
        | ComplexVector (v) when at = typeof<Complex []> -> retype <| v.ToArray()
        | ComplexVector (v) when at = typeof<Complex> -> retype <| v.Single()
        | IntegerVector (v) when at = typeof<int list> -> retype <| List.ofSeq (v)
        | IntegerVector (v) when at = typeof<int []> -> retype <| v.ToArray()
        | IntegerVector (v) when at = typeof<int> -> retype <| v.Single()
        | LogicalVector (v) when at = typeof<bool list> -> retype <| List.ofSeq (v)
        | LogicalVector (v) when at = typeof<bool []> -> retype <| v.ToArray()
        | LogicalVector (v) when at = typeof<bool> -> retype <| v.Single()
        | NumericVector (v) when at = typeof<double list> -> retype <| List.ofSeq (v)
        | NumericVector (v) when at = typeof<double []> -> retype <| v.ToArray()
        | NumericVector (v) when at = typeof<double> -> retype <| v.Single()
        | NumericVector (v) when at = typeof<DateTime list> ->
            retype <| [ for n in v -> DateTime.FromOADate(n + RDateOffset) ]
        | NumericVector (v) when at = typeof<DateTime []> ->
            retype <| [| for n in v -> DateTime.FromOADate(n + RDateOffset) |]
        | NumericVector (v) when at = typeof<DateTime> -> retype <| DateTime.FromOADate(v.Single() + RDateOffset)
        | NumericMatrix (v) when at = typeof<double [,]> -> retype <| v.ToArray()
        | CharacterMatrix (v) when at = typeof<string [,]> -> retype <| v.ToArray()
        | IntegerMatrix (v) when at = typeof<int [,]> -> retype <| v.ToArray()
        | LogicalMatrix (v) when at = typeof<int [,]> -> retype <| v.ToArray()
        // Empty vectors in R are represented as null
        | Null () when at = typeof<string list> -> retype <| List.empty<string>
        | Null () when at = typeof<string []> -> retype <| Array.empty<string>
        | Null () when at = typeof<Complex list> -> retype <| List.empty<Complex>
        | Null () when at = typeof<Complex []> -> retype <| Array.empty<Complex>
        | Null () when at = typeof<int list> -> retype <| List.empty<int>
        | Null () when at = typeof<int []> -> retype <| Array.empty<int>
        | Null () when at = typeof<bool list> -> retype <| List.empty<bool>
        | Null () when at = typeof<bool []> -> retype <| Array.empty<bool>
        | Null () when at = typeof<double list> -> retype <| List.empty<double>
        | Null () when at = typeof<double []> -> retype <| Array.empty<double>
        | Null () when at = typeof<DateTime list> -> retype <| List.empty<DateTime>
        | Null () when at = typeof<DateTime []> -> retype <| Array.empty<DateTime>

        | _ -> None

    let internal convertFromR<'outType> (sexp: SymbolicExpression) : 'outType =
        let concreteType = typeof<'outType>
        let vt = typeof<IConvertFromR<'outType>>

        let converters = mefContainer.Value.GetExports<IConvertFromR<'outType>>()

        match converters |> Seq.tryPick (fun conv -> conv.Value.Convert sexp) with
        | Some res -> res
        | None ->
            match convertFromRBuiltins<'outType> sexp with
            | Some res -> res
            | _ ->
                failwithf
                    "No converter registered to convert from R %s to type %s"
                    (sexp.Type.ToString())
                    concreteType.FullName

    let internal defaultConvertFromRBuiltins (sexp: SymbolicExpression) : Option<obj> =
        let wrap x = box x |> Some

        match sexp with
        | CharacterVector (v) -> wrap <| v.ToArray()
        | ComplexVector (v) -> wrap <| v.ToArray()
        | IntegerVector (v) -> wrap <| v.ToArray()
        | LogicalVector (v) -> wrap <| v.ToArray()
        | NumericVector (v) ->
            match v.GetAttribute("class") with
            | CharacterVector (cv) when cv.ToArray() = [| "Date" |] ->
                wrap <| [| for n in v -> DateTime.FromOADate(n + RDateOffset) |]
            | _ -> wrap <| v.ToArray()
        | CharacterMatrix (v) -> wrap <| v.ToArray()
        | ComplexMatrix (v) -> wrap <| v.ToArray()
        | IntegerMatrix (v) -> wrap <| v.ToArray()
        | LogicalMatrix (v) -> wrap <| v.ToArray()
        | NumericMatrix (v) -> wrap <| v.ToArray()
        | List (v) -> wrap <| v
        | Pairlist (pl) -> wrap <| (pl |> Seq.map (fun sym -> sym.PrintName, sym.AsSymbol().Value))
        | Null () -> wrap <| null
        | Symbol (s) -> wrap <| (s.PrintName, s.Value)
        | _ -> None

    let internal defaultConvertFromR (sexp: SymbolicExpression) : obj =
        Logging.logf "Converting value from R..."
        let converters = mefContainer.Value.GetExports<IDefaultConvertFromR>()

        match converters |> Seq.tryPick (fun conv -> conv.Value.Convert sexp) with
        | Some res -> res
        | None ->
            match defaultConvertFromRBuiltins sexp with
            | Some res -> res
            | _ -> failwithf "No default converter registered from R %s " (sexp.Type.ToString())


    let createDateVector (dv: seq<DateTime>) =
        let vec = engine.Value.CreateNumericVector [| for x in dv -> x.ToOADate() - RDateOffset |]
        vec.SetAttribute("class", engine.Value.CreateCharacterVector [| "Date" |])
        vec

    do
        registerToR<SymbolicExpression> (fun engine v -> v)

        registerToR<string> (fun engine v -> upcast engine.CreateCharacterVector [| v |])
        registerToR<Complex> (fun engine v -> upcast engine.CreateComplexVector [| v |])
        registerToR<int> (fun engine v -> upcast engine.CreateIntegerVector [| v |])
        registerToR<bool> (fun engine v -> upcast engine.CreateLogicalVector [| v |])
        registerToR<byte> (fun engine v -> upcast engine.CreateRawVector [| v |])
        registerToR<double> (fun engine v -> upcast engine.CreateNumericVector [| v |])
        registerToR<DateTime> (fun engine v -> upcast createDateVector [| v |])

        registerToR<string seq> (fun engine v -> upcast engine.CreateCharacterVector v)
        registerToR<Complex seq> (fun engine v -> upcast engine.CreateComplexVector v)
        registerToR<int seq> (fun engine v -> upcast engine.CreateIntegerVector v)
        registerToR<bool seq> (fun engine v -> upcast engine.CreateLogicalVector v)
        registerToR<byte seq> (fun engine v -> upcast engine.CreateRawVector v)
        registerToR<double seq> (fun engine v -> upcast engine.CreateNumericVector v)
        registerToR<DateTime seq> (fun engine v -> upcast createDateVector v)

        registerToR<string [,]> (fun engine v -> upcast engine.CreateCharacterMatrix v)
        registerToR<Complex [,]> (fun engine v -> upcast engine.CreateComplexMatrix v)
        registerToR<int [,]> (fun engine v -> upcast engine.CreateIntegerMatrix v)
        registerToR<bool [,]> (fun engine v -> upcast engine.CreateLogicalMatrix v)
        registerToR<byte [,]> (fun engine v -> upcast engine.CreateRawMatrix v)
        registerToR<double [,]> (fun engine v -> upcast engine.CreateNumericMatrix v)

    type RDotNet.REngine with
        member this.SetValue(value: obj, ?symbolName: string) : SymbolicExpression =
            let se = convertToR this value
            if symbolName.IsSome then engine.Value.SetSymbol(symbolName.Value, se)
            se

    let mutable symbolNum = 0
    let pid = System.Diagnostics.Process.GetCurrentProcess().Id

    /// Get next symbol name
    let getNextSymbolName () : string =
        symbolNum <- symbolNum + 1
        sprintf "fsr_%d_%d" pid symbolNum

    let toR (value: obj) =
        let symbolName = getNextSymbolName ()
        let se = engine.Value.SetValue(value, symbolName)
        symbolName, se

    let eval (expr: string) =
        Logging.logWithOutput
            characterDevice
            (fun () ->
                Logging.logf "eval(%s)" expr
                engine.Value.Evaluate(expr))

    let evalTo (expr: string) (symbol: string) =
        Logging.logWithOutput
            characterDevice
            (fun () ->
                Logging.logf "evalto(%s, %s)" expr symbol
                engine.Value.SetSymbol(symbol, engine.Value.Evaluate(expr)))

    let exec (expr: string) : unit =
        Logging.logWithOutput
            characterDevice
            (fun () ->
                Logging.logf "exec(%s)" expr
                use res = engine.Value.Evaluate(expr)
                ())

open RInteropInternal

/// [omit]
[<AutoOpen>]
module RDotNetExtensions =
    type RDotNet.SymbolicExpression with
        member this.Class: string [] =
            match this.GetAttribute("class") with
            | null -> [||]
            | attrs -> attrs.AsCharacter().ToArray()

        member this.GetValue<'a>() : 'a = convertFromR<'a> this
        member this.Value = defaultConvertFromR this

        /// Get the member symbolic expression of given name.
        member this.Member(name: string) = 
            match this.Type with
            | Internals.SymbolicExpressionType.List -> this.AsList().[name]
            | Internals.SymbolicExpressionType.S4 -> this.GetAttribute(name)
            | _ -> invalidOp "Unsupported operation on R object"

        /// Get the value from the typed vector by name.
        member this.ValueOf<'a> (name: string) =
            match this.Type with
            | Internals.SymbolicExpressionType.NumericVector -> box(this.AsNumeric().[name]) :?> 'a
            | Internals.SymbolicExpressionType.CharacterVector -> box(this.AsCharacter().[name]) :?> 'a
            | Internals.SymbolicExpressionType.LogicalVector -> box(this.AsLogical().[name]) :?> 'a
            | Internals.SymbolicExpressionType.IntegerVector -> box(this.AsInteger().[name]) :?> 'a
            | Internals.SymbolicExpressionType.ComplexVector -> box(this.AsComplex().[name]) :?> 'a
            | Internals.SymbolicExpressionType.RawVector -> box(this.AsRaw().[name]) :?> 'a
            | _ -> invalidOp "Unsupported operation on R object"

        /// Get the value from an indexed vector by index.
        member this.ValueAt<'a>(index: int) = this.AsVector().[index] :?> 'a

        /// Get the first value of a vector.
        member this.First<'a>() = this.ValueAt<'a>(0)

        /// Try and get the first value of a vector, returning
        /// `None` if the `SymbolicExpression` is not a vector
        /// or an empty vector.
        member this.TryFirst<'a>() = if this.IsVector() then this.ValueAt<'a>(0) |> Some else None


    /// Contains functions to make working with SymbolicExpression
    /// more idiomatic.
    [<RequireQualifiedAccess>]
    module SymbolicExpression =

        /// <summary> For an S4 object, get a dictionary containing first the
        /// slot name and second the slot's R type. If the expression
        /// is not an S4 object, returns `None`.</summary>
        /// <param name="expr">An R symbolic expression</param>
        /// <returns>A diictionary with key = slot name, and value = R type</returns>
        let trySlots (expr:SymbolicExpression) =
            match expr.Type with
            | Internals.SymbolicExpressionType.S4 -> expr.AsS4().GetSlotTypes() |> Some
            | _ -> None

        /// <summary> For an S4 object, get a dictionary containing first the
        /// slot name and second the slot's R type.</summary>
        /// <param name="expr">An R symbolic expression</param>
        /// <returns>A diictionary with key = slot name, and value = R type</returns>
        let slots (expr:SymbolicExpression) =
            match expr.Type with
            | Internals.SymbolicExpressionType.S4 -> expr.AsS4().GetSlotTypes()
            | _ -> invalidOp "Can only get slots for an S4 object (R type)"

        /// <summary>Gets the value of a slot as a SymbolicExpression</summary>
        /// <param name="name">Slot name to retrieve</param>
        /// <param name="expr">An R symbolic expression</param>
        /// <returns>Some symbolic expression if the expression was an S4
        /// object and had the slot, or None otherwise.</returns>
        let trySlot name (expr:SymbolicExpression) = 
            match expr.Type with
            | Internals.SymbolicExpressionType.S4 -> expr.AsS4().[name] |> Some
            | _ -> None

        /// <summary>Gets the value of a slot as a SymbolicExpression</summary>
        /// <param name="name">Slot name to retrieve</param>
        /// <param name="expr">An R symbolic expression</param>
        /// <returns>A symbolic expression containing the slot value</returns>
        let slot name (expr:SymbolicExpression) = 
            match expr.Type with
            | Internals.SymbolicExpressionType.S4 -> expr.AsS4().[name]
            | _ -> invalidOp "Can only get slot for an S4 object (R type)"

        /// <summary>Get the data from a column in an R dataframe
        /// by its name.</summary>
        /// <param name="name">The column name</param>
        /// <param name="expr">An R symbolic expression</param>
        /// <returns>A vector containing the data</returns>
        let column (name:string) (expr:SymbolicExpression) =
            if expr.IsDataFrame()
            then expr.AsDataFrame().[name] :> SymbolicExpression
            else invalidOp "The expression is not an R data frame."


/// [omit]
module RInterop =
    type RValue =
        | Function of RParameter list * HasVarArgs
        | Value

    /// Turn an `RValue` (which captures type information of a value or function)
    /// into a serialized string that can be spliced in a quotation
    let serializeRValue =
        function
        | RValue.Value -> ""
        | RValue.Function (pars, hasVar) ->
            let prefix = if hasVar then "1" else "0"
            prefix + if List.isEmpty pars then "" else ";" + (String.concat ";" pars)

    /// Given a string produced by `serializeRValue`, reconstruct the original RValue object
    let deserializeRValue serialized =
        if isNull serialized then
            invalidArg "serialized" "Unexpected null string"
        elif serialized = "" then
            RValue.Value
        else
            let hasVar =
                match serialized.[0] with
                | '1' -> true
                | '0' -> false
                | _ -> invalidArg "serialized" "Should start with a flag"

            let args = if serialized.Length = 1 then [] else List.ofSeq (serialized.Substring(2).Split(';'))
            RValue.Function(args, hasVar)

    let makeSafeName (name: string) = name.Replace("_", "__").Replace(".", "_")

    let internal bindingInfo (name: string) : RValue =
        Logging.logf "Getting bindingInfo: %s" name

        match eval("typeof(get(\"" + name + "\"))").GetValue() with
        | "closure" ->
            let argList =
                try
                    match eval("names(formals(\"" + name + "\"))").GetValue<string []>() with
                    | null -> []
                    | args -> List.ofArray args
                with
                | e -> []

            let hasVarArgs = argList |> List.exists (fun p -> p = "...")
            let argList = argList |> List.filter (fun p -> p <> "...")
            RValue.Function(argList, hasVarArgs)
        | "builtin"
        | "special" ->
            // Don't know how to reflect on builtin or special args so just do as varargs
            RValue.Function([], true)
        | "double"
        | "character"
        | "list"
        | "logical" -> RValue.Value
        | something ->
            Logging.logf "Ignoring name %s of type %s" name something
            RValue.Value

    let getPackages () : string [] =
        Logging.logf "Communicating with R to get packages"
        let res = eval(".packages(all.available=T)").GetValue()
        Logging.logf "Result: %O" res
        res

    let getPackageDescription packageName : string =
        eval("packageDescription(\"" + packageName + "\")$Description").GetValue()

    let getFunctionDescriptions packageName =
        exec <| sprintf """rds = readRDS(system.file("Meta", "Rd.rds", package = "%s"))""" packageName
        Array.zip ((eval "rds$Name").GetValue<string []>()) ((eval "rds$Title").GetValue<string []>())

    let private packages = System.Collections.Generic.HashSet<string>()

    let loadPackage packageName : unit =
        if not (packages.Contains packageName) then
            if not (eval("require(" + packageName + ")").GetValue()) then
                failwithf "Loading package %s failed" packageName

            packages.Add packageName |> ignore

    [<Literal>]
    let internal GetBindingsDefn =
        """function (pkgName) {
    require(pkgName, character.only=TRUE)
    pkgListing <- ls(paste("package:",pkgName,sep=""))
    lapply(
        pkgListing,
        function (pname) {
            pval <- get(pname)
            ptype <- typeof(pval)
            if (ptype == "closure") {
                list(name=pname, type=ptype, params=list(names(formals(pname))))
            } else {
                list(name=pname, type=ptype, params=NA)
            }
        }
    )
}"""

    let internal getBindingsFromR =
        lazy
            (let symbolName = getNextSymbolName ()
             evalTo (GetBindingsDefn.Replace("\r", "")) symbolName
             fun (packageName) -> eval (sprintf "%s('%s')" symbolName packageName))

    let internal bindingInfoFromR (bindingEntry: GenericVector) =
        let entryList = bindingEntry.AsList()
        let name = entryList.[0].AsCharacter().[0]
        let ``type`` = entryList.[1].AsCharacter().[0]

        let value =
            match ``type`` with
            | "closure" ->
                let argList =
                    let paramsAsEntry = entryList.[2]
                    let paramsAsList = paramsAsEntry.AsList()
                    let paramsAsCharacter = paramsAsList.AsCharacter()
                    let paramsValue = paramsAsCharacter.[0]

                    match paramsValue with
                    | v when v.StartsWith("c(") ->
                        [ for arg in v.Split([| "c("; ", "; ")" |], StringSplitOptions.RemoveEmptyEntries) do
                              yield arg.Substring(1, arg.Length - 2) ]
                    | v -> List.ofArray [| v |]
                    | null -> []

                let hasVarArgs = argList |> List.exists (fun p -> p = "...")
                RValue.Function(argList, hasVarArgs)
            | "builtin"
            | "special" -> RValue.Function([], true)
            | "double"
            | "character"
            | "list"
            | "logical" -> RValue.Value
            | something ->
                Logging.logf "Ignoring name %s of type %s" name something
                RValue.Value

        name, serializeRValue value

    let getBindings packageName =
        // TODO: Maybe get these from the environments?
        let bindings = getBindingsFromR.Value packageName
        [| for entry in bindings.AsList() -> entry.AsList() |] |> Array.map bindingInfoFromR

    let callFunc
        (packageName: string)
        (funcName: string)
        (argsByName: seq<KeyValuePair<string, obj>>)
        (varArgs: obj [])
        : SymbolicExpression =
        // We make sure we keep a reference to any temporary symbols until after exec is called,
        // so that the binding is kept alive in R
        // TODO: We need to figure out how to unset the symvol
        let tempSymbols = System.Collections.Generic.List<string * SymbolicExpression>()

        let passArg (arg: obj) : string =
            match arg with
            | :? Missing -> failwithf "Cannot pass Missing value"
            | :? int
            | :? double -> Convert.ToString(arg, Globalization.CultureInfo.InvariantCulture)
            //  This doesn't handle escaping so we fall through to using toR
            //| :? string as sval     -> "\"" + sval + "\""
            | :? bool as bval -> if bval then "TRUE" else "FALSE"
            // We allow pairs to be passed, to specify parameter name
            | _ when
                arg.GetType().IsConstructedGenericType && arg.GetType().GetGenericTypeDefinition() = typedefof<_ * _>
                ->
                match FSharpValue.GetTupleFields(arg) with
                | [| name; value |] when name.GetType() = typeof<string> ->
                    let name = name :?> string
                    tempSymbols.Add(name, engine.Value.SetValue(value, name))
                    name
                | _ -> failwithf "Pairs must be string * value"
            | _ ->
                let sym, se = toR arg
                tempSymbols.Add(sym, se)
                sym

        let argList =
            [|
               // Pass the named arguments as name=val pairs
               for kvp in argsByName do
                   if not (isNull kvp.Value || kvp.Value :? Missing) then yield kvp.Key + "=" + passArg kvp.Value

               // Now yield any varargs
               if not <| isNull varArgs then for argVal in varArgs -> passArg argVal |]

        let expr = sprintf "%s::`%s`(%s)" packageName funcName (String.Join(", ", argList))
        eval expr

    let call
        (packageName: string)
        (funcName: string)
        (serializedRVal: string)
        (namedArgs: obj [])
        (varArgs: obj [])
        : SymbolicExpression =
        //loadPackage packageName

        match deserializeRValue serializedRVal with
        | RValue.Function (rparams, hasVarArg) ->
            let argNames = rparams
            let namedArgCount = argNames.Length

            (*            // TODO: Pass this in so it is robust to change
            if namedArgs.Length <> namedArgCount then
                failwithf "Function %s expects %d named arguments and you supplied %d" funcName namedArgCount namedArgs.Length
*)
            let argsByName = seq { for n, v in Seq.zip argNames namedArgs -> KeyValuePair(n, v) }
            callFunc packageName funcName argsByName varArgs

        | RValue.Value ->
            let expr = sprintf "%s::%s" packageName funcName
            eval expr

    /// Convert a value to a value in R.
    /// Generally you shouldn't use this function - it is mainly for testing.
    let toR (value: obj) = RInteropInternal.toR value |> snd

    /// Convert a symbolic expression to some default .NET representation
    let defaultFromR (sexp: SymbolicExpression) = RInteropInternal.defaultConvertFromR sexp

/// [omit]
[<AutoOpen>]
module RDotNetExtensions2 =
    open RInterop

    type RDotNet.SymbolicExpression with
        /// Call the R print function and return output as a string
        member this.Print() : string =
            // Print by capturing the output in a registered character device
            let printUsingDevice print =
                characterDevice.BeginCapture()
                print ()
                characterDevice.EndCapture()

            // Print by redirecting the output to a temp file (on Mono/Mac,
            // using character device hangs the R provider for some reason)
            let printUsingTempFile print =
                let temp = Path.GetTempFileName()

                try
                    let rvalStr = Function([ "file" ], true) |> serializeRValue
                    call "base" "sink" rvalStr [| temp |] [||] |> ignore
                    print ()
                    call "base" "sink" rvalStr [||] [||] |> ignore
                    File.ReadAllText(temp)
                finally
                    File.Delete(temp)

            let capturer = if Configuration.isUnixOrMac () then printUsingTempFile else printUsingDevice

            capturer
                (fun () ->
                    let rvalStr = RInterop.RValue.Function([ "x" ], true) |> RInterop.serializeRValue
                    RInterop.call "base" "print" rvalStr [| this |] [||] |> ignore)

/// Custom operators that make composing and working with
/// R symbolic expressions easier.
module Operators =

    /// Opens a dynamic property of an R symbolic expression.
    /// Supports named lists, S4 objects, and dataframes.
    /// If a dataframe, the column is extracted by name.
    let inline op_Dynamic (expr:SymbolicExpression) (mem:string) =
        try
            match expr.Type with
            | Internals.SymbolicExpressionType.S4 -> 
                if expr.AsS4().HasSlot mem then expr.AsS4().[mem]
                else expr.Engine.NilValue
            | _ -> 
                if expr.IsDataFrame() 
                then SymbolicExpression.column mem expr
                else expr.Member mem
        with 
        | :? System.ArgumentOutOfRangeException -> expr.Engine.NilValue

    /// When calling an R function, use the => operator in a list
    /// to set a parameter: [ "someparam" => 2 ]
    let (=>) (key:string) (value:'a) = (key, box value)


/// The object represents an R environment loaded from RData file.
/// This type is typically used through an `RData` type provider. To
/// get a statically typed R environment for a given file, use
/// `RData<"C:\\myfile.rdata">`.
type REnv(fileName: string) =
    let env = RInterop.callFunc "base" "new.env" [] [||] // R.new_env()
    do RInterop.callFunc "base" "load" (namedParams [ "file", box fileName; "envir", box env ]) [||] |> ignore

    /// Returns the underlying R environment, represented as `SymbolicExpression`
    member x.Environment = env

    /// Get a value from the R environment as `SymbolicExpression`
    /// (This is equivalent to calling `R.get` function)
    member x.Get(name: string) = RInterop.callFunc "base" "get" (namedParams [ "x", box name; "envir", box env ]) [||]

    /// Returns the keys of all values available in the environment
    /// (This is equivalent to calling `R.ls` function)
    member x.Keys =
        let ls = RInterop.callFunc "base" "ls" (namedParams [ "envir", box env ]) [||]
        ls.GetValue<string []>()