Allow multiple backing types

src/VectorProvider/Implementation.fs

@@ -0,0 +1,107 @@
+namespace VectorProvider
+
+/// Base logic for creating the provider with the specifics of backing type abstracted away
+module Implementation =
+  open FSharp.Quotations
+  open ProviderImplementation.ProvidedTypes
+
+  /// A function that can be used as the invokeCode of a method
+  type Invocation = list<Expr> -> Expr
+
+  /// A set of invocations that can be used to create an implementation of the provider
+  type InvocationImplementations =
+    { originCtor      : Invocation
+      pointCtor       : Invocation
+      dimPropGet      : uint -> Invocation
+      dimPropSet      : uint -> Invocation
+      negateFunc      : Invocation
+      additionFunc    : Invocation
+      subtractionFunc : Invocation }
+
+  module private Helpers =
+
+    let private originCtor invokeCode (typ: ProvidedTypeDefinition) (dim: uint) =
+      let ctor = ProvidedConstructor(parameters = [], invokeCode = invokeCode)
+      do
+        ctor.AddXmlDoc "Creates a vector pointing to the origin"
+        typ.AddMember ctor
+
+    let private pointCtor invokeCode (typ: ProvidedTypeDefinition) (dim: uint) =
+      let ctor =
+        ProvidedConstructor(
+          parameters = [ for i in 1u .. dim -> ProvidedParameter($"Dimension{i}", typeof<int>) ],
+          invokeCode = invokeCode )
+      do
+        ctor.AddXmlDoc "Creates a vector with the given components"
+        typ.AddMember ctor
+
+    let private dimProp getterCode setterCode (typ: ProvidedTypeDefinition) (dim: uint) =
+      let prop =
+        ProvidedProperty(
+          propertyName = $"Dimension{dim + 1u}",
+          propertyType = typeof<int>,
+          getterCode = getterCode,
+          setterCode = setterCode )
+      do
+        prop.AddXmlDoc $"The dimension {dim + 1u} component of the vector"
+        typ.AddMember prop
+
+    let private negationFunction invokeCode (typ: ProvidedTypeDefinition) (dim: uint) =
+      let method =
+        ProvidedMethod(
+          methodName = "Negate",
+          parameters = [ ProvidedParameter("vec", typ.AsType()) ],
+          returnType = typ.AsType(),
+          invokeCode = invokeCode,
+          isStatic = true )
+      do
+        method.AddXmlDoc "Negates the given vector"
+        typ.AddMember method
+
+    let private additionFunction invokeCode (typ: ProvidedTypeDefinition) (dim: uint) =
+      let method =
+        ProvidedMethod(
+          methodName = "Add",
+          parameters =
+            [ ProvidedParameter("vec1", typ.AsType())
+              ProvidedParameter("vec2", typ.AsType()) ],
+          returnType = typ.AsType(),
+          invokeCode = invokeCode,
+          isStatic = true )
+      do
+        method.AddXmlDoc "Adds the given vectors"
+        typ.AddMember method
+
+    let private subtractionFunction invokeCode (typ: ProvidedTypeDefinition) (dim: uint) =
+      let method =
+        ProvidedMethod(
+          methodName = "Subtract",
+          parameters =
+            [ ProvidedParameter("vec1", typ.AsType())
+              ProvidedParameter("vec2", typ.AsType()) ],
+          returnType = typ.AsType(),
+          invokeCode = invokeCode,
+          isStatic = true )
+      do
+        method.AddXmlDoc "Subtracts the given vectors"
+        typ.AddMember method
+
+    /// Creates the constructors and dimension properties based on the given invocation code
+    let generalMembers (invocations: InvocationImplementations) typ dim =
+      originCtor invocations.originCtor typ dim
+      pointCtor invocations.pointCtor typ dim
+      [ 0u .. dim - 1u ]
+      |> List.iter (fun i -> dimProp (invocations.dimPropGet i) (invocations.dimPropSet i) typ i)
+
+    /// Creates the arithmetic functions based on the given invocation code
+    let arithmeticMembers (invocation: InvocationImplementations) typ dim =
+      negationFunction invocation.negateFunc typ dim
+      additionFunction invocation.additionFunc typ dim
+      subtractionFunction invocation.subtractionFunc typ dim
+
+  /// Given the base type specific logic, generates a ProvidedTypeDefinition with the specified backing type and logic
+  let createTypeDefinition (invocations: InvocationImplementations) (baseType: option<System.Type>) asm ns typeName dim =
+    let typ = ProvidedTypeDefinition(asm, ns, typeName, baseType)
+    Helpers.generalMembers invocations typ dim
+    Helpers.arithmeticMembers invocations typ dim
+    typ

src/VectorProvider/IntArray.fs

@@ -0,0 +1,49 @@
+namespace VectorProvider
+
+/// Logic for the specifics of the provider using the `array<int>` backing type
+module IntArray =
+  open FSharp.Quotations
+  open Implementation
+
+  module private Helpers =
+
+    let originCtor maxDim _ =
+      List.init (int maxDim) (fun _ -> <@@ 0 @@>)
+      |> fun x -> Expr.NewArray(typeof<int>, x)
+
+    let pointCtor maxDim (args: list<Expr>) =
+      List.init (int maxDim) (fun i -> <@@ %%(args[i]):int @@>)
+      |> fun x -> Expr.NewArray(typeof<int>, x)
+
+    let dimPropGet maxDim thisDim (args: list<Expr>) =
+      <@@ (%%(args[0]):array<int>)[int thisDim] @@>
+
+    let dimPropSet maxDim thisDim (args: list<Expr>) =
+      <@@ (%%(args[0]):array<int>)[int thisDim] <- (%%(args[1]):int) @@>
+
+    let negateFunc maxDim (args: list<Expr>) =
+      List.init (int maxDim) (fun i -> <@@ -(((%%args[0]):array<int>)[int i]) @@>)
+      |> fun x -> Expr.NewArray(typeof<int>, x)
+
+    let additionFunc maxDim (args: list<Expr>) =
+      List.init (int maxDim) (fun i -> <@@ ((%%args[0]):array<int>)[int i] + ((%%args[1]):array<int>)[int i] @@>)
+      |> fun x -> Expr.NewArray(typeof<int>, x)
+
+    let subtractionFunc maxDim (args: list<Expr>) =
+      List.init (int maxDim) (fun i -> <@@ ((%%args[0]):array<int>)[int i] - ((%%args[1]):array<int>)[int i] @@>)
+      |> fun x -> Expr.NewArray(typeof<int>, x)
+
+  open Helpers
+
+  /// Creates a ProvidedTypeDefinition with the specified name and dimensionality
+  let createTypeDefinition asm ns typeName dim =
+    let baseType = Some typeof<array<int>>
+    let invocations =
+      { originCtor      = originCtor dim
+        pointCtor       = pointCtor dim
+        dimPropGet      = dimPropGet dim
+        dimPropSet      = dimPropSet dim
+        negateFunc      = negateFunc dim
+        additionFunc    = additionFunc dim
+        subtractionFunc = subtractionFunc dim }
+    createTypeDefinition invocations baseType asm ns typeName dim

src/VectorProvider/MathNetVector.fs

@@ -0,0 +1,49 @@
+namespace VectorProvider
+
+module MathNetVector =
+  open FSharp.Quotations
+  open ProviderImplementation.ProvidedTypes
+  open MathNet.Numerics.LinearAlgebra
+
+  module private GeneralHelpers =
+
+    let createOriginCtor (typ: ProvidedTypeDefinition) (dim: uint) =
+      let invocation =
+        <@@ Vector<int>.Build.Dense(int dim) @@>
+      let ctor = ProvidedConstructor (parameters = [], invokeCode = fun _ -> invocation)
+      do
+        ctor.AddXmlDoc "Creates a vector pointing to the origin"
+        typ.AddMember ctor
+
+    let createPointCtor (typ: ProvidedTypeDefinition) (dim: uint) =
+      let invocation (args: list<Expr>) =
+        List.init (int dim) (fun i -> <@@ %%(args[i]): int @@>)
+        |> fun x -> Expr.NewArray(typeof<int>, x)
+        |> fun x -> <@@ Vector<int>.Build.DenseOfArray(%%x) @@>
+      let ctor =
+        ProvidedConstructor (
+          parameters = [ for i in 1u .. dim -> ProvidedParameter ($"Dimension{i}", typeof<int>) ],
+          invokeCode = invocation )
+      do
+        ctor.AddXmlDoc "Creates a vector with the given components"
+        typ.AddMember ctor
+
+  module private ArithematicHelpers =
+    let x = 0
+
+  open GeneralHelpers
+  open ArithematicHelpers
+
+  let private createCtors typ dim = ()
+
+  let private createDimensionProperties typ dim = ()
+
+  let private createArithmeticMethods typ dim = ()
+
+  let createTypeDefinition asm ns typeName dim =
+    let typ = ProvidedTypeDefinition (asm, ns, typeName, Some typeof<Vector<int>>)
+    do
+      createCtors typ dim
+      createDimensionProperties typ dim
+      createArithmeticMethods typ dim
+    typ

src/VectorProvider/VectorProvider.fs

@@ -3,28 +3,30 @@ namespace VectorProvider
 open FSharp.Core.CompilerServices
 open ProviderImplementation.ProvidedTypes
 
+/// Choice of backing type used by the provider. This determines what type the vector is erased to at runtime
+[<RequireQualifiedAccess>]
+type BackingType =
+  | IntArray = 1
+
 [<TypeProvider>]
 type VectorProvider(config) as this =
   inherit TypeProviderForNamespaces(config)
 
   let asm = System.Reflection.Assembly.GetExecutingAssembly()
   let ns = "VectorProvider"
-  let baseType = Some typeof<array<int>>
-  let staticParams = [ ProvidedStaticParameter ("dimension", typeof<uint>) ]
+  let typeName = "VectorND"
+  let staticParams =
+    [ ProvidedStaticParameter("dimension", typeof<uint>)
+      ProvidedStaticParameter("backingType", typeof<BackingType>, Some BackingType.IntArray) ]
 
-  let vecType = ProvidedTypeDefinition (asm, ns, "Vector", baseType)
+  let vecType = ProvidedTypeDefinition (asm, ns, typeName, None)
 
   do
     vecType.DefineStaticParameters (
       staticParams,
       fun typeName -> function
-        | [| :? uint as dim |] ->
-            let typ = ProvidedTypeDefinition (asm, ns, typeName, baseType)
-            do
-              GeneralUtils.createCtors typ dim
-              GeneralUtils.createDimensionProperties typ dim
-              ArithmeticUtils.createArithmeticMethods typ dim
-            typ
+        | [| :? uint as dim; :? int as bt |] when bt = int BackingType.IntArray ->
+            IntArray.createTypeDefinition asm ns typeName dim
         | _ -> failwith "Invalid static parameters" )
 
   do this.AddNamespace (ns, [vecType])

src/VectorProvider/VectorProvider.fsproj

@@ -6,9 +6,13 @@
   <ItemGroup>
     <Compile Include="ProvidedTypes.fsi" />
     <Compile Include="ProvidedTypes.fs" />
-    <Compile Include="GeneralUtils.fs" />
-    <Compile Include="ArithmeticUtils.fs" />
+    <Compile Include="Implementation.fs" />
+    <Compile Include="IntArray.fs" />
+    <Compile Include="MathNetVector.fs" />
     <Compile Include="VectorProvider.fs" />
     <Compile Include="VectorOperators.fs" />
   </ItemGroup>
+  <ItemGroup>
+    <PackageReference Include="MathNet.Numerics" Version="5.0.0" />
+  </ItemGroup>
 </Project>