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.

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

Merge master to release/dev16.8 #9763

Merged
merged 3 commits into from
Jul 24, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
84 changes: 67 additions & 17 deletions src/fsharp/CompileOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2086,6 +2086,61 @@ type CcuLoadFailureAction =
| RaiseError
| ReturnNone

type LType =
| Resolution
| RestoreSource

type LStatus =
| Unprocessed
| Processed

type PackageManagerLine =
{ LineType: LType
LineStatus: LStatus
Line: string
Range: range }

static member AddLineWithKey (packageKey: string) (lt:LType) (line: string) (m: range) (packageManagerLines: Map<string, PackageManagerLine list>): Map<string, PackageManagerLine list> =
let path = PackageManagerLine.StripDependencyManagerKey packageKey line
let map =
let mutable found = false
let result =
packageManagerLines
|> Map.map(fun key lines ->
if key = packageKey then
found <- true
lines |> List.append [{LineType=lt; LineStatus=LStatus.Unprocessed; Line=path; Range=m}]
else
lines)
if found then
result
else
result.Add(packageKey, [{LineType=lt; LineStatus=LStatus.Unprocessed; Line=path; Range=m}])
map

static member RemoveUnprocessedLines (packageKey: string) (packageManagerLines: Map<string, PackageManagerLine list>): Map<string, PackageManagerLine list> =
let map =
packageManagerLines
|> Map.map(fun key lines ->
if key = packageKey then
lines |> List.filter(fun line -> line.LineStatus=LStatus.Processed)
else
lines)
map

static member SetLinesAsProcessed (packageKey:string) (packageManagerLines: Map<string, PackageManagerLine list>): Map<string, PackageManagerLine list> =
let map =
packageManagerLines
|> Map.map(fun key lines ->
if key = packageKey then
lines |> List.map(fun line -> {line with LineStatus = LStatus.Processed;})
else
lines)
map

static member StripDependencyManagerKey (packageKey: string) (line: string): string =
line.Substring(packageKey.Length + 1).Trim()

[<NoEquality; NoComparison>]
type TcConfigBuilder =
{ mutable primaryAssembly: PrimaryAssembly
Expand All @@ -2107,7 +2162,7 @@ type TcConfigBuilder =
mutable loadedSources: (range * string * string) list
mutable compilerToolPaths: string list
mutable referencedDLLs: AssemblyReference list
mutable packageManagerLines: Map<string, (bool * string * range) list>
mutable packageManagerLines: Map<string, PackageManagerLine list>
mutable projectReferences: IProjectReference list
mutable knownUnresolvedReferences: UnresolvedAssemblyReference list
reduceMemoryUsage: ReduceMemoryFlag
Expand Down Expand Up @@ -2536,13 +2591,9 @@ type TcConfigBuilder =
elif not (tcConfigB.referencedDLLs |> List.exists (fun ar2 -> Range.equals m ar2.Range && path=ar2.Text)) then // NOTE: We keep same paths if range is different.
let projectReference = tcConfigB.projectReferences |> List.tryPick (fun pr -> if pr.FileName = path then Some pr else None)
tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs ++ AssemblyReference(m, path, projectReference)

member tcConfigB.AddDependencyManagerText (packageManager:IDependencyManagerProvider, m, path:string) =
let path = tcConfigB.dependencyProvider.RemoveDependencyManagerKey(packageManager.Key, path)

match tcConfigB.packageManagerLines |> Map.tryFind packageManager.Key with
| Some lines -> tcConfigB.packageManagerLines <- Map.add packageManager.Key (lines ++ (false, path, m)) tcConfigB.packageManagerLines
| _ -> tcConfigB.packageManagerLines <- Map.add packageManager.Key [false, path, m] tcConfigB.packageManagerLines
member tcConfigB.AddDependencyManagerText (packageManager: IDependencyManagerProvider, lt, m, path: string) =
tcConfigB.packageManagerLines <- PackageManagerLine.AddLineWithKey packageManager.Key lt path m tcConfigB.packageManagerLines

member tcConfigB.RemoveReferencedAssemblyByPath (m, path) =
tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs |> List.filter (fun ar -> not (Range.equals ar.Range m) || ar.Text <> path)
Expand Down Expand Up @@ -5002,7 +5053,7 @@ let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file) =
let ProcessMetaCommandsFromInput
(nowarnF: 'state -> range * string -> 'state,
dllRequireF: 'state -> range * string -> 'state,
packageRequireF: 'state -> IDependencyManagerProvider * range * string -> 'state,
packageRequireF: 'state -> IDependencyManagerProvider * LType * range * string -> 'state,
loadSourceF: 'state -> range * string -> unit)
(tcConfig:TcConfigBuilder, inp, pathOfMetaCommandSource, state0) =

Expand Down Expand Up @@ -5051,7 +5102,7 @@ let ProcessMetaCommandsFromInput
match dm with
| _, dependencyManager when not(isNull dependencyManager) ->
if tcConfig.langVersion.SupportsFeature(LanguageFeature.PackageManagement) then
packageRequireF state (dependencyManager, m, path)
packageRequireF state (dependencyManager, LType.Resolution, m, path)
else
errorR(Error(FSComp.SR.packageManagementRequiresVFive(), m))
state
Expand Down Expand Up @@ -5143,7 +5194,7 @@ let ApplyNoWarnsToTcConfig (tcConfig: TcConfig, inp: ParsedInput, pathOfMetaComm
let tcConfigB = tcConfig.CloneOfOriginalBuilder
let addNoWarn = fun () (m,s) -> tcConfigB.TurnWarningOff(m, s)
let addReferencedAssemblyByPath = fun () (_m,_s) -> ()
let addDependencyManagerText = fun () (_prefix,_m,_s) -> ()
let addDependencyManagerText = fun () (_prefix, _lt, _m, _s) -> ()
let addLoadedSource = fun () (_m,_s) -> ()
ProcessMetaCommandsFromInput (addNoWarn, addReferencedAssemblyByPath, addDependencyManagerText, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ())
TcConfig.Create(tcConfigB, validate=false)
Expand All @@ -5153,7 +5204,7 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig: TcConfig, inp: ParsedInput,
let tcConfigB = tcConfig.CloneOfOriginalBuilder
let getWarningNumber = fun () _ -> ()
let addReferencedAssemblyByPath = fun () (m,s) -> tcConfigB.AddReferencedAssemblyByPath(m,s)
let addDependencyManagerText = fun () (packageManager, m,s) -> tcConfigB.AddDependencyManagerText(packageManager,m,s)
let addDependencyManagerText = fun () (packageManager, lt, m,s) -> tcConfigB.AddDependencyManagerText(packageManager, lt, m, s)
let addLoadedSource = fun () (m,s) -> tcConfigB.AddLoadedSource(m,s,pathOfMetaCommandSource)
ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addDependencyManagerText, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ())
TcConfig.Create(tcConfigB, validate=false)
Expand Down Expand Up @@ -5303,7 +5354,7 @@ module ScriptPreprocessClosure =
let mutable nowarns = []
let getWarningNumber = fun () (m, s) -> nowarns <- (s, m) :: nowarns
let addReferencedAssemblyByPath = fun () (m, s) -> tcConfigB.AddReferencedAssemblyByPath(m, s)
let addDependencyManagerText = fun () (packageManagerPrefix,m,s) -> tcConfigB.AddDependencyManagerText(packageManagerPrefix,m,s)
let addDependencyManagerText = fun () (packageManagerPrefix, lt, m, s) -> tcConfigB.AddDependencyManagerText(packageManagerPrefix, lt, m, s)
let addLoadedSource = fun () (m, s) -> tcConfigB.AddLoadedSource(m, s, pathOfMetaCommandSource)
try
ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addDependencyManagerText, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ())
Expand Down Expand Up @@ -5331,7 +5382,7 @@ module ScriptPreprocessClosure =
let packageManagerKey, packageManagerLines = kv.Key, kv.Value
match packageManagerLines with
| [] -> ()
| (_, _, m)::_ ->
| { LineType=_; LineStatus=_; Line=_; Range=m } :: _ ->
let reportError =
let report errorType err msg =
let error = err, msg
Expand All @@ -5349,8 +5400,7 @@ module ScriptPreprocessClosure =
errorR(Error(tcConfig.dependencyProvider.CreatePackageManagerUnknownError(tcConfig.compilerToolPaths, outputDir, packageManagerKey, reportError), m))

| dependencyManager ->
let inline snd3 (_, b, _) = b
let packageManagerTextLines = packageManagerLines |> List.map snd3
let packageManagerTextLines = packageManagerLines |> List.map(fun l -> l.Line)
let result = tcConfig.dependencyProvider.Resolve(dependencyManager, ".fsx", packageManagerTextLines, reportError, executionTfm, executionRid, tcConfig.implicitIncludeDir, mainFile, scriptName)
match result.Success with
| true ->
Expand All @@ -5359,7 +5409,7 @@ module ScriptPreprocessClosure =
let tcConfigB = tcConfig.CloneOfOriginalBuilder
for folder in result.Roots do
tcConfigB.AddIncludePath(m, folder, "")
tcConfigB.packageManagerLines <- tcConfigB.packageManagerLines |> Map.map(fun _ l -> l |> List.map(fun (_, p, m) -> true, p, m))
tcConfigB.packageManagerLines <- PackageManagerLine.SetLinesAsProcessed packageManagerKey tcConfigB.packageManagerLines
tcConfig <- TcConfig.Create(tcConfigB, validate=false)
for script in result.SourceFiles do
let scriptText = File.ReadAllText script
Expand All @@ -5371,7 +5421,7 @@ module ScriptPreprocessClosure =
// Resolution produced errors update packagerManagerLines entries to note these failure
// failed resolutions will no longer be considered
let tcConfigB = tcConfig.CloneOfOriginalBuilder
tcConfigB.packageManagerLines <- tcConfigB.packageManagerLines |> Map.map(fun _ l -> l |> List.filter(fun (tried, _, _) -> tried))
tcConfigB.packageManagerLines <- PackageManagerLine.RemoveUnprocessedLines packageManagerKey tcConfigB.packageManagerLines
tcConfig <- TcConfig.Create(tcConfigB, validate=false)]
else []

Expand Down
27 changes: 22 additions & 5 deletions src/fsharp/CompileOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -254,6 +254,25 @@ type VersionFlag =
member GetVersionInfo: implicitIncludeDir:string -> ILVersionInfo
member GetVersionString: implicitIncludeDir:string -> string

type LType =
| Resolution
| RestoreSource

type LStatus =
| Unprocessed
| Processed

type PackageManagerLine =
{ LineType: LType
LineStatus: LStatus
Line: string
Range: range }

static member AddLineWithKey: string -> LType -> string -> range -> Map<string, PackageManagerLine list> -> Map<string, PackageManagerLine list>
static member RemoveUnprocessedLines: string -> Map<string, PackageManagerLine list> -> Map<string, PackageManagerLine list>
static member SetLinesAsProcessed: string -> Map<string, PackageManagerLine list> -> Map<string, PackageManagerLine list>
static member StripDependencyManagerKey: string -> string -> string

[<NoEquality; NoComparison>]
type TcConfigBuilder =
{ mutable primaryAssembly: PrimaryAssembly
Expand All @@ -277,8 +296,7 @@ type TcConfigBuilder =
mutable loadedSources: (range * string * string) list
mutable compilerToolPaths: string list
mutable referencedDLLs: AssemblyReference list
mutable packageManagerLines: Map<string, (bool * string * range) list>

mutable packageManagerLines: Map<string, PackageManagerLine list>
mutable projectReferences: IProjectReference list
mutable knownUnresolvedReferences: UnresolvedAssemblyReference list
reduceMemoryUsage: ReduceMemoryFlag
Expand Down Expand Up @@ -396,8 +414,7 @@ type TcConfigBuilder =

mutable langVersion : LanguageVersion

mutable dependencyProvider : DependencyProvider

mutable dependencyProvider: DependencyProvider
}

static member Initial: TcConfigBuilder
Expand Down Expand Up @@ -694,7 +711,7 @@ val RequireDLL: CompilationThreadToken * TcImports * TcEnv * thisAssemblyName: s

/// Processing # commands
val ProcessMetaCommandsFromInput :
(('T -> range * string -> 'T) * ('T -> range * string -> 'T) * ('T -> IDependencyManagerProvider * range * string -> 'T) * ('T -> range * string -> unit))
(('T -> range * string -> 'T) * ('T -> range * string -> 'T) * ('T -> IDependencyManagerProvider * LType * range * string -> 'T) * ('T -> range * string -> unit))
-> TcConfigBuilder * ParsedInput * string * 'T
-> 'T

Expand Down
20 changes: 19 additions & 1 deletion src/fsharp/FSharp.Core/reflect.fs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Primitives.Basics
open System.Linq.Expressions

module internal ReflectionUtils =

Expand Down Expand Up @@ -63,6 +64,19 @@ module internal Impl =
| null -> None
| prop -> Some(fun (obj: obj) -> prop.GetValue (obj, instancePropertyFlags ||| bindingFlags, null, null, null))

let compilePropGetterFunc (prop: PropertyInfo) =
let param = Expression.Parameter (typeof<obj>, "param")

let expr =
Expression.Lambda<Func<obj, obj>> (
Expression.Convert (
Expression.Property (
Expression.Convert (param, prop.DeclaringType),
prop),
typeof<obj>),
param)
expr.Compile ()

//-----------------------------------------------------------------
// ATTRIBUTE DECOMPILATION

Expand Down Expand Up @@ -585,6 +599,10 @@ module internal Impl =
let props = fieldPropsOfRecordType(typ, bindingFlags)
(fun (obj: obj) -> props |> Array.map (fun prop -> prop.GetValue (obj, null)))

let getRecordReaderFromFuncs(typ: Type, bindingFlags) =
let props = fieldPropsOfRecordType(typ, bindingFlags) |> Array.map compilePropGetterFunc
(fun (obj: obj) -> props |> Array.map (fun prop -> prop.Invoke obj))

let getRecordConstructorMethod(typ: Type, bindingFlags) =
let props = fieldPropsOfRecordType(typ, bindingFlags)
let ctor = typ.GetConstructor(BindingFlags.Instance ||| bindingFlags, null, props |> Array.map (fun p -> p.PropertyType), null)
Expand Down Expand Up @@ -806,7 +824,7 @@ type FSharpValue =
static member PreComputeRecordReader(recordType: Type, ?bindingFlags) : (obj -> obj[]) =
let bindingFlags = defaultArg bindingFlags BindingFlags.Public
checkRecordType ("recordType", recordType, bindingFlags)
getRecordReader (recordType, bindingFlags)
getRecordReaderFromFuncs (recordType, bindingFlags)

static member PreComputeRecordConstructor(recordType: Type, ?bindingFlags) =
let bindingFlags = defaultArg bindingFlags BindingFlags.Public
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -359,11 +359,6 @@ type DependencyProvider (assemblyProbingPaths: AssemblyResolutionProbe, nativePr
reportError.Invoke(ErrorReportType.Error, err, msg)
null, Unchecked.defaultof<IDependencyManagerProvider>

/// Remove the dependency mager with the specified key
member _.RemoveDependencyManagerKey(packageManagerKey:string, path:string): string =

path.Substring(packageManagerKey.Length + 1).Trim()

/// Fetch a dependencymanager that supports a specific key
member _.TryFindDependencyManagerByKey (compilerTools: string seq, outputDir: string, reportError: ResolvingErrorReport, key: string): IDependencyManagerProvider =

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -72,9 +72,6 @@ type DependencyProvider =
/// Returns a formatted error message for the host to present
member CreatePackageManagerUnknownError: string seq * string * string * ResolvingErrorReport -> int * string

/// Remove the dependency manager with the specified key
member RemoveDependencyManagerKey: packageManagerKey: string * path: string -> string

/// Resolve reference for a list of package manager lines
member Resolve : packageManager: IDependencyManagerProvider * scriptExt: string * packageManagerTextLines: string seq * reportError: ResolvingErrorReport * executionTfm: string * [<Optional;DefaultParameterValue(null:string)>]executionRid: string * [<Optional;DefaultParameterValue("")>]implicitIncludeDir: string * [<Optional;DefaultParameterValue("")>]mainScriptName: string * [<Optional;DefaultParameterValue("")>]fileName: string -> IResolveDependenciesResult

Expand Down
Loading