Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Dsyme tuple spike #6

Merged
merged 6 commits into from
Jul 19, 2016
Merged

Dsyme tuple spike #6

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
754284f
Teach fsharp that System.ValueTuple is a framework assembly
KevinRansom Jul 7, 2016
09a1135
Update reflect.fs to use fields for ValueTuples
KevinRansom Jul 9, 2016
8efcf96
Attempt to emit field access rather than property access.
KevinRansom Jul 11, 2016
1239cd0
Diagnostic junk
KevinRansom Jul 18, 2016
f03a6b5
merge from dsyme-tuplespike
KevinRansom Jul 18, 2016
6db1b99
Remove printfn tracingdiagnostics
KevinRansom Jul 18, 2016
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion src/fsharp/CompileOps.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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"
Expand Down
3 changes: 1 addition & 2 deletions src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -527,7 +527,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">
Expand All @@ -538,7 +538,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" />
Expand Down
98 changes: 71 additions & 27 deletions src/fsharp/FSharp.Core/reflect.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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[]) =
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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

Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/IlxGen.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2010,15 +2010,15 @@ and GenGetTupleField cenv cgbuf eenv (tupInfo,e,tys,n,m) sequel =
elif ar < maxTuple then
let tcr' = mkCompiledTupleTyconRef g tupInfo tys
let typ = GenNamedTyApp cenv.amap m g eenv.tyenv tcr' tys
mkGetTupleItemN g m n typ e tys.[n]
mkGetTupleItemN g m n typ tupInfo e tys.[n]
else
let tysA,tysB = List.splitAfter (goodTupleFields) tys
let tyB = mkCompiledTupleTy g tupInfo tysB
let tys' = tysA@[tyB]
let tcr' = mkCompiledTupleTyconRef g tupInfo tys'
let typ' = GenNamedTyApp cenv.amap m g eenv.tyenv tcr' tys'
let n' = (min n goodTupleFields)
let elast = mkGetTupleItemN g m n' typ' e tys'.[n']
let elast = mkGetTupleItemN g m n' typ' tupInfo e tys'.[n']
if n < goodTupleFields then
elast
else
Expand Down
12 changes: 9 additions & 3 deletions src/fsharp/TastOps.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -7826,8 +7826,14 @@ let rec mkCompiledTuple g isStruct (argtys,args,m) =
let mkILMethodSpecForTupleItem (_g : TcGlobals) (typ:ILType) n =
mkILNonGenericInstanceMethSpecInTy(typ, (if n < goodTupleFields then "get_Item"+(n+1).ToString() else "get_Rest"), [], mkILTyvarTy (uint16 n))

let mkGetTupleItemN g m n typ te retty =
mkAsmExpr([IL.mkNormalCall(mkILMethodSpecForTupleItem g typ n)],[],[te],[retty],m)
let mkILFieldSpecForTupleItem typ n =
mkILFieldSpecInTy (typ,(if n < goodTupleFields then "Item"+(n+1).ToString() else "Rest"), mkILTyvarTy (uint16 n))

let mkGetTupleItemN g m n (typ:ILType) isStruct te retty =
if isStruct then
mkAsmExpr([mkNormalLdfld (mkILFieldSpecForTupleItem typ n) ],[],[],[retty],m)
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You're not using te (the expression for the object from which you're loading the field) in the first branch

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

te doesn't make a difference.

else
mkAsmExpr([IL.mkNormalCall(mkILMethodSpecForTupleItem g typ n)],[],[te],[retty],m)

/// Match an Int32 constant expression
let (|Int32Expr|_|) expr =
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/TastOps.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -230,7 +230,7 @@ val isCompiledTupleTyconRef : TcGlobals -> TyconRef -> bool
val mkCompiledTupleTyconRef : TcGlobals -> bool -> 'a list -> TyconRef
val mkCompiledTupleTy : TcGlobals -> bool -> TTypes -> TType
val mkCompiledTuple : TcGlobals -> bool -> TTypes * Exprs * range -> TyconRef * TTypes * Exprs * range
val mkGetTupleItemN : TcGlobals -> range -> int -> ILType -> Expr -> TType -> Expr
val mkGetTupleItemN : TcGlobals -> range -> int -> ILType -> bool -> Expr -> TType -> Expr

val evalTupInfoIsStruct : TupInfo -> bool

Expand Down