Merge pull request #6 from KevinRansom/dsyme-tuple-spike

Dsyme tuple spike

src/absil/il.fs

@@ -1987,7 +1987,7 @@ let mkILFieldRef(tref,nm,ty) = { EnclosingTypeRef=tref; Name=nm; Type=ty}
 let mkILFieldSpec (tref,ty) = { FieldRef= tref; EnclosingType=ty }
 
 let mkILFieldSpecInTy (typ:ILType,nm,fty) = 
-  mkILFieldSpec (mkILFieldRef (typ.TypeRef,nm,fty), typ)
+    mkILFieldSpec (mkILFieldRef (typ.TypeRef,nm,fty), typ)
 
 let emptyILCustomAttrs = ILAttributes (fun () -> [| |])
 

src/fsharp/CompileOps.fs

@@ -1618,7 +1618,8 @@ let DefaultBasicReferencesForOutOfProjectSources =
       yield "System.Runtime.Serialization.Formatters.Soap"
       yield "System.Data"
       yield "System.Drawing"
-
+      yield "System.ValueTuple"
+
       // Don't reference System.Core for .NET 2.0 compilations.
       //
       // We only use a default reference to System.Core if one exists which we can load it into the compiler process.
@@ -1660,6 +1661,7 @@ let SystemAssemblies primaryAssemblyName =
       yield "System.Runtime"
       yield "System.Observable"
       yield "System.Numerics"
+      yield "System.ValueTuple"
 
       // Additions for coreclr and portable profiles
       yield "System.Collections"

src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj

@@ -528,7 +528,7 @@
     <Reference Include="Microsoft.DiaSymReader"><HintPath>..\..\..\packages\Microsoft.DiaSymReader.1.0.8\lib\portable-net45+win8\Microsoft.DiaSymReader.dll</HintPath></Reference>
     <Reference Include="System.Reflection.Metadata"><HintPath>..\..\..\packages\System.Reflection.Metadata.1.4.1-beta-24227-04\lib\portable-net45+win8\System.Reflection.Metadata.dll</HintPath></Reference>
     <Reference Include="System.Collections.Immutable"><HintPath>..\..\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81</HintPath></Reference>
-    <Reference Include="System.ValueTuple"><HintPath>..\..\..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1</HintPath></Reference>
+    <Reference Include="System.ValueTuple"><HintPath>..\..\..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1</HintPath><Private>false</Private></Reference>
   </ItemGroup>
   <ItemGroup>
     <ProjectReference Include="$(FSharpSourcesRoot)\fsharp\FSharp.Core\FSharp.Core.fsproj">
@@ -539,7 +539,6 @@
   <Import Project="$(FSharpSourcesRoot)\.nuget\NuGet.targets" Condition="Exists('$(FSharpSourcesRoot)\.nuget\NuGet.targets')" />
   <Import Project="$(FSharpSourcesRoot)\FSharpSource.targets" />
   <Import Project="$(FSharpSourcesRoot)\..\lkg\FSharp-$(LkgVersion)\bin\FSharp.PowerPack.targets" />
-
   <Target Name="GatherBinariesToBeSigned" AfterTargets="Localize">
     <ItemGroup>
       <BinariesToBeSigned Include="$(OutDir)$(AssemblyName).dll" />

src/fsharp/FSharp.Core/reflect.fs

@@ -396,7 +396,7 @@ module internal Impl =
     let mutable systemValueTupleException = null
 
     let reflectedValueTuple n =
-        try
+        try        
 #if FX_ASSEMBLYLOADBYSTRING
             let a = Assembly.Load("System.ValueTuple")
 #else
@@ -522,7 +522,7 @@ module internal Impl =
           let tysA = tyargs.[0..tupleEncField-1]
           let tyB = tyargs.[tupleEncField]
           Array.append tysA (getTupleTypeInfo tyB)
-      else 
+      else
           tyargs
 
     let orderTupleProperties (props:PropertyInfo[]) =
@@ -548,34 +548,73 @@ module internal Impl =
                haveNames = expectNames)
 #endif               
         props
-
+
+    let orderTupleFields (fields:FieldInfo[]) =
+        // The tuple fields are of the form:
+        //   Item1
+        //   ..
+        //   Item1, Item2, ..., Item<maxTuple-1>
+        //   Item1, Item2, ..., Item<maxTuple-1>, Rest
+        // The PropertyInfo may not come back in order, so ensure ordering here.
+#if FX_ATLEAST_PORTABLE
+#else
+        assert(maxTuple < 10) // Alphasort will only works for upto 9 items: Item1, Item10, Item2, Item3, ..., Item9, Rest
+#endif
+        let fields = fields |> Array.sortBy (fun fi -> fi.Name) // they are not always in alphabetic order
+#if FX_ATLEAST_PORTABLE  
+#else      
+        assert(fields.Length <= maxTuple)
+        assert(let haveNames   = fields |> Array.map (fun fi -> fi.Name)
+               let expectNames = Array.init fields.Length (fun i -> let j = i+1 // index j = 1,2,..,fields.Length <= maxTuple
+                                                                    if   j<maxTuple then "Item" + string j
+                                                                    elif j=maxTuple then "Rest"
+                                                                    else (assert false; "")) // dead code under prior assert, props.Length <= maxTuple
+               haveNames = expectNames)
+#endif
+        fields
+
     let getTupleConstructorMethod(typ:Type,bindingFlags) =
-          let props = typ.GetProperties() |> orderTupleProperties
+        let ctor =
+            if typ.IsValueType then
+                let fields = typ.GetFields() |> orderTupleFields
 #if FX_ATLEAST_PORTABLE
-          let ctor = typ.GetConstructor(props |> Array.map (fun p -> p.PropertyType))
-          ignore bindingFlags
-#else          
-          let ctor = typ.GetConstructor(BindingFlags.Instance ||| bindingFlags,null,props |> Array.map (fun p -> p.PropertyType),null)
-#endif          
-          match ctor with
-          | null -> raise <| ArgumentException(SR.GetString1(SR.invalidTupleTypeConstructorNotDefined, typ.FullName))
-          | _ -> ()
-          ctor
-
+                ignore bindingFlags
+                typ.GetConstructor(fields |> Array.map (fun fi -> fi.FieldType))
+#else
+                typ.GetConstructor(BindingFlags.Instance ||| bindingFlags,null,fields |> Array.map (fun fi -> fi.FieldType),null)
+#endif
+            else
+                let props = typ.GetProperties() |> orderTupleProperties
+#if FX_ATLEAST_PORTABLE
+                ignore bindingFlags
+                typ.GetConstructor(props |> Array.map (fun p -> p.PropertyType))
+#else
+                typ.GetConstructor(BindingFlags.Instance ||| bindingFlags,null,props |> Array.map (fun p -> p.PropertyType),null)
+#endif
+        match ctor with
+        | null -> raise <| ArgumentException(SR.GetString1(SR.invalidTupleTypeConstructorNotDefined, typ.FullName))
+        | _ -> ()
+        ctor
+
     let getTupleCtor(typ:Type,bindingFlags) =
           let ctor = getTupleConstructorMethod(typ,bindingFlags)
           (fun (args:obj[]) ->
 #if FX_ATLEAST_PORTABLE   
               ctor.Invoke(args))
 #else
               ctor.Invoke(BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| bindingFlags,null,args,null))
-#endif              
+#endif
 
     let rec getTupleReader (typ:Type) = 
         let etys = typ.GetGenericArguments() 
         // Get the reader for the outer tuple record
-        let props = typ.GetProperties(instancePropertyFlags ||| BindingFlags.Public) |> orderTupleProperties
-        let reader = (fun (obj:obj) -> props |> Array.map (fun prop -> prop.GetValue(obj,null)))
+        let reader =
+            if typ.IsValueType then
+                let fields = (typ.GetFields(instancePropertyFlags ||| BindingFlags.Public) |> orderTupleFields)
+                ((fun (obj:obj) -> fields |> Array.map (fun field -> field.GetValue(obj))))
+            else
+                let props = (typ.GetProperties(instancePropertyFlags ||| BindingFlags.Public) |> orderTupleProperties)
+                ((fun (obj:obj) -> props |> Array.map (fun prop -> prop.GetValue(obj,null))))
         if etys.Length < maxTuple 
         then reader
         else
@@ -585,7 +624,7 @@ module internal Impl =
                 let directVals = reader obj
                 let encVals = reader2 directVals.[tupleEncField]
                 Array.append directVals.[0..tupleEncField-1] encVals)
-                
+
     let rec getTupleConstructor (typ:Type) = 
         let etys = typ.GetGenericArguments() 
         let maker1 =  getTupleCtor (typ,BindingFlags.Public)
@@ -606,20 +645,25 @@ module internal Impl =
         else
             maker1,Some(etys.[tupleEncField])
 
-    let getTupleReaderInfo (typ:Type,index:int) =         
+    let getTupleReaderInfo (typ:Type,index:int) =
         if index < 0 then invalidArg "index" (SR.GetString2(SR.tupleIndexOutOfRange, typ.FullName, index.ToString()))
-        let props = typ.GetProperties(instancePropertyFlags ||| BindingFlags.Public) |> orderTupleProperties
-        let get index = 
-            if index >= props.Length then invalidArg "index" (SR.GetString2(SR.tupleIndexOutOfRange, typ.FullName, index.ToString()))
-            props.[index]
-
+
+        let get index =
+            if typ.IsValueType then
+                let props = typ.GetProperties(instancePropertyFlags ||| BindingFlags.Public) |> orderTupleProperties
+                if index >= props.Length then invalidArg "index" (SR.GetString2(SR.tupleIndexOutOfRange, typ.FullName, index.ToString()))
+                props.[index]
+            else
+                let props = typ.GetProperties(instancePropertyFlags ||| BindingFlags.Public) |> orderTupleProperties
+                if index >= props.Length then invalidArg "index" (SR.GetString2(SR.tupleIndexOutOfRange, typ.FullName, index.ToString()))
+                props.[index]
+
         if index < tupleEncField then
-            get index, None  
+            get index, None
         else
             let etys = typ.GetGenericArguments()
             get tupleEncField, Some(etys.[tupleEncField],index-(maxTuple-1))
-
-
+
     //-----------------------------------------------------------------
     // FUNCTION DECOMPILATION
 

src/fsharp/IlxGen.fs

@@ -390,7 +390,7 @@ let rec GenTypeArgAux amap m g tyenv tyarg =
 and GenTypeArgsAux amap m g tyenv  tyargs = 
     List.map (GenTypeArgAux amap m g tyenv) (DropErasedTyargs tyargs)
 
-and GenTyAppAux amap m g tyenv repr tinst =  
+and GenTyAppAux amap m g tyenv repr tinst =
     match repr with  
     | CompiledTypeRepr.ILAsmOpen ty -> 
         let ilTypeInst = GenTypeArgsAux amap m g tyenv tinst
@@ -403,7 +403,7 @@ and GenTyAppAux amap m g tyenv repr tinst =
             mkILTy boxity (mkILTySpec (tref,ilTypeInst))
         | Some ilType -> 
             ilType // monomorphic types include a cached ilType to avoid reallocation of an ILType node
-          
+
 
 and GenNamedTyAppAux (amap:Import.ImportMap) m g tyenv ptrsOK tcref tinst = 
     let tinst = DropErasedTyargs tinst 
@@ -2026,7 +2026,6 @@ and GenGetTupleField cenv cgbuf eenv (tupInfo,e,tys,n,m) sequel =
                 getCompiledTupleItem g (elast,tysB,n-goodTupleFields,m)
     GenExpr cenv cgbuf eenv SPSuppress (getCompiledTupleItem cenv.g (e,tys,n,m)) sequel
 
-
 and GenAllocExn cenv cgbuf eenv (c,args,m) sequel =
     GenExprs cenv cgbuf eenv args
     let typ = GenExnType cenv.amap m cenv.g eenv.tyenv c

src/fsharp/TastOps.fs

@@ -624,7 +624,7 @@ let reduceTyconMeasureableOrProvided g (tycon:Tycon) tyargs =
     | TProvidedTypeExtensionPoint info when info.IsErased -> info.BaseTypeForErased (range0, g.obj_ty)
 #endif
     | _ -> invalidArg "tc" "this type definition is not a refinement" 
-    
+
 let reduceTyconRefMeasureableOrProvided (g:TcGlobals) (tcref:TyconRef) tyargs = 
     reduceTyconMeasureableOrProvided g tcref.Deref tyargs
 
@@ -7834,10 +7834,6 @@ let mkGetTupleItemN g m n (typ:ILType) isStruct te retty =
         mkAsmExpr([mkNormalLdfld  (mkILFieldSpecForTupleItem typ n)   ],[],[te],[retty],m)
     else
         mkAsmExpr([IL.mkNormalCall(mkILMethodSpecForTupleItem g typ n)],[],[te],[retty],m)
-
-//  let mkGetTupleItemN g m n typ te retty =
-//    mkAsmExpr([IL.mkNormalCall(mkILMethodSpecForTupleItem g typ n)],[],[te],[retty],m)
-
 /// Match an Int32 constant expression
 let (|Int32Expr|_|) expr = 
     match expr with 

src/fsharp/tast.fs

@@ -952,7 +952,7 @@ type Entity =
                     let ilTypeOpt = 
                         match x.TyparsNoRange with 
                         | [] -> Some (mkILTy boxity (mkILTySpec (ilTypeRef,[]))) 
-                        | _ -> None 
+                        | _  -> None
                     CompiledTypeRepr.ILAsmNamed (ilTypeRef, boxity, ilTypeOpt))
 
     /// Gets the data indicating the compiled representation of a named type or module in terms of Abstract IL data structures.