mono
/
fsharp
зеркало из
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

Merge remote-tracking branch 'upstream/release/dev16.3' into merges/release/dev16.3-to-master

This commit is contained in:
Brett V. Forsgren 2019-09-23 09:25:09 -07:00
Родитель dc5e29435b 0422ff293b
Коммит 7ce0d57b46
283 изменённых файлов: 5136 добавлений и 2442 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

4
.gitignore поставляемый
Просмотреть файл

@ -100,7 +100,9 @@ ossreadme*.txt
*.log
*.jrs
*.chk
*.bak
*.bak
*.vserr
*.err
*.orig
*.mdf
*.ldf

12
DEVGUIDE.md
Просмотреть файл

@ -53,7 +53,17 @@ After you build the first time you can open and use this solution in Visual Stud
If you don't have everything installed yet, you'll get prompted by Visual Studio to install a few more things. This is because we use a `.vsconfig` file that specifies all our dependencies.
## Developing on Windows - No Visual Studio
If you are just developing the core compiler and library then building ``FSharp.sln`` will be enough.
### Developing the F# Compiler (Linux/macOS)
For Linux/Mac:
./build.sh
Running tests:
./build.sh --test
We recommend installing the latest released Visual Studio and using that if you are on Windows. However, if you prefer not to do that, you will need to install the following:

17
FSharp.Profiles.props
Просмотреть файл

@ -11,35 +11,18 @@
<PropertyGroup Condition="$(TargetFramework.StartsWith('netstandard')) OR $(TargetFramework.StartsWith('netcoreapp'))">
<DefineConstants>$(DefineConstants);NETSTANDARD</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_APP_DOMAINS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_ARRAY_LONG_LENGTH</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_BEGINEND_READWRITE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_BINARY_SERIALIZATION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_CONVERTER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_DEFAULT_DEPENDENCY_TYPE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_CORHOST_SIGNER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_EVENTWAITHANDLE_IDISPOSABLE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_EXIT_CONTEXT_FLAGS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_PARAMETERIZED_THREAD_START</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_PDB_READER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_PDB_WRITER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_REFLECTION_MODULE_HANDLES</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_REFLECTION_ONLY</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_RUNTIMEENVIRONMENT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SECURITY_PERMISSIONS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SERVERCODEPAGES</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SYMBOLSTORE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SYSTEM_CONFIGURATION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_THREAD</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_THREADABORT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_WAITONE_MILLISECONDS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_WEB_CLIENT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_WIN_REGISTRY</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_WINFORMS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_INDENTED_TEXT_WRITER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_REDUCED_EXCEPTIONS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_REFEMIT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_GLOBALIZATION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_REFLECTION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_MSBUILD</DefineConstants>
<OtherFlags>$(OtherFlags) --simpleresolution</OtherFlags>
</PropertyGroup>

4
FSharpBuild.Directory.Build.props
Просмотреть файл

@ -94,6 +94,10 @@
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<PropertyGroup Condition="'$(OS)' == 'Unix'">
<DefineConstants>$(DefineConstants);TESTING_ON_LINUX</DefineConstants>
</PropertyGroup>
<!-- SDK targets override -->
<PropertyGroup Condition="'$(Configuration)' != 'Proto' AND '$(DisableCompilerRedirection)'!='true' AND Exists('$(ProtoOutputPath)')">
<FSharpTargetsPath>$(ProtoOutputPath)\fsc\Microsoft.FSharp.Targets</FSharpTargetsPath>

1
FSharpTests.Directory.Build.targets
Просмотреть файл

@ -13,6 +13,7 @@
DisabledWarnings="$(NoWarn)"
DotnetFsiCompilerPath="$(DotnetFsiCompilerPath)"
FsiExec="@(FsiExec)"
LangVersion="$(LangVersion)"
LCID="$(LCID)"
LoadSources="@(LoadSource)"
NoFramework="false"

2
Makefile
Просмотреть файл

@ -29,7 +29,7 @@ restore:
build: proto restore
$(DotNetExe) build-server shutdown
$(DotNetExe) build -c $(Configuration) -f netstandard1.6 src/fsharp/FSharp.Core/FSharp.Core.fsproj
$(DotNetExe) build -c $(Configuration) -f netstandard2.0 src/fsharp/FSharp.Core/FSharp.Core.fsproj
$(DotNetExe) build -c $(Configuration) -f netstandard2.0 src/fsharp/FSharp.Build/FSharp.Build.fsproj
$(DotNetExe) build -c $(Configuration) -f netstandard2.0 src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj
$(DotNetExe) build -c $(Configuration) -f netcoreapp2.1 src/fsharp/fsc/fsc.fsproj

1
eng/Build.ps1
Просмотреть файл

@ -195,6 +195,7 @@ function BuildSolution() {
/p:QuietRestore=$quietRestore `
/p:QuietRestoreBinaryLog=$binaryLog `
/p:TestTargetFrameworks=$testTargetFrameworks `
/v:$verbosity `
$suppressExtensionDeployment `
@properties
}

11
eng/Versions.props
Просмотреть файл

@ -12,25 +12,25 @@
<!-- Version number computation -->
<PropertyGroup>
<PreReleaseVersionLabel>beta</PreReleaseVersionLabel>
<FSLanguageVersion>4.6</FSLanguageVersion>
<FSLanguageVersion>4.7</FSLanguageVersion>
<FSCoreMajorVersion>$(FSLanguageVersion)</FSCoreMajorVersion>
<FSCorePackageVersion>$(FSCoreMajorVersion).3</FSCorePackageVersion>
<FSCorePackageVersion>$(FSCoreMajorVersion).1</FSCorePackageVersion>
<FSCoreVersionPrefix>$(FSCoreMajorVersion).0</FSCoreVersionPrefix>
<FSCoreVersion>$(FSCoreVersionPrefix).0</FSCoreVersion>
<!-- The current published nuget package -->
<FSharpCoreShippedPackageVersion>4.6.2</FSharpCoreShippedPackageVersion>
<FSharpCoreShippedPackageVersion>4.7.0</FSharpCoreShippedPackageVersion>
<!-- The pattern for specifying the preview package -->
<FSharpCorePreviewPackageVersion>$(FSCorePackageVersion)-$(PreReleaseVersionLabel).*</FSharpCorePreviewPackageVersion>
</PropertyGroup>
<PropertyGroup>
<FSPackageMajorVersion>10.5</FSPackageMajorVersion>
<FSPackageMajorVersion>10.6</FSPackageMajorVersion>
<FSPackageVersion>$(FSPackageMajorVersion).0</FSPackageVersion>
<FSProductVersionPrefix>$(FSPackageVersion)</FSProductVersionPrefix>
<FSProductVersion>$(FSPackageVersion).0</FSProductVersion>
</PropertyGroup>
<PropertyGroup>
<VSMajorVersion>16</VSMajorVersion>
<VSMinorVersion>2</VSMinorVersion>
<VSMinorVersion>3</VSMinorVersion>
<VSGeneralVersion>$(VSMajorVersion).0</VSGeneralVersion>
<VSAssemblyVersionPrefix>$(VSMajorVersion).$(VSMinorVersion).0</VSAssemblyVersionPrefix>
<VSAssemblyVersion>$(VSAssemblyVersionPrefix).0</VSAssemblyVersion>
@ -55,7 +55,6 @@
https://dotnet.myget.org/F/roslyn-tools/api/v3/index.json;
https://api.nuget.org/v3/index.json;
https://dotnet.myget.org/F/roslyn/api/v3/index.json;
https://dotnet.myget.org/F/roslyn-analyzers/api/v3/index.json;
https://dotnet.myget.org/F/symreader-converter/api/v3/index.json;
https://dotnet.myget.org/F/interactive-window/api/v3/index.json;
https://myget.org/F/vs-devcore/api/v3/index.json;

2
eng/build.sh
Просмотреть файл

@ -246,6 +246,7 @@ function BuildSolution {
# do real build
MSBuild $toolset_build_proj \
$bl \
/v:$verbosity \
/p:Configuration=$configuration \
/p:Projects="$projects" \
/p:RepoRoot="$repo_root" \
@ -278,3 +279,4 @@ if [[ "$test_core_clr" == true ]]; then
fi
ExitWithExitCode 0

1
eng/common/templates/job/publish-build-assets.yml
Просмотреть файл

@ -61,6 +61,7 @@ jobs:
/p:MaestroApiEndpoint=https://maestro-prod.westus2.cloudapp.azure.com
/p:PublishUsingPipelines=${{ parameters.publishUsingPipelines }}
/p:Configuration=$(_BuildConfig)
/v:detailed
condition: ${{ parameters.condition }}
continueOnError: ${{ parameters.continueOnError }}

2
eng/common/tools.sh
Просмотреть файл

@ -379,6 +379,8 @@ function MSBuild-Core {
}
}
. "$scriptroot/pipeline-logging-functions.sh"
ResolvePath "${BASH_SOURCE[0]}"
_script_dir=`dirname "$_ResolvePath"`

4
fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
Просмотреть файл

@ -12,13 +12,9 @@
<CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies> <!-- Tests won't run without this, at least on OSX, see https://github.com/NuGet/Home/issues/4837#issuecomment-354536302 -->
</PropertyGroup>
<PropertyGroup Condition="'$(TargetFramework)' == 'netcoreapp2.0'">
<DefineConstants>$(DefineConstants);FX_NO_RUNTIMEENVIRONMENT</DefineConstants>
<DefineConstants>$(DefineConstants);NO_PROJECTCRACKER</DefineConstants>
</PropertyGroup>
<ItemGroup>
<Compile Include="$(FSharpSourcesRoot)\..\tests\service\ReshapedReflection.fs">
<Link>ReshapedReflection.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)\..\tests\service\FsUnit.fs">
<Link>FsUnit.fs</Link>
</Compile>

19
fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj
Просмотреть файл

@ -33,7 +33,6 @@
<DefineConstants>$(DefineConstants);FX_NO_PDB_WRITER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SYMBOLSTORE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_APP_DOMAINS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_RUNTIMEENVIRONMENT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_WIN_REGISTRY</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SYSTEM_CONFIGURATION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_REFEMIT</DefineConstants>
@ -66,9 +65,6 @@
<Compile Include="$(FSharpSourcesRoot)/fsharp/Logger.fs">
<Link>Logger.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/utils/reshapedreflection.fs">
<Link>Reshaped/reshapedreflection.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/utils/sformat.fsi">
<Link>ErrorText/sformat.fsi</Link>
</Compile>
@ -81,6 +77,12 @@
<Compile Include="$(FSharpSourcesRoot)/fsharp/sr.fs">
<Link>ErrorText/sr.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/fsharp/LanguageFeatures.fsi">
<Link>Driver\LanguageFeatures.fsi</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/fsharp/LanguageFeatures.fs">
<Link>Driver\LanguageFeatures.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/utils/prim-lexing.fsi">
<Link>LexYaccRuntime/prim-lexing.fsi</Link>
</Compile>
@ -156,6 +158,9 @@
<Compile Include="$(FSharpSourcesRoot)/absil/bytes.fs">
<Link>Utilities/bytes.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/fsharp/XmlAdapters.fs">
<Link>Utilities\XmlAdapters.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/fsharp/lib.fs">
<Link>Utilities/lib.fs</Link>
</Compile>
@ -269,6 +274,9 @@
<Compile Include="$(FSharpSourcesRoot)/absil/ilreflect.fs">
<Link>AbsIL/ilreflect.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)\utils\reshapedmsbuild.fs">
<Link>ReferenceResolution/reshapedmsbuild.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/fsharp/ReferenceResolver.fs">
<Link>ReferenceResolution/ReferenceResolver.fs</Link>
</Compile>
@ -593,9 +601,6 @@
<Compile Include="$(FSharpSourcesRoot)\fsharp\service\ServiceUntypedParse.fs">
<Link>Service/ServiceUntypedParse.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)\utils\reshapedmsbuild.fs">
<Link>Service/reshapedmsbuild.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)\fsharp\service\ServiceDeclarationLists.fsi">
<Link>Service/ServiceDeclarationLists.fsi</Link>
</Compile>

15
src/absil/illib.fs
Просмотреть файл

@ -12,10 +12,6 @@ open System.Reflection
open System.Threading
open System.Runtime.CompilerServices
#if FX_RESHAPED_REFLECTION
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
// Logical shift right treating int32 as unsigned integer.
// Code that uses this should probably be adjusted to use unsigned integer types.
let (>>>&) (x: int32) (n: int32) = int32 (uint32 x >>> n)
@ -258,12 +254,6 @@ module Option =
module List =
//let item n xs = List.nth xs n
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
let sortWithOrder (c: IComparer<'T>) elements = List.sortWith (Order.toFunction c) elements
let splitAfter n l =
@ -1272,11 +1262,6 @@ type LayeredMultiMap<'Key, 'Value when 'Key : equality and 'Key : comparison>(co
[<AutoOpen>]
module Shim =
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
type IFileSystem =
/// A shim over File.ReadAllBytes

17
src/absil/ilreflect.fs
Просмотреть файл

@ -24,10 +24,6 @@ open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Range
open FSharp.Core.Printf
#if FX_RESHAPED_REFLECTION
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
let codeLabelOrder = ComparisonIdentity.Structural<ILCodeLabel>
// Convert the output of convCustomAttr
@ -314,10 +310,8 @@ let convAssemblyRef (aref: ILAssemblyRef) =
asmName.Version <- System.Version (int32 version.Major, int32 version.Minor, int32 version.Build, int32 version.Revision)
Option.iter setVersion aref.Version
// asmName.ProcessorArchitecture <- System.Reflection.ProcessorArchitecture.MSIL
#if !FX_RESHAPED_GLOBALIZATION
//Option.iter (fun name -> asmName.CultureInfo <- System.Globalization.CultureInfo.CreateSpecificCulture name) aref.Locale
asmName.CultureInfo <- System.Globalization.CultureInfo.InvariantCulture
#endif
asmName
/// The global environment.
@ -665,9 +659,6 @@ let TypeBuilderInstantiationT =
ty
let typeIsNotQueryable (ty: Type) =
#if FX_RESHAPED_REFLECTION
let ty = ty.GetTypeInfo()
#endif
(ty :? TypeBuilder) || ((ty.GetType()).Equals(TypeBuilderInstantiationT))
//----------------------------------------------------------------------------
// convFieldSpec
@ -796,11 +787,7 @@ let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) =
parentT.GetMethod(mref.Name, cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic,
null,
argTs,
#if FX_RESHAPED_REFLECTION
(null: obj[]))
#else
(null: ParameterModifier[]))
#endif
// This can fail if there is an ambiguity w.r.t. return type
with _ -> null
if (isNonNull methInfo && equalTypes resT methInfo.ReturnType) then
@ -1436,11 +1423,7 @@ let buildGenParamsPass1 _emEnv defineGenericParameters (gps: ILGenericParameterD
let buildGenParamsPass1b cenv emEnv (genArgs: Type array) (gps: ILGenericParameterDefs) =
#if FX_RESHAPED_REFLECTION
let genpBs = genArgs |> Array.map (fun x -> (x.GetTypeInfo() :?> GenericTypeParameterBuilder))
#else
let genpBs = genArgs |> Array.map (fun x -> (x :?> GenericTypeParameterBuilder))
#endif
gps |> List.iteri (fun i (gp: ILGenericParameterDef) ->
let gpB = genpBs.[i]
// the Constraints are either the parent (base) type or interfaces.

3
src/absil/ilwrite.fs
Просмотреть файл

@ -3037,9 +3037,6 @@ module FileSystemUtilites =
open System
open System.Reflection
open System.Globalization
#if FX_RESHAPED_REFLECTION
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
let progress = try System.Environment.GetEnvironmentVariable("FSharp_DebugSetFilePermissions") <> null with _ -> false
let setExecutablePermission (filename: string) =

40
src/fsharp/CompileOps.fs
Просмотреть файл

@ -29,6 +29,7 @@ open FSharp.Compiler.AttributeChecking
open FSharp.Compiler.ConstraintSolver
open FSharp.Compiler.DiagnosticMessage
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Import
open FSharp.Compiler.Infos
open FSharp.Compiler.Lexhelp
@ -1740,7 +1741,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt
let os = System.Text.StringBuilder()
OutputPhasedDiagnostic os err flattenErrors canSuggestNames
errors.Add( Diagnostic.Short(isError, os.ToString()) )
relatedErrors |> List.iter OutputRelatedError
match err with
@ -1790,7 +1791,7 @@ let OutputDiagnosticContext prefix fileLineFn os err =
let (++) x s = x @ [s]
//----------------------------------------------------------------------------
//--------------------------------------------------------------------------
// General file name resolver
//--------------------------------------------------------------------------
@ -1975,7 +1976,7 @@ type ICompilationThread =
/// Enqueue work to be done on a compilation thread.
abstract EnqueueWork: (CompilationThreadToken -> unit) -> unit
type ImportedBinary =
type ImportedBinary =
{ FileName: string
RawMetadata: IRawFSharpAssemblyData
#if !NO_EXTENSIONTYPING
@ -1986,7 +1987,7 @@ type ImportedBinary =
ILAssemblyRefs: ILAssemblyRef list
ILScopeRef: ILScopeRef }
type ImportedAssembly =
type ImportedAssembly =
{ ILScopeRef: ILScopeRef
FSharpViewOfMetadata: CcuThunk
AssemblyAutoOpenAttributes: string list
@ -2001,7 +2002,7 @@ type AvailableImportedAssembly =
| ResolvedImportedAssembly of ImportedAssembly
| UnresolvedImportedAssembly of string
type CcuLoadFailureAction =
type CcuLoadFailureAction =
| RaiseError
| ReturnNone
@ -2161,8 +2162,10 @@ type TcConfigBuilder =
mutable internalTestSpanStackReferring: bool
mutable noConditionalErasure: bool
mutable pathMap: PathMap
mutable langVersion: LanguageVersion
}
static member Initial =
@ -2205,7 +2208,7 @@ type TcConfigBuilder =
debuginfo = false
testFlagEmitFeeFeeAs100001 = false
dumpDebugInfo = false
debugSymbolFile = None
debugSymbolFile = None
(* Backend configuration *)
typeCheckOnly = false
@ -2300,6 +2303,7 @@ type TcConfigBuilder =
internalTestSpanStackReferring = false
noConditionalErasure = false
pathMap = PathMap.empty
langVersion = LanguageVersion("default")
}
static member CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, reduceMemoryUsage, implicitIncludeDir,
@ -2720,6 +2724,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
member x.emitTailcalls = data.emitTailcalls
member x.deterministic = data.deterministic
member x.pathMap = data.pathMap
member x.langVersion = data.langVersion
member x.preferredUiLang = data.preferredUiLang
member x.lcid = data.lcid
member x.optsOn = data.optsOn
@ -3097,7 +3102,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
member tcConfig.PrimaryAssemblyDllReference() = primaryAssemblyReference
member tcConfig.CoreLibraryDllReference() = fslibReference
let ReportWarning options err =
warningOn err (options.WarnLevel) (options.WarnOn) && not (List.contains (GetDiagnosticNumber err) (options.WarnOff))
@ -3448,8 +3453,8 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompil
if List.exists (Filename.checkSuffix lower) (FSharpSigFileSuffixes@FSharpImplFileSuffixes) then
if not(FileSystem.SafeExists filename) then
error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup))
// bug 3155: if the file name is indirect, use a full path
let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(filename, tcConfig.inputCodePage, retryLocked)
let isFeatureSupported featureId = tcConfig.langVersion.SupportsFeature featureId
let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(isFeatureSupported, filename, tcConfig.inputCodePage, retryLocked)
ParseOneInputLexbuf(tcConfig, lexResourceManager, conditionalCompilationDefines, lexbuf, filename, isLastCompiland, errorLogger)
else error(Error(FSComp.SR.buildInvalidSourceFileExtension(SanitizeFileName filename tcConfig.implicitIncludeDir), rangeStartup))
with e -> (* errorR(Failure("parse failed")); *) errorRecovery e rangeStartup; None
@ -4693,7 +4698,7 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
let tcGlobals = TcGlobals(tcConfig.compilingFslib, ilGlobals, fslibCcu,
tcConfig.implicitIncludeDir, tcConfig.mlCompatibility,
tcConfig.isInteractive, tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations,
tcConfig.noDebugData, tcConfig.pathMap)
tcConfig.noDebugData, tcConfig.pathMap, tcConfig.langVersion)
#if DEBUG
// the global_g reference cell is used only for debug printing
@ -4978,11 +4983,13 @@ module private ScriptPreprocessClosure =
| CodeContext.CompilationAndEvaluation -> ["INTERACTIVE"]
| CodeContext.Compilation -> ["COMPILED"]
| CodeContext.Editing -> "EDITING" :: (if IsScript filename then ["INTERACTIVE"] else ["COMPILED"])
let lexbuf = UnicodeLexing.SourceTextAsLexbuf(sourceText)
let isFeatureSupported featureId = tcConfig.langVersion.SupportsFeature featureId
let lexbuf = UnicodeLexing.SourceTextAsLexbuf(isFeatureSupported, sourceText)
let isLastCompiland = (IsScript filename), tcConfig.target.IsExe // The root compiland is last in the list of compilands.
ParseOneInputLexbuf (tcConfig, lexResourceManager, defines, lexbuf, filename, isLastCompiland, errorLogger)
/// Create a TcConfig for load closure starting from a single .fsx file
let CreateScriptTextTcConfig
(legacyReferenceResolver, defaultFSharpBinariesDir,
@ -5194,7 +5201,7 @@ module private ScriptPreprocessClosure =
useSimpleResolution, useFsiAuxLib, useSdkRefs,
lexResourceManager: Lexhelp.LexResourceManager,
applyCommmandLineArgs, assumeDotNetFramework,
tryGetMetadataSnapshot, reduceMemoryUsage) =
tryGetMetadataSnapshot, reduceMemoryUsage) =
// Resolve the basic references such as FSharp.Core.dll first, before processing any #I directives in the script
//
@ -5292,11 +5299,8 @@ let CheckSimulateException(tcConfig: TcConfig) =
| Some("tc-oom") -> raise(System.OutOfMemoryException())
| Some("tc-an") -> raise(System.ArgumentNullException("simulated"))
| Some("tc-invop") -> raise(System.InvalidOperationException())
#if FX_REDUCED_EXCEPTIONS
#else
| Some("tc-av") -> raise(System.AccessViolationException())
| Some("tc-nfn") -> raise(System.NotFiniteNumberException())
#endif
| Some("tc-aor") -> raise(System.ArgumentOutOfRangeException())
| Some("tc-dv0") -> raise(System.DivideByZeroException())
| Some("tc-oe") -> raise(System.OverflowException())

4
src/fsharp/CompileOps.fsi
Просмотреть файл

@ -17,6 +17,7 @@ open FSharp.Compiler.TypeChecker
open FSharp.Compiler.Range
open FSharp.Compiler.Ast
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Tast
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.Text
@ -383,6 +384,8 @@ type TcConfigBuilder =
mutable noConditionalErasure: bool
mutable pathMap : PathMap
mutable langVersion : LanguageVersion
}
static member Initial: TcConfigBuilder
@ -543,6 +546,7 @@ type TcConfig =
member copyFSharpCore: CopyFSharpCoreFlag
member shadowCopyReferences: bool
member useSdkRefs: bool
member langVersion: LanguageVersion
static member Create: TcConfigBuilder * validate: bool -> TcConfig

45
src/fsharp/CompileOptions.fs
Просмотреть файл

@ -18,6 +18,7 @@ open FSharp.Compiler.TcGlobals
open FSharp.Compiler.Tast
open FSharp.Compiler.Tastops
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Lib
open FSharp.Compiler.Range
open FSharp.Compiler.IlxGen
@ -527,6 +528,7 @@ let tagAlgorithm = "{SHA1|SHA256}"
let tagInt = "<n>"
let tagPathMap = "<path=sourcePath;...>"
let tagNone = ""
let tagLangVersionValues = "{?|version|latest|preview}"
// PrintOptionInfo
//----------------
@ -814,28 +816,41 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) =
//----------------------
let defineSymbol tcConfigB s = tcConfigB.conditionalCompilationDefines <- s :: tcConfigB.conditionalCompilationDefines
let mlCompatibilityFlag (tcConfigB: TcConfigBuilder) =
CompilerOption
("mlcompatibility", tagNone,
OptionUnit (fun () -> tcConfigB.mlCompatibility<-true; tcConfigB.TurnWarningOff(rangeCmdArgs, "62")), None,
Some (FSComp.SR.optsMlcompatibility()))
/// LanguageVersion management
let setLanguageVersion (specifiedVersion) =
let languageVersion = new LanguageVersion(specifiedVersion)
let dumpAllowedValues () =
printfn "%s" (FSComp.SR.optsSupportedLangVersions())
for v in languageVersion.ValidOptions do printfn "%s" v
for v in languageVersion.ValidVersions do printfn "%s" v
exit 0
if specifiedVersion = "?" then dumpAllowedValues ()
if not (languageVersion.ContainsVersion specifiedVersion) then error(Error(FSComp.SR.optsUnrecognizedLanguageVersion specifiedVersion, rangeCmdArgs))
languageVersion
let languageFlags tcConfigB =
[
CompilerOption
("checked", tagNone,
OptionSwitch (fun switch -> tcConfigB.checkOverflow <- (switch = OptionSwitch.On)), None,
Some (FSComp.SR.optsChecked()))
CompilerOption
("define", tagString,
OptionString (defineSymbol tcConfigB), None,
Some (FSComp.SR.optsDefine()))
// -langversion:? Display the allowed values for language version
// -langversion:<string> Specify language version such as
// 'default' (latest major version), or
// 'latest' (latest version, including minor versions),
// 'preview' (features for preview)
// or specific versions like '4.7'
CompilerOption("langversion", tagLangVersionValues, OptionString (fun switch -> tcConfigB.langVersion <- setLanguageVersion(switch)), None, Some (FSComp.SR.optsLangVersion()))
CompilerOption("checked", tagNone, OptionSwitch (fun switch -> tcConfigB.checkOverflow <- (switch = OptionSwitch.On)), None, Some (FSComp.SR.optsChecked()))
CompilerOption("define", tagString, OptionString (defineSymbol tcConfigB), None, Some (FSComp.SR.optsDefine()))
mlCompatibilityFlag tcConfigB
]
// OptionBlock: Advanced user options
//-----------------------------------
@ -1606,16 +1621,10 @@ let ReportTime (tcConfig:TcConfig) descr =
| Some("fsc-oom") -> raise(System.OutOfMemoryException())
| Some("fsc-an") -> raise(System.ArgumentNullException("simulated"))
| Some("fsc-invop") -> raise(System.InvalidOperationException())
#if FX_REDUCED_EXCEPTIONS
#else
| Some("fsc-av") -> raise(System.AccessViolationException())
#endif
| Some("fsc-aor") -> raise(System.ArgumentOutOfRangeException())
| Some("fsc-dv0") -> raise(System.DivideByZeroException())
#if FX_REDUCED_EXCEPTIONS
#else
| Some("fsc-nfn") -> raise(System.NotFiniteNumberException())
#endif
| Some("fsc-oe") -> raise(System.OverflowException())
| Some("fsc-atmm") -> raise(System.ArrayTypeMismatchException())
| Some("fsc-bif") -> raise(System.BadImageFormatException())

17
src/fsharp/ConstraintSolver.fs
Просмотреть файл

@ -2730,9 +2730,26 @@ let UndoIfFailed f =
ReportWarnings warns
true
let UndoIfFailedOrWarnings f =
let trace = Trace.New()
let res =
try
f trace
|> CheckNoErrorsAndGetWarnings
with e -> None
match res with
| Some [] ->
true
| _ ->
trace.Undo()
false
let AddCxTypeEqualsTypeUndoIfFailed denv css m ty1 ty2 =
UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) ty1 ty2)
let AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv css m ty1 ty2 =
UndoIfFailedOrWarnings (fun trace -> SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) ty1 ty2)
let AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 =
let csenv = { MakeConstraintSolverEnv ContextInfo.NoContext css m denv with MatchingOnly = true }
UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2)

1
src/fsharp/ConstraintSolver.fsi
Просмотреть файл

@ -126,6 +126,7 @@ val CheckDeclaredTypars : DisplayEnv -> ConstraintSolverSt
val AddConstraint : ConstraintSolverEnv -> int -> Range.range -> OptionalTrace -> Typar -> TyparConstraint -> OperationResult<unit>
val AddCxTypeEqualsType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit
val AddCxTypeEqualsTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
val AddCxTypeEqualsTypeUndoIfFailedOrWarnings : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
val AddCxTypeMustSubsumeType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit
val AddCxTypeMustSubsumeTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool

16
src/fsharp/ErrorLogger.fs
Просмотреть файл

@ -351,10 +351,6 @@ module ErrorLoggerExtensions =
/// Reraise an exception if it is one we want to report to Watson.
let ReraiseIfWatsonable(exn:exn) =
#if FX_REDUCED_EXCEPTIONS
ignore exn
()
#else
match exn with
// These few SystemExceptions which we don't report to Watson are because we handle these in some way in Build.fs
| :? System.Reflection.TargetInvocationException -> ()
@ -366,7 +362,6 @@ module ErrorLoggerExtensions =
PreserveStackTrace exn
raise exn
| _ -> ()
#endif
type ErrorLogger with
@ -404,10 +399,7 @@ module ErrorLoggerExtensions =
// Throws StopProcessing and exceptions raised by the DiagnosticSink(exn) handler.
match exn with
(* Don't send ThreadAbortException down the error channel *)
#if FX_REDUCED_EXCEPTIONS
#else
| :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException), _) -> ()
#endif
| ReportedError _ | WrappedError(ReportedError _, _) -> ()
| StopProcessing | WrappedError(StopProcessing, _) ->
PreserveStackTrace exn
@ -679,7 +671,7 @@ type public FSharpErrorSeverityOptions =
// See https://github.com/Microsoft/visualfsharp/issues/6417, if a compile of the FSharp.Compiler.Services.dll or other compiler
// binary produces exactly 65536 methods then older versions of the compiler raise a bug. If you hit this bug again then try removing
// this.
let dummyMethodFOrBug6417A() = ()
let dummyMethodFOrBug6417B() = ()
// binary produces exactly 65536 methods then older versions of the compiler raise a bug. If you hit this bug again then try adding
// this back in.
// let dummyMethodFOrBug6417A() = ()
// let dummyMethodFOrBug6417B() = ()

3
src/fsharp/ExtensionTyping.fs
Просмотреть файл

@ -140,9 +140,7 @@ module internal ExtensionTyping =
let StripException (e: exn) =
match e with
#if !FX_REDUCED_EXCEPTIONS
| :? System.Reflection.TargetInvocationException as e -> e.InnerException
#endif
| :? TypeInitializationException as e -> e.InnerException
| _ -> e
@ -417,6 +415,7 @@ module internal ExtensionTyping =
member __.IsEnum = x.IsEnum
member __.IsClass = x.IsClass
member __.IsSealed = x.IsSealed
member __.IsAbstract = x.IsAbstract
member __.IsInterface = x.IsInterface
member __.GetArrayRank() = x.GetArrayRank()
member __.GenericParameterPosition = x.GenericParameterPosition

1
src/fsharp/ExtensionTyping.fsi
Просмотреть файл

@ -120,6 +120,7 @@ module internal ExtensionTyping =
member IsInterface : bool
member IsClass : bool
member IsSealed : bool
member IsAbstract : bool
member IsPublic : bool
member IsNestedPublic : bool
member GenericParameterPosition : int

8
src/fsharp/FSComp.txt
Просмотреть файл

@ -73,6 +73,7 @@ buildProductNameCommunity,"F# Compiler for F# %s"
pickleErrorReadingWritingMetadata,"Error reading/writing metadata for the F# compiled DLL '%s'. Was the DLL compiled with an earlier version of the F# compiler? (error: '%s')."
245,tastTypeOrModuleNotConcrete,"The type/module '%s' is not a concrete module or type"
tastTypeHasAssemblyCodeRepresentation,"The type '%s' has an inline assembly code representation"
246,optsUnrecognizedLanguageVersion,"Unrecognized value '%s' for --langversion use --langversion:? for complete list"
247,tastNamespaceAndModuleWithSameNameInAssembly,"A namespace and a module named '%s' both occur in two parts of this assembly"
248,tastTwoModulesWithSameNameInAssembly,"Two modules named '%s' occur in two parts of this assembly"
249,tastDuplicateTypeDefinitionInAssembly,"Two type definitions named '%s' occur in namespace '%s' in two parts of this assembly"
@ -420,6 +421,7 @@ parsAttributesMustComeBeforeVal,"Attributes should be placed before 'val'"
568,parsAllEnumFieldsRequireValues,"All enum fields must be given values"
569,parsInlineAssemblyCannotHaveVisibilityDeclarations,"Accessibility modifiers are not permitted on inline assembly code types"
571,parsUnexpectedIdentifier,"Unexpected identifier: '%s'"
10,parsUnexpectedSymbolDot,"Unexpected symbol '.' in member definition. Expected 'with', '=' or other token."
572,parsUnionCasesCannotHaveVisibilityDeclarations,"Accessibility modifiers are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation."
573,parsEnumFieldsCannotHaveVisibilityDeclarations,"Accessibility modifiers are not permitted on enumeration fields"
parsConsiderUsingSeparateRecordType,"Consider using a separate record type instead"
@ -1462,9 +1464,13 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl
3244,parsInvalidAnonRecdType,"Invalid anonymous record type"
3245,tcCopyAndUpdateNeedsRecordType,"The input to a copy-and-update expression that creates an anonymous record must be either an anonymous record or a record"
3246,tcAugmentationsCannotHaveAttributes,"Attributes cannot be applied to type extensions."
3250,expressionHasNoName,"Expression does not have a name."
3251,chkNoFirstClassNameOf,"Using the 'nameof' operator as a first-class function value is not permitted."
3300,chkInvalidFunctionParameterType,"The parameter '%s' has an invalid type '%s'. This is not permitted by the rules of Common IL."
3301,chkInvalidFunctionReturnType,"The function or method has an invalid return type '%s'. This is not permitted by the rules of Common IL."
useSdkRefs,"Use reference assemblies for .NET framework references when available (Enabled by default)."
fSharpBannerVersion,"%s for F# %s"
nativeResourceFormatError,"Stream does not begin with a null resource and is not in '.RES' format."
nativeResourceHeaderMalformed,"Resource header beginning at offset %s is malformed."
nativeResourceHeaderMalformed,"Resource header beginning at offset %s is malformed."
optsLangVersion,"Display the allowed values for language version, specify language version such as 'latest' or 'preview'"
optsSupportedLangVersions,"Supported language versions:"

1
src/fsharp/FSharp.Build/FSharp.Build.fsproj
Просмотреть файл

@ -19,7 +19,6 @@
<InternalsVisibleTo Include="VisualFSharp.UnitTests" />
<EmbeddedText Include="FSBuild.txt" />
<Compile Include="..\..\utils\CompilerLocationUtils.fs" />
<Compile Include="..\..\utils\reshapedreflection.fs" />
<Compile Include="FSharpCommandLineBuilder.fs" />
<Compile Include="Fsc.fs" />
<Compile Include="Fsi.fs" />

16
src/fsharp/FSharp.Build/Fsc.fs
Просмотреть файл

@ -40,6 +40,7 @@ type public Fsc () as this =
let mutable generateInterfaceFile : string = null
let mutable highEntropyVA : bool = false
let mutable keyFile : string = null
let mutable langVersion : string = null
let mutable noFramework = false
let mutable optimize : bool = true
let mutable otherFlags : string = null
@ -103,15 +104,15 @@ type public Fsc () as this =
| "EMBEDDED" -> "embedded"
| "FULL" -> "full"
| _ -> null)
if embedAllSources then
builder.AppendSwitch("--embed+")
if embedAllSources then builder.AppendSwitch("--embed+")
if embeddedFiles <> null then
for item in embeddedFiles do
builder.AppendSwitchIfNotNull("--embed:", item.ItemSpec)
builder.AppendSwitchIfNotNull("--sourcelink:", sourceLink)
builder.AppendSwitchIfNotNull("--langversion:", langVersion)
// NoFramework
if noFramework then
builder.AppendSwitch("--noframework")
if noFramework then
builder.AppendSwitch("--noframework")
// BaseAddress
builder.AppendSwitchIfNotNull("--baseaddress:", baseAddress)
// DefineConstants
@ -120,7 +121,6 @@ type public Fsc () as this =
builder.AppendSwitchIfNotNull("--define:", item.ItemSpec)
// DocumentationFile
builder.AppendSwitchIfNotNull("--doc:", documentationFile)
// GenerateInterfaceFile
builder.AppendSwitchIfNotNull("--sig:", generateInterfaceFile)
// KeyFile
@ -343,6 +343,10 @@ type public Fsc () as this =
with get() = keyFile
and set(s) = keyFile <- s
member fsc.LangVersion
with get() = langVersion
and set(s) = langVersion <- s
member fsc.LCID
with get() = vslcid
and set(p) = vslcid <- p
@ -376,7 +380,7 @@ type public Fsc () as this =
member fsc.PathMap
with get() = pathMap
and set(s) = pathMap <- s
// --pdb <string>:
// Name the debug output file
member fsc.PdbFile

6
src/fsharp/FSharp.Build/Fsi.fs
Просмотреть файл

@ -29,6 +29,7 @@ type public Fsi () as this =
let mutable disabledWarnings : string = null
let mutable dotnetFsiCompilerPath : string = null
let mutable fsiExec = false
let mutable langVersion : string = null
let mutable noFramework = false
let mutable optimize = true
let mutable otherFlags : string = null
@ -67,6 +68,7 @@ type public Fsi () as this =
builder.AppendSwitchIfNotNull("--codepage:", codePage)
builder.AppendSwitchIfNotNull("--langversion:", langVersion)
if noFramework then builder.AppendSwitch("--noframework")
if defineConstants <> null then
@ -167,6 +169,10 @@ type public Fsi () as this =
with get() = vslcid
and set(p) = vslcid <- p
member fsc.LangVersion
with get() = langVersion
and set(s) = langVersion <- s
// --noframework
member fsi.NoFramework
with get() = noFramework

9
src/fsharp/FSharp.Build/Microsoft.FSharp.Targets
Просмотреть файл

@ -273,8 +273,8 @@ this file.
</PropertyGroup>
<!-- Condition is to filter out the _CoreCompileResourceInputs so that it doesn't pass in culture resources to the compiler -->
<!-- NOTE: ManifestResourceWithNoCulture and ManifestNonResxWithNoCultureOnDisk are generated by Mono targets files -->
<Fsc Condition=" '%(_CoreCompileResourceInputs.WithCulture)' != 'true' "
<!-- NOTE: ManifestResourceWithNoCulture and ManifestNonResxWithNoCultureOnDisk are generated by Mono targets files -->
<Fsc Condition="'%(_CoreCompileResourceInputs.WithCulture)' != 'true'"
BaseAddress="$(BaseAddress)"
ChecksumAlgorithm="$(PdbChecksumAlgorithm)"
CodePage="$(CodePage)"
@ -291,6 +291,7 @@ this file.
GenerateInterfaceFile="$(GenerateInterfaceFile)"
HighEntropyVA="$(HighEntropyVA)"
KeyFile="$(KeyOriginatorFile)"
LangVersion="$(LangVersion)"
LCID="$(LCID)"
NoFramework="true"
Optimize="$(Optimize)"
@ -309,6 +310,7 @@ this file.
SkipCompilerExecution="$(SkipCompilerExecution)"
SourceLink="$(SourceLink)"
Sources="@(CompileBefore);@(Compile);@(CompileAfter)"
SubsystemVersion="$(SubsystemVersion)"
Tailcalls="$(Tailcalls)"
TargetType="$(OutputType)"
TargetProfile="$(TargetProfile)"
@ -322,8 +324,7 @@ this file.
WarningLevel="$(WarningLevel)"
WarningsAsErrors="$(WarningsAsErrors)"
Win32ManifestFile="$(Win32Manifest)"
Win32ResourceFile="$(Win32Resource)"
SubsystemVersion="$(SubsystemVersion)">
Win32ResourceFile="$(Win32Resource)">
<Output TaskParameter="CommandLineArgs" ItemName="FscCommandLineArgs" />
</Fsc>

2
src/fsharp/FSharp.Build/xlf/FSBuild.txt.ja.xlf
Просмотреть файл

@ -4,7 +4,7 @@
<body>
<trans-unit id="fSharpBannerVersion">
<source>{0} for F# {1}</source>
<target state="translated">F# {1} の {0}</target>
<target state="translated">F# {1} のための {0}</target>
<note />
</trans-unit>
<trans-unit id="toolpathUnknown">

1
src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj
Просмотреть файл

@ -21,7 +21,6 @@
<ItemGroup>
<EmbeddedText Include="..\FSInteractiveSettings.txt" />
<Compile Include="..\..\utils\reshapedreflection.fs" />
<Compile Include="..\fsiattrs.fs" />
<Compile Include="..\fsiaux.fsi" />
<Compile Include="..\fsiaux.fs" />

22
src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj
Просмотреть файл

@ -63,12 +63,6 @@
<Compile Include="..\Logger.fs">
<Link>Logger.fs</Link>
</Compile>
<Compile Include="..\..\utils\reshapedreflection.fs">
<Link>Reflection\reshapedreflection.fs</Link>
</Compile>
<Compile Include="..\..\utils\reshapedmsbuild.fs">
<Link>Reflection\reshapedmsbuild.fs</Link>
</Compile>
<Compile Include="..\..\utils\sformat.fsi">
<Link>ErrorText\sformat.fsi</Link>
</Compile>
@ -81,6 +75,12 @@
<Compile Include="..\sr.fs">
<Link>ErrorText\sr.fs</Link>
</Compile>
<Compile Include="..\LanguageFeatures.fsi">
<Link>Driver\LanguageFeatures.fsi</Link>
</Compile>
<Compile Include="..\LanguageFeatures.fs">
<Link>Driver\LanguageFeatures.fs</Link>
</Compile>
<Compile Include="..\..\utils\prim-lexing.fsi">
<Link>LexYaccRuntime\prim-lexing.fsi</Link>
</Compile>
@ -147,6 +147,9 @@
<Compile Include="..\..\absil\bytes.fs">
<Link>Utilities\bytes.fs</Link>
</Compile>
<Compile Include="..\XmlAdapters.fs">
<Link>Utilities\XmlAdapters.fs</Link>
</Compile>
<Compile Include="..\InternalCollections.fsi">
<Link>Utilities\InternalCollections.fsi</Link>
</Compile>
@ -272,7 +275,9 @@
<Compile Include="..\ReferenceResolver.fs">
<Link>ReferenceResolution\ReferenceResolver.fs</Link>
</Compile>
<Compile Include="..\..\utils\reshapedmsbuild.fs">
<Link>ReferenceResolution/reshapedmsbuild.fs</Link>
</Compile>
<!-- A legacy resolver used to help with scripting diagnostics in the Visual Studio tools -->
<Compile Include="..\LegacyMSBuildReferenceResolver.fsi">
<Link>ReferenceResolution/LegacyMSBuildReferenceResolver.fsi</Link>
@ -636,9 +641,6 @@
<Compile Include="..\service\ServiceXmlDocParser.fs">
<Link>Service/ServiceXmlDocParser.fs</Link>
</Compile>
<Compile Include="..\..\utils\reshapedmsbuild.fs">
<Link>Service/reshapedmsbuild.fs</Link>
</Compile>
<Compile Include="..\service\ExternalSymbol.fsi">
<Link>Service/ExternalSymbol.fsi</Link>
</Compile>

4
src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec
Просмотреть файл

@ -4,7 +4,7 @@
<id>FSharp.Compiler.Private.netcore</id>
<description>
.NET Core compatible version of the fsharp compiler service dll
Supported Platforms: - .NET Core (netstandard1.6)
Supported Platforms: - .NET Core (netstandard2.0)
</description>
<language>en-US</language>
<requireLicenseAcceptance>true</requireLicenseAcceptance>
@ -15,7 +15,7 @@
<tags>$tags$</tags>
<dependencies>
<group>
<dependency id="NETStandard.Library" version="1.6.0" />
<dependency id="NETStandard.Library" version="2.0.0" />
<dependency id="System.Collections.Immutable" version="1.5.0" />
<dependency id="System.Diagnostics.Process" version="4.1.0" />
<dependency id="System.Diagnostics.TraceSource" version="4.0.0" />

4
src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec
Просмотреть файл

@ -45,7 +45,7 @@
<!-- assemblies -->
<file src="fsc\$Configuration$\netcoreapp2.1\fsc.exe" target="lib\netcoreapp2.1" />
<file src="fsi\$Configuration$\netcoreapp2.1\fsi.exe" target="lib\netcoreapp2.1" />
<file src="FSharp.Core\$Configuration$\netstandard1.6\FSharp.Core.dll" target="lib\netcoreapp2.1" />
<file src="FSharp.Core\$Configuration$\netstandard2.0\FSharp.Core.dll" target="lib\netcoreapp2.1" />
<file src="FSharp.Compiler.Private\$Configuration$\netstandard2.0\FSharp.Compiler.Private.dll" target="lib\netcoreapp2.1" />
<file src="FSharp.Build\$Configuration$\netcoreapp2.1\FSharp.Build.dll" target="lib\netcoreapp2.1" />
<file src="FSharp.Compiler.Interactive.Settings\$Configuration$\netstandard2.0\FSharp.Compiler.Interactive.Settings.dll"
@ -59,7 +59,7 @@
<file src="FSharp.Build\$Configuration$\netcoreapp2.1\Microsoft.FSharp.Overrides.NetSdk.targets" target="contentFiles\any\any" />
<!-- resources -->
<file src="FSharp.Core\$Configuration$\netstandard1.6\**\FSharp.Core.resources.dll" target="lib\netcoreapp2.1" />
<file src="FSharp.Core\$Configuration$\netstandard2.0\**\FSharp.Core.resources.dll" target="lib\netcoreapp2.1" />
<file src="FSharp.Compiler.Private\$Configuration$\netstandard2.0\**\FSharp.Compiler.Private.resources.dll"
target="lib\netcoreapp2.1" />
<file src="FSharp.Compiler.Interactive.Settings\$Configuration$\netstandard2.0\**\FSharp.Compiler.Interactive.Settings.resources.dll"

2
src/fsharp/FSharp.Core.nuget/FSharp.Core.nuget.csproj
Просмотреть файл

@ -2,7 +2,7 @@
<PropertyGroup>
<PreRelease>true</PreRelease>
<TargetFrameworks>net45;netstandard1.6</TargetFrameworks>
<TargetFrameworks>net45;netstandard2.0</TargetFrameworks>
<PackageId>FSharp.Core</PackageId>
<NuspecFile>FSharp.Core.nuspec</NuspecFile>
<IsPackable>true</IsPackable>

49
src/fsharp/FSharp.Core.nuget/FSharp.Core.nuspec
Просмотреть файл

@ -5,50 +5,23 @@
<iconUrl>https://fsharp.org/img/logo.png</iconUrl>
<language>en-US</language>
<dependencies>
<group targetFramework=".NETStandard1.6">
<dependency id="System.Collections" version="4.0.11" />
<dependency id="System.Console" version="4.0.0" />
<dependency id="System.Diagnostics.Debug" version="4.0.11" />
<dependency id="System.Diagnostics.Tools" version="4.0.1" />
<dependency id="System.Globalization" version="4.0.11" />
<dependency id="System.IO" version="4.1.0" />
<dependency id="System.Linq" version="4.1.0" />
<dependency id="System.Linq.Expressions" version="4.1.0" />
<dependency id="System.Linq.Queryable" version="4.0.1" />
<dependency id="System.Net.Requests" version="4.0.11" />
<dependency id="System.Reflection" version="4.1.0" />
<dependency id="System.Reflection.Extensions" version="4.0.1" />
<dependency id="System.Resources.ResourceManager" version="4.0.1" />
<dependency id="System.Runtime" version="4.1.0" />
<dependency id="System.Runtime.Extensions" version="4.1.0" />
<dependency id="System.Runtime.Numerics" version="4.0.1" />
<dependency id="System.Text.RegularExpressions" version="4.1.0" />
<dependency id="System.Threading" version="4.0.11" />
<dependency id="System.Threading.Tasks" version="4.0.11" />
<dependency id="System.Threading.Tasks.Parallel" version="4.0.1" />
<dependency id="System.Threading.Thread" version="4.0.0" />
<dependency id="System.Threading.ThreadPool" version="4.0.10" />
<dependency id="System.Threading.Timer" version="4.0.1" />
</group>
<group targetFramework=".NETStandard2.0">
</group>
<group targetFramework="net45">
</group>
<group targetFramework=".NETStandard2.0" />
<group targetFramework="net45" />
</dependencies>
</metadata>
<files>
<file src="FSharp.Core\$Configuration$\netstandard1.6\FSharp.Core.dll" target="lib\netstandard1.6" />
<file src="FSharp.Core\$Configuration$\netstandard1.6\FSharp.Core.sigdata" target="lib\netstandard1.6" />
<file src="FSharp.Core\$Configuration$\netstandard1.6\FSharp.Core.optdata" target="lib\netstandard1.6" />
<file src="FSharp.Core\$Configuration$\netstandard1.6\FSharp.Core.xml" target="lib\netstandard1.6" />
<file src="FSharp.Core\$Configuration$\netstandard2.0\FSharp.Core.dll" target="lib\netstandard2.0" />
<file src="FSharp.Core\$Configuration$\netstandard2.0\FSharp.Core.sigdata" target="lib\netstandard2.0" />
<file src="FSharp.Core\$Configuration$\netstandard2.0\FSharp.Core.optdata" target="lib\netstandard2.0" />
<file src="FSharp.Core\$Configuration$\netstandard2.0\FSharp.Core.xml" target="lib\netstandard2.0" />
<file src="FSharp.Core\$Configuration$\net45\FSharp.Core.dll" target="lib\net45" />
<file src="FSharp.Core\$Configuration$\net45\FSharp.Core.sigdata" target="lib\net45" />
<file src="FSharp.Core\$Configuration$\net45\FSharp.Core.optdata" target="lib\net45" />
<file src="FSharp.Core\$Configuration$\net45\FSharp.Core.xml" target="lib\net45" />
<file src="FSharp.Core\$Configuration$\net45\FSharp.Core.dll" target="lib\net45" />
<file src="FSharp.Core\$Configuration$\net45\FSharp.Core.sigdata" target="lib\net45" />
<file src="FSharp.Core\$Configuration$\net45\FSharp.Core.optdata" target="lib\net45" />
<file src="FSharp.Core\$Configuration$\net45\FSharp.Core.xml" target="lib\net45" />
<!-- resources -->
<file src="FSharp.Core\$Configuration$\netstandard1.6\**\FSharp.Core.resources.dll" target="lib\netstandard1.6" />
<file src="FSharp.Core\$Configuration$\netstandard2.0\**\FSharp.Core.resources.dll" target="lib\netstandard2.0" />
<file src="FSharp.Core\$Configuration$\net45\**\FSharp.Core.resources.dll" target="lib\net45" />
</files>
</package>

3
src/fsharp/FSharp.Core/FSCore.resx
Просмотреть файл

@ -540,4 +540,7 @@
<data name="unsupportedQueryConstructKind" xml:space="preserve">
<value>This is not a valid query expression. The construct '{0}' was used in a query but is not recognized by the F#-to-LINQ query translator. Check the specification of permitted queries and consider moving some of the operations out of the query expression.</value>
</data>
<data name="maxDegreeOfParallelismNotPositive" xml:space="preserve">
<value>maxDegreeOfParallelism must be positive, was {0}</value>
</data>
</root>

12
src/fsharp/FSharp.Core/FSharp.Core.fsproj
Просмотреть файл

@ -4,8 +4,8 @@
<PropertyGroup>
<OutputType>Library</OutputType>
<TargetFrameworks>net45;netstandard1.6</TargetFrameworks>
<TargetFrameworks Condition="'$(OS)' == 'Unix'">netstandard1.6</TargetFrameworks>
<TargetFrameworks>net45;netstandard2.0</TargetFrameworks>
<TargetFrameworks Condition="'$(OS)' == 'Unix'">netstandard2.0</TargetFrameworks>
<NoWarn>$(NoWarn);45;55;62;75;1204</NoWarn>
<AllowCrossTargeting>true</AllowCrossTargeting>
<DefineConstants>$(DefineConstants);FSHARP_CORE</DefineConstants>
@ -113,9 +113,6 @@
<Compile Include="set.fs">
<Link>Collections/set.fs</Link>
</Compile>
<Compile Include="..\..\utils\reshapedreflection.fs">
<Link>Reflection/reshapedreflection.fs</Link>
</Compile>
<Compile Include="reflect.fsi">
<Link>Reflection/reflect.fsi</Link>
</Compile>
@ -217,11 +214,6 @@
<PackageReference Include="System.Threading.Tasks.Parallel" Version="$(SystemThreadingTasksParallelVersion)" />
</ItemGroup>
<ItemGroup Condition="'$(TargetFramework)' == 'netstandard1.6'">
<PackageReference Include="System.Threading.Thread" Version="$(SystemThreadingThreadVersion)" />
<PackageReference Include="System.Threading.ThreadPool" Version="$(SystemThreadingThreadPoolVersion)" />
</ItemGroup>
<!-- Hook compilation phase to do custom work -->
<!-- NOTE: The optdata and sigdata files are no longer needed by the F# compiler (the information is -->
<!-- integrated as resources into more recent FSharp.Core.dll's. However they are still produced to -->

9
src/fsharp/FSharp.Core/Linq.fs
Просмотреть файл

@ -162,11 +162,6 @@ open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Quotations.DerivedPatterns
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open ReflectionAdapters
#endif
module LeafExpressionConverter =
// The following is recognized as a LINQ 'member initialization pattern' in a quotation.
@ -219,11 +214,7 @@ module LeafExpressionConverter =
SubstHelperRaw(q, x, y) |> Expr.Cast
let showAll =
#if FX_RESHAPED_REFLECTION
true
#else
BindingFlags.Public ||| BindingFlags.NonPublic
#endif
let NullableConstructor =
typedefof<Nullable<int>>.GetConstructors().[0]

5
src/fsharp/FSharp.Core/Query.fs
Просмотреть файл

@ -302,11 +302,6 @@ open Microsoft.FSharp.Quotations.DerivedPatterns
open Microsoft.FSharp.Linq.QueryRunExtensions
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open ReflectionAdapters
#endif
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Query =

9
src/fsharp/FSharp.Core/QueryExtensions.fs
Просмотреть файл

@ -15,11 +15,6 @@ open System.Collections.Generic
open System.Linq
open System.Linq.Expressions
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open ReflectionAdapters
#endif
// ----------------------------------------------------------------------------
/// A type used to reconstruct a grouping after applying a mutable->immutable mapping transformation
@ -171,11 +166,7 @@ module internal Adapters =
let (|RecordFieldGetSimplification|_|) (expr:Expr) =
match expr with
| Patterns.PropertyGet(Some (Patterns.NewRecord(typ,els)),propInfo,[]) ->
#if FX_RESHAPED_REFLECTION
let fields = Microsoft.FSharp.Reflection.FSharpType.GetRecordFields(typ, true)
#else
let fields = Microsoft.FSharp.Reflection.FSharpType.GetRecordFields(typ,System.Reflection.BindingFlags.Public|||System.Reflection.BindingFlags.NonPublic)
#endif
match fields |> Array.tryFindIndex (fun p -> p = propInfo) with
| None -> None
| Some i -> if i < els.Length then Some els.[i] else None

11
src/fsharp/FSharp.Core/array.fs
Просмотреть файл

@ -10,9 +10,6 @@ namespace Microsoft.FSharp.Collections
open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Core.CompilerServices
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
#if FX_RESHAPED_REFLECTION
open System.Reflection
#endif
/// Basic operations on arrays
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
@ -191,11 +188,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("CountBy")>]
let countBy (projection: 'T->'Key) (array: 'T[]) =
checkNonNull "array" array
#if FX_RESHAPED_REFLECTION
if (typeof<'Key>).GetTypeInfo().IsValueType
#else
if typeof<'Key>.IsValueType
#endif
then countByValueType projection array
else countByRefType projection array
@ -445,11 +438,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("GroupBy")>]
let groupBy (projection: 'T->'Key) (array: 'T[]) =
checkNonNull "array" array
#if FX_RESHAPED_REFLECTION
if (typeof<'Key>).GetTypeInfo().IsValueType
#else
if typeof<'Key>.IsValueType
#endif
then groupByValueType projection array
else groupByRefType projection array

119
src/fsharp/FSharp.Core/async.fs
Просмотреть файл

@ -17,10 +17,6 @@ namespace Microsoft.FSharp.Control
open Microsoft.FSharp.Control
open Microsoft.FSharp.Collections
#if FX_RESHAPED_REFLECTION
open ReflectionAdapters
#endif
type LinkedSubSource(cancellationToken: CancellationToken) =
let failureCTS = new CancellationTokenSource()
@ -168,13 +164,11 @@ namespace Microsoft.FSharp.Control
let f = unbox<(unit -> AsyncReturn)> o
this.ExecuteWithTrampoline f |> unfake)
#if !FX_NO_PARAMETERIZED_THREAD_START
// Preallocate this delegate and keep it in the trampoline holder.
let threadStartCallbackForStartThreadWithTrampoline =
ParameterizedThreadStart (fun o ->
let f = unbox<(unit -> AsyncReturn)> o
this.ExecuteWithTrampoline f |> unfake)
#endif
/// Execute an async computation after installing a trampoline on its synchronous stack.
[<DebuggerHidden>]
@ -196,22 +190,10 @@ namespace Microsoft.FSharp.Control
| null -> this.QueueWorkItemWithTrampoline f
| _ -> this.PostWithTrampoline syncCtxt f
#if FX_NO_PARAMETERIZED_THREAD_START
// This should be the only call to Thread.Start in this library. We must always install a trampoline.
member this.StartThreadWithTrampoline (f: unit -> AsyncReturn) =
#if FX_NO_THREAD
this.QueueWorkItemWithTrampoline f
#else
(new Thread((fun _ -> this.Execute f |> unfake), IsBackground=true)).Start()
fake()
#endif
#else
// This should be the only call to Thread.Start in this library. We must always install a trampoline.
member __.StartThreadWithTrampoline (f: unit -> AsyncReturn) =
(new Thread(threadStartCallbackForStartThreadWithTrampoline, IsBackground=true)).Start(f|>box)
fake()
#endif
/// Save the exception continuation during propagation of an exception, or prior to raising an exception
member inline __.OnExceptionRaised econt =
@ -731,12 +713,7 @@ namespace Microsoft.FSharp.Control
match resEvent with
| null -> ()
| ev ->
#if FX_NO_EVENTWAITHANDLE_IDISPOSABLE
ev.Dispose()
System.GC.SuppressFinalize ev
#else
ev.Close()
#endif
resEvent <- null)
interface IDisposable with
@ -824,15 +801,7 @@ namespace Microsoft.FSharp.Control
| None ->
// OK, let's really wait for the Set signal. This may block.
let timeout = defaultArg timeout Threading.Timeout.Infinite
#if FX_NO_EXIT_CONTEXT_FLAGS
#if FX_NO_WAITONE_MILLISECONDS
let ok = resHandle.WaitOne(TimeSpan(int64 timeout*10000L))
#else
let ok = resHandle.WaitOne(millisecondsTimeout= timeout)
#endif
#else
let ok = resHandle.WaitOne(millisecondsTimeout= timeout, exitContext=true)
#endif
if ok then
// Now the result really must be available
result
@ -1196,7 +1165,13 @@ namespace Microsoft.FSharp.Control
async { let! cancellationToken = cancellationTokenAsync
return AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions }
static member Parallel (computations: seq<Async<'T>>) =
static member Parallel (computations: seq<Async<'T>>) = Async.Parallel(computations, ?maxDegreeOfParallelism=None)
static member Parallel (computations: seq<Async<'T>>, ?maxDegreeOfParallelism: int) =
match maxDegreeOfParallelism with
| Some x when x < 1 -> raise(System.ArgumentException(String.Format(SR.GetString(SR.maxDegreeOfParallelismNotPositive), x), "maxDegreeOfParallelism"))
| _ -> ()
MakeAsync (fun ctxt ->
let tasks, result =
try
@ -1251,19 +1226,61 @@ namespace Microsoft.FSharp.Control
| _ -> ()
finishTask(Interlocked.Decrement &count)
tasks |> Array.iteri (fun i p ->
QueueAsync
// If maxDegreeOfParallelism is set but is higher then the number of tasks we have we set it back to None to fall into the simple
// queue all items branch
let maxDegreeOfParallelism =
match maxDegreeOfParallelism with
| None -> None
| Some maxDegreeOfParallelism -> if maxDegreeOfParallelism >= tasks.Length then None else Some maxDegreeOfParallelism
// Simple case (no maxDegreeOfParallelism) just queue all the work, if we have maxDegreeOfParallelism set we start that many workers
// which will make progress on the actual computations
match maxDegreeOfParallelism with
| None ->
tasks |> Array.iteri (fun i p ->
QueueAsync
innerCTS.Token
// on success, record the result
(fun res -> recordSuccess i res)
// on exception...
(fun edi -> recordFailure (Choice1Of2 edi))
// on cancellation...
(fun cexn -> recordFailure (Choice2Of2 cexn))
p
|> unfake)
| Some maxDegreeOfParallelism ->
let mutable i = -1
let worker = MakeAsync (fun _ ->
while i < tasks.Length do
let j = Interlocked.Increment &i
if j < tasks.Length then
let trampolineHolder = new TrampolineHolder()
trampolineHolder.ExecuteWithTrampoline (fun () ->
let ctxt =
AsyncActivation.Create
innerCTS.Token
trampolineHolder
(fun res -> recordSuccess j res)
(fun edi -> recordFailure (Choice1Of2 edi))
(fun cexn -> recordFailure (Choice2Of2 cexn))
tasks.[j].Invoke ctxt
)
|> unfake
fake()
)
for x = 1 to maxDegreeOfParallelism do
QueueAsync
innerCTS.Token
// on success, record the result
(fun res -> recordSuccess i res)
// on exception...
(fun _ -> fake())
(fun edi -> recordFailure (Choice1Of2 edi))
// on cancellation...
(fun cexn -> recordFailure (Choice2Of2 cexn))
p
|> unfake)
worker
|> unfake
fake()))
static member Sequential (computations: seq<Async<'T>>) = Async.Parallel(computations, maxDegreeOfParallelism=1)
static member Choice(computations: Async<'T option> seq) : Async<'T option> =
MakeAsync (fun ctxt ->
let result =
@ -1385,15 +1402,7 @@ namespace Microsoft.FSharp.Control
let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite
if millisecondsTimeout = 0 then
async.Delay(fun () ->
#if FX_NO_EXIT_CONTEXT_FLAGS
#if FX_NO_WAITONE_MILLISECONDS
let ok = waitHandle.WaitOne(TimeSpan 0L)
#else
let ok = waitHandle.WaitOne 0
#endif
#else
let ok = waitHandle.WaitOne(0, exitContext=false)
#endif
async.Return ok)
else
CreateDelimitedUserCodeAsync(fun ctxt ->
@ -1683,12 +1692,7 @@ namespace Microsoft.FSharp.Control
member stream.AsyncRead(buffer: byte[], ?offset, ?count) =
let offset = defaultArg offset 0
let count = defaultArg count buffer.Length
#if FX_NO_BEGINEND_READWRITE
// use combo CreateDelimitedUserCodeAsync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task
CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith (stream.ReadAsync(buffer, offset, count, ctxt.aux.token)) ctxt false)
#else
Async.FromBeginEnd (buffer, offset, count, stream.BeginRead, stream.EndRead)
#endif
[<CompiledName("AsyncReadBytes")>] // give the extension member a 'nice', unmangled compiled name, unique within this module
member stream.AsyncRead count =
@ -1705,12 +1709,7 @@ namespace Microsoft.FSharp.Control
member stream.AsyncWrite(buffer:byte[], ?offset:int, ?count:int) =
let offset = defaultArg offset 0
let count = defaultArg count buffer.Length
#if FX_NO_BEGINEND_READWRITE
// use combo CreateDelimitedUserCodeAsync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task
CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false)
#else
Async.FromBeginEnd (buffer, offset, count, stream.BeginWrite, stream.EndWrite)
#endif
type IObservable<'Args> with
@ -1746,8 +1745,6 @@ namespace Microsoft.FSharp.Control
| _ ->
None)
#if !FX_NO_WEB_CLIENT
type System.Net.WebClient with
member inline private this.Download(event: IEvent<'T, _>, handler: _ -> 'T, start, result) =
let downloadAsync =
@ -1799,5 +1796,3 @@ namespace Microsoft.FSharp.Control
start = (fun userToken -> this.DownloadFileAsync(address, fileName, userToken)),
result = (fun _ -> ())
)
#endif

33
src/fsharp/FSharp.Core/async.fsi
Просмотреть файл

@ -161,6 +161,35 @@ namespace Microsoft.FSharp.Control
/// <returns>A computation that returns an array of values from the sequence of input computations.</returns>
static member Parallel : computations:seq<Async<'T>> -> Async<'T[]>
/// <summary>Creates an asynchronous computation that executes all the given asynchronous computations,
/// initially queueing each as work items and using a fork/join pattern.</summary>
///
/// <remarks>If all child computations succeed, an array of results is passed to the success continuation.
///
/// If any child computation raises an exception, then the overall computation will trigger an
/// exception, and cancel the others.
///
/// The overall computation will respond to cancellation while executing the child computations.
/// If cancelled, the computation will cancel any remaining child computations but will still wait
/// for the other child computations to complete.</remarks>
/// <param name="computations">A sequence of distinct computations to be parallelized.</param>
/// <returns>A computation that returns an array of values from the sequence of input computations.</returns>
static member Parallel : computations:seq<Async<'T>> * ?maxDegreeOfParallelism : int -> Async<'T[]>
/// <summary>Creates an asynchronous computation that executes all the given asynchronous computations sequentially.</summary>
///
/// <remarks>If all child computations succeed, an array of results is passed to the success continuation.
///
/// If any child computation raises an exception, then the overall computation will trigger an
/// exception, and cancel the others.
///
/// The overall computation will respond to cancellation while executing the child computations.
/// If cancelled, the computation will cancel any remaining child computations but will still wait
/// for the other child computations to complete.</remarks>
/// <param name="computations">A sequence of distinct computations to be run in sequence.</param>
/// <returns>A computation that returns an array of values from the sequence of input computations.</returns>
static member Sequential : computations:seq<Async<'T>> -> Async<'T[]>
/// <summary>Creates an asynchronous computation that executes all given asynchronous computations in parallel,
/// returning the result of the first succeeding computation (one whose result is 'Some x').
/// If all child computations complete with None, the parent computation also returns None.</summary>
@ -739,8 +768,7 @@ namespace Microsoft.FSharp.Control
/// <returns>An asynchronous computation that waits for response to the <c>WebRequest</c>.</returns>
[<CompiledName("AsyncGetResponse")>] // give the extension member a nice, unmangled compiled name, unique within this module
member AsyncGetResponse : unit -> Async<System.Net.WebResponse>
#if !FX_NO_WEB_CLIENT
type System.Net.WebClient with
/// <summary>Returns an asynchronous computation that, when run, will wait for the download of the given URI.</summary>
@ -761,7 +789,6 @@ namespace Microsoft.FSharp.Control
/// <returns>An asynchronous computation that will wait for the download of the URI to specified file.</returns>
[<CompiledName("AsyncDownloadFile")>] // give the extension member a nice, unmangled compiled name, unique within this module
member AsyncDownloadFile : address:System.Uri * fileName: string -> Async<unit>
#endif
// Internals used by MailboxProcessor
module internal AsyncBuilderImpl =

4
src/fsharp/FSharp.Core/event.fs
Просмотреть файл

@ -11,10 +11,6 @@ namespace Microsoft.FSharp.Control
open System.Reflection
open System.Diagnostics
#if FX_RESHAPED_REFLECTION
open ReflectionAdapters
#endif
[<CompiledName("FSharpDelegateEvent`1")>]
type DelegateEvent<'Delegate when 'Delegate :> System.Delegate>() =
let mutable multicast : System.Delegate = null

8
src/fsharp/FSharp.Core/fslib-extra-pervasives.fs
Просмотреть файл

@ -166,21 +166,13 @@ module ExtraTopLevelOperators =
[<CompiledName("CreateDictionary")>]
let dict (keyValuePairs:seq<'Key*'T>) : IDictionary<'Key,'T> =
#if FX_RESHAPED_REFLECTION
if (typeof<'Key>).GetTypeInfo().IsValueType
#else
if typeof<'Key>.IsValueType
#endif
then dictValueType keyValuePairs :> _
else dictRefType keyValuePairs :> _
[<CompiledName("CreateReadOnlyDictionary")>]
let readOnlyDict (keyValuePairs:seq<'Key*'T>) : IReadOnlyDictionary<'Key,'T> =
#if FX_RESHAPED_REFLECTION
if (typeof<'Key>).GetTypeInfo().IsValueType
#else
if typeof<'Key>.IsValueType
#endif
then dictValueType keyValuePairs :> _
else dictRefType keyValuePairs :> _

11
src/fsharp/FSharp.Core/list.fs
Просмотреть файл

@ -9,9 +9,6 @@ namespace Microsoft.FSharp.Collections
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Core.CompilerServices
open System.Collections.Generic
#if FX_RESHAPED_REFLECTION
open System.Reflection
#endif
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
@ -71,11 +68,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("CountBy")>]
let countBy (projection:'T->'Key) (list:'T list) =
#if FX_RESHAPED_REFLECTION
if (typeof<'Key>).GetTypeInfo().IsValueType
#else
if typeof<'Key>.IsValueType
#endif
then countByValueType projection list
else countByRefType projection list
@ -446,11 +439,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("GroupBy")>]
let groupBy (projection:'T->'Key) (list:'T list) =
#if FX_RESHAPED_REFLECTION
if (typeof<'Key>).GetTypeInfo().IsValueType
#else
if typeof<'Key>.IsValueType
#endif
then groupByValueType projection list
else groupByRefType projection list

20
src/fsharp/FSharp.Core/map.fs
Просмотреть файл

@ -446,21 +446,19 @@ module MapTree =
[<CompiledName("FSharpMap`2")>]
type Map<[<EqualityConditionalOn>]'Key, [<EqualityConditionalOn; ComparisonConditionalOn>]'Value when 'Key : comparison >(comparer: IComparer<'Key>, tree: MapTree<'Key, 'Value>) =
#if !FX_NO_BINARY_SERIALIZATION
[<System.NonSerialized>]
// This type is logically immutable. This field is only mutated during deserialization.
let mutable comparer = comparer
// This type is logically immutable. This field is only mutated during deserialization.
let mutable comparer = comparer
[<System.NonSerialized>]
// This type is logically immutable. This field is only mutated during deserialization.
let mutable tree = tree
// This type is logically immutable. This field is only mutated during deserialization.
let mutable tree = tree
// This type is logically immutable. This field is only mutated during serialization and deserialization.
// This type is logically immutable. This field is only mutated during serialization and deserialization.
//
// WARNING: The compiled name of this field may never be changed because it is part of the logical
// WARNING: The compiled name of this field may never be changed because it is part of the logical
// WARNING: permanent serialization format for this type.
let mutable serializedData = null
#endif
let mutable serializedData = null
// We use .NET generics per-instantiation static fields to avoid allocating a new object for each empty
// set (it is just a lookup into a .NET table of type-instantiation-indexed static fields).
@ -468,7 +466,6 @@ type Map<[<EqualityConditionalOn>]'Key, [<EqualityConditionalOn; ComparisonCondi
let comparer = LanguagePrimitives.FastGenericComparer<'Key>
new Map<'Key, 'Value>(comparer, MapTree<_, _>.MapEmpty)
#if !FX_NO_BINARY_SERIALIZATION
[<System.Runtime.Serialization.OnSerializingAttribute>]
member __.OnSerializing(context: System.Runtime.Serialization.StreamingContext) =
ignore context
@ -483,9 +480,8 @@ type Map<[<EqualityConditionalOn>]'Key, [<EqualityConditionalOn; ComparisonCondi
member __.OnDeserialized(context: System.Runtime.Serialization.StreamingContext) =
ignore context
comparer <- LanguagePrimitives.FastGenericComparer<'Key>
tree <- serializedData |> Array.map (fun (KeyValue(k, v)) -> (k, v)) |> MapTree.ofArray comparer
tree <- serializedData |> Array.map (fun (KeyValue(k, v)) -> (k, v)) |> MapTree.ofArray comparer
serializedData <- null
#endif
static member Empty : Map<'Key, 'Value> =
empty

229
src/fsharp/FSharp.Core/prim-types.fs
Просмотреть файл

@ -374,29 +374,6 @@ namespace Microsoft.FSharp.Core
/// <summary>Represents a out-argument managed pointer in F# code. This type should only be used with F# 4.5+.</summary>
type outref<'T> = byref<'T, ByRefKinds.Out>
#if FX_RESHAPED_REFLECTION
module PrimReflectionAdapters =
open System.Reflection
open System.Linq
// copied from BasicInlinedOperations
let inline box (x:'T) = (# "box !0" type ('T) x : obj #)
let inline unboxPrim<'T>(x:obj) = (# "unbox.any !0" type ('T) x : 'T #)
type System.Type with
member inline this.IsGenericType = this.GetTypeInfo().IsGenericType
member inline this.IsValueType = this.GetTypeInfo().IsValueType
member inline this.IsSealed = this.GetTypeInfo().IsSealed
member inline this.IsAssignableFrom(otherType: Type) = this.GetTypeInfo().IsAssignableFrom(otherType.GetTypeInfo())
member inline this.GetGenericArguments() = this.GetTypeInfo().GenericTypeArguments
member inline this.GetProperty(name) = this.GetRuntimeProperty(name)
member inline this.GetMethod(name, parameterTypes) = this.GetRuntimeMethod(name, parameterTypes)
member inline this.GetCustomAttributes(attributeType: Type, inherits: bool) : obj[] =
unboxPrim<_> (box (CustomAttributeExtensions.GetCustomAttributes(this.GetTypeInfo(), attributeType, inherits).ToArray()))
open PrimReflectionAdapters
#endif
module internal BasicInlinedOperations =
let inline unboxPrim<'T>(x:obj) = (# "unbox.any !0" type ('T) x : 'T #)
let inline box (x:'T) = (# "box !0" type ('T) x : obj #)
@ -548,12 +525,8 @@ namespace Microsoft.FSharp.Core
ignore obj // pretend the variable is used
let e = new System.ArgumentException(ErrorStrings.AddressOpNotFirstClassString)
(# "throw" (e :> System.Exception) : nativeptr<'T> #)
open IntrinsicOperators
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
#endif
[<CodeAnalysis.SuppressMessage("Microsoft.Design", "CA1034:NestedTypesShouldNotBeVisible")>] // nested module OK
module IntrinsicFunctions =
@ -881,78 +854,6 @@ namespace Microsoft.FSharp.Core
/// specialcase: Core implementation of structural comparison on arbitrary arrays.
and GenericComparisonArbArrayWithComparer (comp:GenericComparer) (x:System.Array) (y:System.Array) : int =
#if FX_NO_ARRAY_LONG_LENGTH
if x.Rank = 1 && y.Rank = 1 then
let lenx = x.Length
let leny = y.Length
let c = intOrder lenx leny
if c <> 0 then c else
let basex = (x.GetLowerBound(0))
let basey = (y.GetLowerBound(0))
let c = intOrder basex basey
if c <> 0 then c else
let rec check i =
if i >= lenx then 0 else
let c = GenericCompare comp ((x.GetValue(i + basex)),(y.GetValue(i + basey)))
if c <> 0 then c else check (i + 1)
check 0
elif x.Rank = 2 && y.Rank = 2 then
let lenx0 = x.GetLength(0)
let leny0 = y.GetLength(0)
let c = intOrder lenx0 leny0
if c <> 0 then c else
let lenx1 = x.GetLength(1)
let leny1 = y.GetLength(1)
let c = intOrder lenx1 leny1
if c <> 0 then c else
let basex0 = (x.GetLowerBound(0))
let basex1 = (x.GetLowerBound(1))
let basey0 = (y.GetLowerBound(0))
let basey1 = (y.GetLowerBound(1))
let c = intOrder basex0 basey0
if c <> 0 then c else
let c = intOrder basex1 basey1
if c <> 0 then c else
let rec check0 i =
let rec check1 j =
if j >= lenx1 then 0 else
let c = GenericCompare comp ((x.GetValue(i + basex0,j + basex1)), (y.GetValue(i + basey0,j + basey1)))
if c <> 0 then c else check1 (j + 1)
if i >= lenx0 then 0 else
let c = check1 0
if c <> 0 then c else
check0 (i + 1)
check0 0
else
let c = intOrder x.Rank y.Rank
if c <> 0 then c else
let ndims = x.Rank
// check lengths
let rec precheck k =
if k >= ndims then 0 else
let c = intOrder (x.GetLength(k)) (y.GetLength(k))
if c <> 0 then c else
let c = intOrder (x.GetLowerBound(k)) (y.GetLowerBound(k))
if c <> 0 then c else
precheck (k+1)
let c = precheck 0
if c <> 0 then c else
let idxs : int[] = zeroCreate ndims
let rec checkN k baseIdx i lim =
if i >= lim then 0 else
set idxs k (baseIdx + i)
let c =
if k = ndims - 1
then GenericCompare comp ((x.GetValue(idxs)), (y.GetValue(idxs)))
else check (k+1)
if c <> 0 then c else
checkN k baseIdx (i + 1) lim
and check k =
if k >= ndims then 0 else
let baseIdx = x.GetLowerBound(k)
checkN k baseIdx 0 (x.GetLength(k))
check 0
#else
if x.Rank = 1 && y.Rank = 1 then
let lenx = x.LongLength
let leny = y.LongLength
@ -985,11 +886,11 @@ namespace Microsoft.FSharp.Core
let c = int64Order basex1 basey1
if c <> 0 then c else
let rec check0 i =
let rec check1 j =
let rec check1 j =
if j >=. lenx1 then 0 else
let c = GenericCompare comp ((x.GetValue(i +. basex0,j +. basex1)), (y.GetValue(i +. basey0,j +. basey1)))
if c <> 0 then c else check1 (j +. 1L)
if i >=. lenx0 then 0 else
if i >=. lenx0 then 0 else
let c = check1 0L
if c <> 0 then c else
check0 (i +. 1L)
@ -998,8 +899,8 @@ namespace Microsoft.FSharp.Core
let c = intOrder x.Rank y.Rank
if c <> 0 then c else
let ndims = x.Rank
// check lengths
let rec precheck k =
// check lengths
let rec precheck k =
if k >= ndims then 0 else
let c = int64Order (x.GetLongLength(k)) (y.GetLongLength(k))
if c <> 0 then c else
@ -1023,10 +924,9 @@ namespace Microsoft.FSharp.Core
let baseIdx = x.GetLowerBound(k)
checkN k (int64 baseIdx) 0L (x.GetLongLength(k))
check 0
#endif
/// optimized case: Core implementation of structural comparison on object arrays.
and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int =
and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int =
let lenx = x.Length
let leny = y.Length
let c = intOrder lenx leny
@ -1035,8 +935,8 @@ namespace Microsoft.FSharp.Core
let mutable i = 0
let mutable res = 0
while i < lenx do
let c = GenericCompare comp ((get x i), (get y i))
if c <> 0 then (res <- c; i <- lenx)
let c = GenericCompare comp ((get x i), (get y i))
if c <> 0 then (res <- c; i <- lenx)
else i <- i + 1
res
@ -1058,7 +958,7 @@ namespace Microsoft.FSharp.Core
type GenericComparer with
interface System.Collections.IComparer with
override c.Compare(x:obj,y:obj) = GenericCompare c (x,y)
/// The unique object for comparing values in PER mode (where local exceptions are thrown when NaNs are compared)
let fsComparerPER = GenericComparer(true)
@ -1403,63 +1303,6 @@ namespace Microsoft.FSharp.Core
/// specialcase: Core implementation of structural equality on arbitrary arrays.
and GenericEqualityArbArray er (iec:System.Collections.IEqualityComparer) (x:System.Array) (y:System.Array) : bool =
#if FX_NO_ARRAY_LONG_LENGTH
if x.Rank = 1 && y.Rank = 1 then
// check lengths
let lenx = x.Length
let leny = y.Length
(int32Eq lenx leny) &&
// check contents
let basex = x.GetLowerBound(0)
let basey = y.GetLowerBound(0)
(int32Eq basex basey) &&
let rec check i = (i >= lenx) || (GenericEqualityObj er iec ((x.GetValue(basex + i)),(y.GetValue(basey + i))) && check (i + 1))
check 0
elif x.Rank = 2 && y.Rank = 2 then
// check lengths
let lenx0 = x.GetLength(0)
let leny0 = y.GetLength(0)
(int32Eq lenx0 leny0) &&
let lenx1 = x.GetLength(1)
let leny1 = y.GetLength(1)
(int32Eq lenx1 leny1) &&
let basex0 = x.GetLowerBound(0)
let basex1 = x.GetLowerBound(1)
let basey0 = y.GetLowerBound(0)
let basey1 = y.GetLowerBound(1)
(int32Eq basex0 basey0) &&
(int32Eq basex1 basey1) &&
// check contents
let rec check0 i =
let rec check1 j = (j >= lenx1) || (GenericEqualityObj er iec ((x.GetValue(basex0 + i,basex1 + j)), (y.GetValue(basey0 + i,basey1 + j))) && check1 (j + 1))
(i >= lenx0) || (check1 0 && check0 (i + 1))
check0 0
else
(x.Rank = y.Rank) &&
let ndims = x.Rank
// check lengths
let rec precheck k =
(k >= ndims) ||
(int32Eq (x.GetLength(k)) (y.GetLength(k)) &&
int32Eq (x.GetLowerBound(k)) (y.GetLowerBound(k)) &&
precheck (k+1))
precheck 0 &&
let idxs : int32[] = zeroCreate ndims
// check contents
let rec checkN k baseIdx i lim =
(i >= lim) ||
(set idxs k (baseIdx + i);
(if k = ndims - 1
then GenericEqualityObj er iec ((x.GetValue(idxs)),(y.GetValue(idxs)))
else check (k+1)) &&
checkN k baseIdx (i + 1) lim)
and check k =
(k >= ndims) ||
(let baseIdx = x.GetLowerBound(k)
checkN k baseIdx 0 (x.GetLength(k)))
check 0
#else
if x.Rank = 1 && y.Rank = 1 then
// check lengths
let lenx = x.LongLength
@ -1468,9 +1311,9 @@ namespace Microsoft.FSharp.Core
// check contents
let basex = int64 (x.GetLowerBound(0))
let basey = int64 (y.GetLowerBound(0))
(int64Eq basex basey) &&
(int64Eq basex basey) &&
let rec check i = (i >=. lenx) || (GenericEqualityObj er iec ((x.GetValue(basex +. i)),(y.GetValue(basey +. i))) && check (i +. 1L))
check 0L
check 0L
elif x.Rank = 2 && y.Rank = 2 then
// check lengths
let lenx0 = x.GetLongLength(0)
@ -1491,16 +1334,16 @@ namespace Microsoft.FSharp.Core
(i >=. lenx0) || (check1 0L && check0 (i +. 1L))
check0 0L
else
(x.Rank = y.Rank) &&
(x.Rank = y.Rank) &&
let ndims = x.Rank
// check lengths
let rec precheck k =
(k >= ndims) ||
(int64Eq (x.GetLongLength(k)) (y.GetLongLength(k)) &&
int32Eq (x.GetLowerBound(k)) (y.GetLowerBound(k)) &&
// check lengths
let rec precheck k =
(k >= ndims) ||
(int64Eq (x.GetLongLength(k)) (y.GetLongLength(k)) &&
int32Eq (x.GetLowerBound(k)) (y.GetLowerBound(k)) &&
precheck (k+1))
precheck 0 &&
let idxs : int64[] = zeroCreate ndims
let idxs : int64[] = zeroCreate ndims
// check contents
let rec checkN k baseIdx i lim =
(i >=. lim) ||
@ -1513,10 +1356,8 @@ namespace Microsoft.FSharp.Core
(k >= ndims) ||
(let baseIdx = x.GetLowerBound(k)
checkN k (int64 baseIdx) 0L (x.GetLongLength(k)))
check 0
#endif
/// optimized case: Core implementation of structural equality on object arrays.
and GenericEqualityObjArray er iec (x:obj[]) (y:obj[]) : bool =
let lenx = x.Length
@ -2958,7 +2799,6 @@ namespace Microsoft.FSharp.Core
[<CodeAnalysis.SuppressMessage("Microsoft.Usage", "CA2225:OperatorOverloadsHaveNamedAlternates")>]
static member op_Implicit(func : ('T -> 'Res) ) = new System.Func<'T,'Res>(func)
#if !FX_NO_CONVERTER
[<CodeAnalysis.SuppressMessage("Microsoft.Usage", "CA2225:OperatorOverloadsHaveNamedAlternates")>]
static member op_Implicit(f : System.Converter<_,_>) : ('T -> 'Res) = (fun t -> f.Invoke(t))
@ -2968,7 +2808,6 @@ namespace Microsoft.FSharp.Core
static member FromConverter (converter: System.Converter<_,_>) : ('T -> 'Res) = (fun t -> converter.Invoke(t))
static member ToConverter (func: ('T -> 'Res) ) = new System.Converter<'T,'Res>(func)
#endif
static member InvokeFast (func:FSharpFunc<_,_>, arg1: 'T, arg2: 'Res) = OptimizedClosures.invokeFast2(func, arg1, arg2)
@ -2984,9 +2823,7 @@ namespace Microsoft.FSharp.Core
static member inline ToFSharpFunc (action: Action<_>) = (fun t -> action.Invoke(t))
#if !FX_NO_CONVERTER
static member inline ToFSharpFunc (converter : Converter<_,_>) = (fun t -> converter.Invoke(t))
#endif
// Note: this is not made public in the signature, because of conflicts with the Converter overload.
// The method remains in case someone is calling it via reflection.
@ -4266,26 +4103,12 @@ namespace Microsoft.FSharp.Core
module Attributes =
open System.Runtime.CompilerServices
#if !FX_NO_DEFAULT_DEPENDENCY_TYPE
[<assembly: System.Runtime.CompilerServices.DefaultDependency(System.Runtime.CompilerServices.LoadHint.Always)>]
#endif
#if !FX_NO_COMVISIBLE
[<assembly: System.Runtime.InteropServices.ComVisible(false)>]
#endif
[<assembly: System.CLSCompliant(true)>]
#if BE_SECURITY_TRANSPARENT
[<assembly: System.Security.SecurityTransparent>] // assembly is fully transparent
#if CROSS_PLATFORM_COMPILER
#else
[<assembly: System.Security.SecurityRules(System.Security.SecurityRuleSet.Level2)>] // v4 transparency; soon to be the default, but not yet
#endif
#else
#if !FX_NO_SECURITY_PERMISSIONS
// REVIEW: Need to choose a specific permission for the action to be applied to
[<assembly: System.Security.Permissions.SecurityPermission(System.Security.Permissions.SecurityAction.RequestMinimum)>]
#endif
#endif
do ()
@ -4317,6 +4140,9 @@ namespace Microsoft.FSharp.Core
[<CompiledName("TypeOf")>]
let inline typeof<'T> = BasicInlinedOperations.typeof<'T>
[<CompiledName("NameOf")>]
let inline nameof (_: 'T) : string = raise (Exception "may not call directly, should always be optimized away")
[<CompiledName("MethodHandleOf")>]
let methodhandleof (_call: ('T -> 'TResult)) : System.RuntimeMethodHandle = raise (Exception "may not call directly, should always be optimized away")
@ -4649,13 +4475,10 @@ namespace Microsoft.FSharp.Core
when ^T : unativeint = (# "conv.ovf.i.un" value : nativeint #)
when ^T : byte = (# "conv.ovf.i.un" value : nativeint #)
module OperatorIntrinsics =
module OperatorIntrinsics =
open System.Collections
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
#endif
let notStarted() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationNotStarted)))
let alreadyFinished() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished)))

23
src/fsharp/FSharp.Core/prim-types.fsi
Просмотреть файл

@ -1342,20 +1342,6 @@ namespace Microsoft.FSharp.Core
[<CompilerMessage("This function is a primitive library routine used by optimized F# code and should not be used directly", 1204, IsHidden=true)>]
val inline FastCompareTuple5 : comparer:System.Collections.IComparer -> tuple1:('T1 * 'T2 * 'T3 * 'T4 * 'T5) -> tuple2:('T1 * 'T2 * 'T3 * 'T4 * 'T5) -> int
#if FX_RESHAPED_REFLECTION
module internal PrimReflectionAdapters =
open System.Reflection
type System.Type with
member inline IsGenericType : bool
member inline IsValueType : bool
member inline GetMethod : string * parameterTypes : Type[] -> MethodInfo
member inline GetProperty : string -> PropertyInfo
member inline IsAssignableFrom : otherType : Type -> bool
member inline GetCustomAttributes : attributeType : Type * inherits: bool -> obj[]
#endif
//-------------------------------------------------------------------------
// F# Choice Types
@ -1503,8 +1489,6 @@ namespace Microsoft.FSharp.Core
/// <returns>'U</returns>
abstract member Invoke : func:'T -> 'U
#if !FX_NO_CONVERTER
/// <summary>Convert an F# first class function value to a value of type <c>System.Converter</c></summary>
/// <param name="func">The input function.</param>
/// <returns>A System.Converter of the function type.</returns>
@ -1524,7 +1508,6 @@ namespace Microsoft.FSharp.Core
/// <param name="converter">The input System.Converter.</param>
/// <returns>An F# function of the same type.</returns>
static member FromConverter : converter:System.Converter<'T,'U> -> ('T -> 'U)
#endif
/// <summary>Invoke an F# first class function value with five curried arguments. In some cases this
/// will result in a more efficient application than applying the arguments successively.</summary>
@ -1575,12 +1558,10 @@ namespace Microsoft.FSharp.Core
/// <returns>The F# function.</returns>
static member inline ToFSharpFunc : action:Action<'T> -> ('T -> unit)
#if !FX_NO_CONVERTER
/// <summary>Convert the given Converter delegate object to an F# function value</summary>
/// <param name="converter">The input Converter delegate.</param>
/// <returns>The F# function.</returns>
static member inline ToFSharpFunc : converter:Converter<'T,'U> -> ('T -> 'U)
#endif
/// <summary>Convert the given Action delegate object to an F# function value</summary>
/// <param name="func">The input Action delegate.</param>
@ -2418,6 +2399,10 @@ namespace Microsoft.FSharp.Core
[<CompiledName("TypeOf")>]
val inline typeof<'T> : System.Type
/// <summary>Returns the name of the given symbol.</summary>
[<CompiledName("NameOf")>]
val inline nameof : 'T -> string
/// <summary>An internal, library-only compiler intrinsic for compile-time
/// generation of a RuntimeMethodHandle.</summary>
[<CompiledName("MethodHandleOf")>]

9
src/fsharp/FSharp.Core/printf.fs
Просмотреть файл

@ -47,11 +47,6 @@ module internal PrintfImpl =
open Microsoft.FSharp.Collections
open LanguagePrimitives.IntrinsicOperators
#if FX_RESHAPED_REFLECTION
open Microsoft.FSharp.Core.PrimReflectionAdapters
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
open System.IO
[<Flags>]
@ -1070,12 +1065,8 @@ module internal PrintfImpl =
static member GenericToString<'T>(spec: FormatSpecifier) =
let bindingFlags =
#if FX_RESHAPED_REFLECTION
isPlusForPositives spec.Flags // true - show non-public
#else
if isPlusForPositives spec.Flags then BindingFlags.Public ||| BindingFlags.NonPublic
else BindingFlags.Public
#endif
let useZeroWidth = isPadWithZeros spec.Flags
let opts =

57
src/fsharp/FSharp.Core/quotations.fs
Просмотреть файл

@ -20,11 +20,6 @@ open Microsoft.FSharp.Text.StructuredPrintfImpl.TaggedTextOps
#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open ReflectionAdapters
#endif
//--------------------------------------------------------------------------
// RAW quotations - basic data types
//--------------------------------------------------------------------------
@ -56,11 +51,7 @@ module Helpers =
let staticBindingFlags = BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
let staticOrInstanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
#if FX_RESHAPED_REFLECTION
let publicOrPrivateBindingFlags = true
#else
let publicOrPrivateBindingFlags = BindingFlags.Public ||| BindingFlags.NonPublic
#endif
let isDelegateType (typ:Type) =
if typ.IsSubclassOf(typeof<Delegate>) then
@ -989,11 +980,7 @@ module Patterns =
let resT = instFormal tyargTs rty
let methInfo =
try
#if FX_RESHAPED_REFLECTION
match parentT.GetMethod(nm, argTs) with
#else
match parentT.GetMethod(nm, staticOrInstanceBindingFlags, null, argTs, null) with
#endif
| null -> None
| res -> Some res
with :? AmbiguousMatchException -> None
@ -1021,11 +1008,7 @@ module Patterns =
let tyArgs = List.toArray tyArgs
let methInfo =
try
#if FX_RESHAPED_REFLECTION
match ty.GetMethod(nm, argTypes) with
#else
match ty.GetMethod(nm, staticOrInstanceBindingFlags, null, argTypes, null) with
#endif
| null -> None
| res -> Some res
with :? AmbiguousMatchException -> None
@ -1138,21 +1121,13 @@ module Patterns =
| _ -> null
| ctor -> ctor
let bindProp (tc, propName, retType, argTypes, tyargs) =
// We search in the instantiated type, rather than searching the generic type.
let typ = mkNamedType (tc, tyargs)
let argtyps : Type list = argTypes |> inst tyargs
let retType : Type = retType |> inst tyargs |> removeVoid
#if FX_RESHAPED_REFLECTION
try
typ.GetProperty(propName, staticOrInstanceBindingFlags)
with :? AmbiguousMatchException -> null // more than one property found with the specified name and matching binding constraints - return null to initiate manual search
|> bindPropBySearchIfCandidateIsNull typ propName retType (Array.ofList argtyps)
|> checkNonNullResult ("propName", String.Format(SR.GetString(SR.QfailedToBindProperty), propName)) // fxcop may not see "propName" as an arg
#else
typ.GetProperty(propName, staticOrInstanceBindingFlags, null, retType, Array.ofList argtyps, null) |> checkNonNullResult ("propName", String.Format(SR.GetString(SR.QfailedToBindProperty), propName)) // fxcop may not see "propName" as an arg
#endif
let bindField (tc, fldName, tyargs) =
let typ = mkNamedType (tc, tyargs)
typ.GetField(fldName, staticOrInstanceBindingFlags) |> checkNonNullResult ("fldName", String.Format(SR.GetString(SR.QfailedToBindField), fldName)) // fxcop may not see "fldName" as an arg
@ -1163,26 +1138,12 @@ module Patterns =
let bindGenericCtor (tc:Type, argTypes:Instantiable<Type list>) =
let argtyps = instFormal (getGenericArguments tc) argTypes
#if FX_RESHAPED_REFLECTION
let argTypes = Array.ofList argtyps
tc.GetConstructor argTypes
|> bindCtorBySearchIfCandidateIsNull tc argTypes
|> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))
#else
tc.GetConstructor(instanceBindingFlags, null, Array.ofList argtyps, null) |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))
#endif
let bindCtor (tc, argTypes:Instantiable<Type list>, tyargs) =
let typ = mkNamedType (tc, tyargs)
let argtyps = argTypes |> inst tyargs
#if FX_RESHAPED_REFLECTION
let argTypes = Array.ofList argtyps
typ.GetConstructor argTypes
|> bindCtorBySearchIfCandidateIsNull typ argTypes
|> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))
#else
typ.GetConstructor(instanceBindingFlags, null, Array.ofList argtyps, null) |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))
#endif
let chop n xs =
if n < 0 then invalidArg "n" (SR.GetString(SR.inputMustBeNonNegative))
@ -1358,11 +1319,7 @@ module Patterns =
if a = "" then mscorlib
elif a = "." then st.localAssembly
else
#if FX_RESHAPED_REFLECTION
match System.Reflection.Assembly.Load(AssemblyName a) with
#else
match System.Reflection.Assembly.Load a with
#endif
| null -> raise <| System.InvalidOperationException(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString()))
| assembly -> assembly
@ -1684,14 +1641,6 @@ module Patterns =
let decodedTopResources = new Dictionary<Assembly * string, int>(10, HashIdentity.Structural)
#if FX_NO_REFLECTION_MODULE_HANDLES // not available on Silverlight
[<StructuralEquality;StructuralComparison>]
type ModuleHandle = ModuleHandle of string * string
type System.Reflection.Module with
member x.ModuleHandle = ModuleHandle(x.Assembly.FullName, x.Name)
#else
type ModuleHandle = System.ModuleHandle
#endif
[<StructuralEquality; NoComparison>]
type ReflectedDefinitionTableKey =
@ -1735,11 +1684,7 @@ module Patterns =
not (decodedTopResources.ContainsKey((assem, resourceName))) then
let cmaAttribForResource =
#if FX_RESHAPED_REFLECTION
CustomAttributeExtensions.GetCustomAttributes(assem, typeof<CompilationMappingAttribute>) |> Seq.toArray
#else
assem.GetCustomAttributes(typeof<CompilationMappingAttribute>, false)
#endif
|> (function null -> [| |] | x -> x)
|> Array.tryPick (fun ca ->
match ca with

70
src/fsharp/FSharp.Core/reflect.fs
Просмотреть файл

@ -27,11 +27,6 @@ module internal ReflectionUtils =
[<AutoOpen>]
module internal Impl =
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open ReflectionAdapters
#endif
let getBindingFlags allowAccess = ReflectionUtils.toBindingFlags (defaultArg allowAccess false)
let inline checkNonNull argName (v: 'T) =
@ -56,31 +51,18 @@ module internal Impl =
//-----------------------------------------------------------------
// GENERAL UTILITIES
#if FX_RESHAPED_REFLECTION
let instanceFieldFlags = BindingFlags.Instance
let instancePropertyFlags = BindingFlags.Instance
let staticPropertyFlags = BindingFlags.Static
let staticFieldFlags = BindingFlags.Static
let staticMethodFlags = BindingFlags.Static
#else
let instanceFieldFlags = BindingFlags.GetField ||| BindingFlags.Instance
let instancePropertyFlags = BindingFlags.GetProperty ||| BindingFlags.Instance
let staticPropertyFlags = BindingFlags.GetProperty ||| BindingFlags.Static
let staticFieldFlags = BindingFlags.GetField ||| BindingFlags.Static
let staticMethodFlags = BindingFlags.Static
#endif
let getInstancePropertyInfo (typ: Type, propName, bindingFlags) = typ.GetProperty(propName, instancePropertyFlags ||| bindingFlags)
let getInstancePropertyInfos (typ, names, bindingFlags) = names |> Array.map (fun nm -> getInstancePropertyInfo (typ, nm, bindingFlags))
let getInstancePropertyReader (typ: Type, propName, bindingFlags) =
match getInstancePropertyInfo(typ, propName, bindingFlags) with
| null -> None
#if FX_RESHAPED_REFLECTION
| prop -> Some(fun (obj: obj) -> prop.GetValue (obj, null))
#else
| prop -> Some(fun (obj: obj) -> prop.GetValue (obj, instancePropertyFlags ||| bindingFlags, null, null, null))
#endif
//-----------------------------------------------------------------
// ATTRIBUTE DECOMPILATION
@ -95,7 +77,6 @@ module internal Impl =
| None -> failwith "no compilation mapping attribute"
| Some a -> a
#if !FX_NO_REFLECTION_ONLY
let cmaName = typeof<CompilationMappingAttribute>.FullName
let assemblyName = typeof<CompilationMappingAttribute>.Assembly.GetName().Name
let _ = assert (assemblyName = "FSharp.Core")
@ -121,33 +102,26 @@ module internal Impl =
match tryFindCompilationMappingAttributeFromData attrs with
| None -> failwith "no compilation mapping attribute"
| Some a -> a
#endif
let tryFindCompilationMappingAttributeFromType (typ: Type) =
#if !FX_NO_REFLECTION_ONLY
let assem = typ.Assembly
if (not (isNull assem)) && assem.ReflectionOnly then
tryFindCompilationMappingAttributeFromData ( typ.GetCustomAttributesData())
else
#endif
tryFindCompilationMappingAttribute ( typ.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))
let tryFindCompilationMappingAttributeFromMemberInfo (info: MemberInfo) =
#if !FX_NO_REFLECTION_ONLY
let assem = info.DeclaringType.Assembly
if (not (isNull assem)) && assem.ReflectionOnly then
tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData())
else
#endif
tryFindCompilationMappingAttribute (info.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))
let findCompilationMappingAttributeFromMemberInfo (info: MemberInfo) =
#if !FX_NO_REFLECTION_ONLY
let assem = info.DeclaringType.Assembly
if (not (isNull assem)) && assem.ReflectionOnly then
findCompilationMappingAttributeFromData (info.GetCustomAttributesData())
else
#endif
findCompilationMappingAttribute (info.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))
let sequenceNumberOfMember (x: MemberInfo) = let (_, n, _) = findCompilationMappingAttributeFromMemberInfo x in n
@ -285,11 +259,8 @@ module internal Impl =
let getUnionCaseRecordReader (typ: Type, tag: int, bindingFlags) =
let props = fieldsPropsOfUnionCase (typ, tag, bindingFlags)
#if FX_RESHAPED_REFLECTION
(fun (obj: obj) -> props |> Array.map (fun prop -> prop.GetValue (obj, null)))
#else
(fun (obj: obj) -> props |> Array.map (fun prop -> prop.GetValue (obj, bindingFlags, null, null, null)))
#endif
let getUnionTagReader (typ: Type, bindingFlags) : (obj -> int) =
if isOptionType typ then
(fun (obj: obj) -> match obj with null -> 0 | _ -> 1)
@ -302,20 +273,12 @@ module internal Impl =
| Some reader -> (fun (obj: obj) -> reader obj :?> int)
| None ->
(fun (obj: obj) ->
#if FX_RESHAPED_REFLECTION
let m2b = typ.GetMethod("GetTag", [| typ |])
#else
let m2b = typ.GetMethod("GetTag", BindingFlags.Static ||| bindingFlags, null, [| typ |], null)
#endif
m2b.Invoke(null, [|obj|]) :?> int)
let getUnionTagMemberInfo (typ: Type, bindingFlags) =
match getInstancePropertyInfo (typ, "Tag", bindingFlags) with
#if FX_RESHAPED_REFLECTION
| null -> (typ.GetMethod("GetTag") :> MemberInfo)
#else
| null -> (typ.GetMethod("GetTag", BindingFlags.Static ||| bindingFlags) :> MemberInfo)
#endif
| info -> (info :> MemberInfo)
let isUnionCaseNullary (typ: Type, tag: int, bindingFlags) =
@ -335,11 +298,8 @@ module internal Impl =
let getUnionCaseConstructor (typ: Type, tag: int, bindingFlags) =
let meth = getUnionCaseConstructorMethod (typ, tag, bindingFlags)
(fun args ->
#if FX_RESHAPED_REFLECTION
meth.Invoke(null, args))
#else
meth.Invoke(null, BindingFlags.Static ||| BindingFlags.InvokeMethod ||| bindingFlags, null, args, null))
#endif
let checkUnionType (unionType, bindingFlags) =
checkNonNull "unionType" unionType
if not (isUnionType (unionType, bindingFlags)) then
@ -513,18 +473,10 @@ module internal Impl =
let ctor =
if typ.IsValueType then
let fields = typ.GetFields (instanceFieldFlags ||| BindingFlags.Public) |> orderTupleFields
#if FX_RESHAPED_REFLECTION
typ.GetConstructor(fields |> Array.map (fun fi -> fi.FieldType))
#else
typ.GetConstructor(BindingFlags.Public ||| BindingFlags.Instance, null, fields |> Array.map (fun fi -> fi.FieldType), null)
#endif
else
let props = typ.GetProperties() |> orderTupleProperties
#if FX_RESHAPED_REFLECTION
typ.GetConstructor(props |> Array.map (fun p -> p.PropertyType))
#else
typ.GetConstructor(BindingFlags.Public ||| BindingFlags.Instance, null, props |> Array.map (fun p -> p.PropertyType), null)
#endif
match ctor with
| null -> raise (ArgumentException (String.Format (SR.GetString (SR.invalidTupleTypeConstructorNotDefined), typ.FullName)))
| _ -> ()
@ -533,11 +485,7 @@ module internal Impl =
let getTupleCtor(typ: Type) =
let ctor = getTupleConstructorMethod typ
(fun (args: obj[]) ->
#if FX_RESHAPED_REFLECTION
ctor.Invoke args)
#else
ctor.Invoke(BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public, null, args, null))
#endif
let rec getTupleReader (typ: Type) =
let etys = typ.GetGenericArguments()
@ -639,11 +587,7 @@ module internal Impl =
let getRecordConstructorMethod(typ: Type, bindingFlags) =
let props = fieldPropsOfRecordType(typ, bindingFlags)
#if FX_RESHAPED_REFLECTION
let ctor = typ.GetConstructor(props |> Array.map (fun p -> p.PropertyType))
#else
let ctor = typ.GetConstructor(BindingFlags.Instance ||| bindingFlags, null, props |> Array.map (fun p -> p.PropertyType), null)
#endif
match ctor with
| null -> raise <| ArgumentException (String.Format (SR.GetString (SR.invalidRecordTypeConstructorNotDefined), typ.FullName))
| _ -> ()
@ -652,11 +596,7 @@ module internal Impl =
let getRecordConstructor(typ: Type, bindingFlags) =
let ctor = getRecordConstructorMethod(typ, bindingFlags)
(fun (args: obj[]) ->
#if FX_RESHAPED_REFLECTION
ctor.Invoke args)
#else
ctor.Invoke(BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| bindingFlags, null, args, null))
#endif
/// EXCEPTION DECOMPILATION
// Check the base type - if it is also an F# type then
@ -703,10 +643,6 @@ module internal Impl =
if not (isTupleType tupleType) then
invalidArg argName (String.Format (SR.GetString (SR.notATupleType), tupleType.FullName))
#if FX_RESHAPED_REFLECTION
open ReflectionAdapters
#endif
[<Sealed>]
type UnionCaseInfo(typ: System.Type, tag: int) =

8
src/fsharp/FSharp.Core/seq.fs
Просмотреть файл

@ -1071,11 +1071,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("GroupBy")>]
let groupBy (projection:'T->'Key) (source:seq<'T>) =
#if FX_RESHAPED_REFLECTION
if (typeof<'Key>).GetTypeInfo().IsValueType
#else
if typeof<'Key>.IsValueType
#endif
then mkDelayedSeq (fun () -> groupByValueType projection source)
else mkDelayedSeq (fun () -> groupByRefType projection source)
@ -1164,11 +1160,7 @@ namespace Microsoft.FSharp.Collections
let countBy (projection:'T->'Key) (source:seq<'T>) =
checkNonNull "source" source
#if FX_RESHAPED_REFLECTION
if (typeof<'Key>).GetTypeInfo().IsValueType
#else
if typeof<'Key>.IsValueType
#endif
then mkDelayedSeq (fun () -> countByValueType projection source)
else mkDelayedSeq (fun () -> countByRefType projection source)

25
src/fsharp/FSharp.Core/set.fs
Просмотреть файл

@ -512,23 +512,20 @@ module internal SetTree =
[<DebuggerTypeProxy(typedefof<SetDebugView<_>>)>]
[<DebuggerDisplay("Count = {Count}")>]
[<CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1710:IdentifiersShouldHaveCorrectSuffix")>]
type Set<[<EqualityConditionalOn>]'T when 'T: comparison >(comparer:IComparer<'T>, tree: SetTree<'T>) =
#if !FX_NO_BINARY_SERIALIZATION
[<System.NonSerialized>]
// NOTE: This type is logically immutable. This field is only mutated during deserialization.
let mutable comparer = comparer
type Set<[<EqualityConditionalOn>]'T when 'T: comparison >(comparer:IComparer<'T>, tree: SetTree<'T>) =
[<System.NonSerialized>]
// NOTE: This type is logically immutable. This field is only mutated during deserialization.
let mutable tree = tree
// NOTE: This type is logically immutable. This field is only mutated during deserialization.
let mutable comparer = comparer
// NOTE: This type is logically immutable. This field is only mutated during serialization and deserialization.
//
// WARNING: The compiled name of this field may never be changed because it is part of the logical
[<System.NonSerialized>]
// NOTE: This type is logically immutable. This field is only mutated during deserialization.
let mutable tree = tree
// NOTE: This type is logically immutable. This field is only mutated during serialization and deserialization.
// WARNING: The compiled name of this field may never be changed because it is part of the logical
// WARNING: permanent serialization format for this type.
let mutable serializedData = null
#endif
let mutable serializedData = null
// We use .NET generics per-instantiation static fields to avoid allocating a new object for each empty
// set (it is just a lookup into a .NET table of type-instantiation-indexed static fields).
@ -537,7 +534,6 @@ type Set<[<EqualityConditionalOn>]'T when 'T: comparison >(comparer:IComparer<'T
let comparer = LanguagePrimitives.FastGenericComparer<'T>
Set<'T>(comparer, SetEmpty)
#if !FX_NO_BINARY_SERIALIZATION
[<System.Runtime.Serialization.OnSerializingAttribute>]
member __.OnSerializing(context: System.Runtime.Serialization.StreamingContext) =
ignore context
@ -554,7 +550,6 @@ type Set<[<EqualityConditionalOn>]'T when 'T: comparison >(comparer:IComparer<'T
comparer <- LanguagePrimitives.FastGenericComparer<'T>
tree <- SetTree.ofArray comparer serializedData
serializedData <- null
#endif
[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member internal set.Comparer = comparer

5
src/fsharp/FSharp.Core/xlf/FSCore.cs.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">Toto není platný výraz dotazu. V dotazu byla použita konstrukce {0}, která není rozpoznána překladačem dotazu z jazyka F# do jazyka LINQ. Prostudujte si specifikace povolených dotazů a zvažte přesunutí některých operací mimo výraz dotazu.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">Hodnota maxDegreeOfParallelism musí být kladná, ale vyskytla se hodnota {0}.</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.de.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">Dies ist kein gültiger Abfrageausdruck. Das Konstrukt "{0}" wurde in einer Abfrage verwendet, wird jedoch vom F#-to-LINQ-Abfragekonvertierungsprogramm nicht erkannt. Überprüfen Sie die Spezifikation zulässiger Abfragen, und entfernen Sie unter Umständen einige Operationen aus dem Abfrageausdruck.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism muss positiv sein, lautete jedoch "{0}".</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.es.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">Esta no es una expresión de consulta válida. La construcción '{0}' se usó en una consulta, pero el traductor de consultas F#-to-LINQ no la reconoce. Compruebe la especificación de consultas permitidas y considere mover algunas de las operaciones fuera de la expresión de consulta.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism debe ser positivo, era {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.fr.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">Cette expression de requête n'est pas valide. La construction '{0}' a été utilisée dans une requête, mais n'est pas reconnue par le traducteur de requête F#-to-LINQ. Vérifiez la spécification des requêtes autorisées et envisagez de retirer certaines opérations de l'expression de requête.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism doit être positif, était {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.it.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">Espressione di query non valida. Il costrutto '{0}' è stato utilizzato in una query ma non è stato riconosciuto dal traduttore di query da F# a LINQ. Verificare le specifiche delle query consentite e provare a spostare alcune operazioni all'esterno dell'espressione di query.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">Il valore di maxDegreeOfParallelism deve essere positivo. È {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.ja.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">これは有効なクエリ式ではありません。クエリで構造 '{0}' が使用されていますが、F# から LINQ へのクエリ トランスレーターに認識されません。許可されたクエリの仕様を確認し、一部の操作をクエリ式の外に移動することを検討してください。</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism には正の値を指定する必要がありますが、{0} が指定されました</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.ko.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">올바른 쿼리 식이 아닙니다. '{0}' 구문이 쿼리에 사용되었지만 F#-to-LINQ 쿼리 변환기에서 인식할 수 없습니다. 허용되는 쿼리의 사양을 확인하고 일부 연산을 쿼리 식 외부로 이동하세요.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism은 양수여야 하는데 {0}였습니다.</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.pl.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">To nie jest prawidłowe wyrażenie zapytania. Konstrukcja „{0}” została użyta w zapytaniu, ale nie rozpoznaje jej translator zapytań z języka F# na język LINQ. Sprawdź specyfikacje dozwolonych zapytań i rozważ przeniesienie niektórych operacji poza wyrażenie zapytania.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">Wartość maxDegreeOfParallelism musi być dodatnia, a była równa {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.pt-BR.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">Expressão de consulta inválida. A construção '{0}' foi usada em uma consulta, mas não é reconhecida pelo conversor de consultas F#-to-LINQ. Verifique a especificação de consultas permitidas e considere remover algumas das operações da expressão de consulta.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism deve ser positivo, foi {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.ru.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">Недопустимое выражение запроса. Конструкция "{0}" использовалась запросе, но не была распознана транслятором запросов из F# в LINQ. Проверьте спецификацию разрешенных запросов и попробуйте вынести часть операций за пределы выражения запроса.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">Параметр maxDegreeOfParallelism должен иметь положительное значение, указано значение {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.tr.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">Bu geçerli bir sorgu ifadesi değil. '{0}' yapısı sorguda kullanıldı, ancak F#-to-LINQ çevirmeni tarafından tanınmıyor. İzin verilen soruların belirtimini denetleyin ve işlemlerden bazılarını sorgu ifadesinin dışına taşımayı düşünün.</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism pozitif olmalıdır, değeri: {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

5
src/fsharp/FSharp.Core/xlf/FSCore.zh-Hans.xlf
Просмотреть файл

@ -707,6 +707,11 @@
<target state="translated">这不是有效的查询表达式。查询中使用了构造“{0}”，但 F#-LINQ 查询转换器无法识别该构造。请查看有效查询的规范，考虑是否将部分运算移到查询表达式之外。</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism 必须是正数，它之前是 {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

7
src/fsharp/FSharp.Core/xlf/FSCore.zh-Hant.xlf
Просмотреть файл

@ -564,7 +564,7 @@
</trans-unit>
<trans-unit id="printfBadIntegerForDynamicFomatter">
<source>Bad integer supplied to dynamic formatter</source>
<target state="translated">提供給動態格式子的整數錯誤</target>
<target state="translated">提供給動態格式器的整數錯誤</target>
<note />
</trans-unit>
<trans-unit id="printfExpectedPrecision">
@ -707,6 +707,11 @@
<target state="translated">這不是有效的查詢運算式。查詢中使用了建構 '{0}'，但 F#-to-LINQ 查詢翻譯工具無法加以辨認。請檢查所允許之查詢的規格，並考慮將一些運算移出查詢運算式。</target>
<note />
</trans-unit>
<trans-unit id="maxDegreeOfParallelismNotPositive">
<source>maxDegreeOfParallelism must be positive, was {0}</source>
<target state="translated">maxDegreeOfParallelism 必須為正數，原先為 {0}</target>
<note />
</trans-unit>
</body>
</file>
</xliff>

7
src/fsharp/IlxGen.fs
Просмотреть файл

@ -7444,13 +7444,10 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) =
mkLdarg 2us
mkNormalCall (mkILCtorMethSpecForTy (g.iltyp_Exception, [serializationInfoType; streamingContextType])) ],
None))
//#if BE_SECURITY_TRANSPARENT
[ilCtorDefForSerialziation]
//#else
(*
let getObjectDataMethodForSerialization =
let ilMethodDef =
mkILNonGenericVirtualMethod
("GetObjectData", ILMemberAccess.Public,
@ -7478,7 +7475,7 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) =
| _ -> []
let ilTypeName = tref.Name
let interfaces = exnc.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenv.tyenv)
let tdef =
mkILGenericClass

98
src/fsharp/LanguageFeatures.fs Normal file
Просмотреть файл

@ -0,0 +1,98 @@
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
/// Coordinating compiler operations - configuration, loading initial context, reporting errors etc.
module internal FSharp.Compiler.Features
open System
//------------------------------------------------------------------------------------------------------------------
// Language version command line switch
//------------------------------------------------------------------------------------------------------------------
// Add your features to this List - in code use languageVersion.SupportsFeature(LanguageFeatures.yourFeature)
// a return value of false means your feature is not supported by the user's language selection
// All new language features added from now on must be protected by this.
// Note:
// * The fslang design process will require a decision about feature name and whether it is required.
// * When a feature is assigned a release language, we will scrub the code of feature references and apply
// the Release Language version.
/// LanguageFeature enumeration
[<RequireQualifiedAccess>]
type LanguageFeature =
| PreviewVersion = 0
| LanguageVersion46 = 1
| LanguageVersion47 = 2
| SingleUnderscorePattern = 3
| WildCardInForLoop = 4
| RelaxWhitespace = 5
| NameOf = 6
| ImplicitYield = 7
| OpenStaticClasses = 8
/// LanguageVersion management
type LanguageVersion (specifiedVersion) =
// When we increment language versions here preview is higher than current RTM version
static let languageVersion46 = 4.6m
static let languageVersion47 = 4.7m
static let previewVersion = 9999m // Language version when preview specified
static let defaultVersion = languageVersion47 // Language version when default specified
static let latestVersion = defaultVersion // Language version when latest specified
static let latestMajorVersion = languageVersion46 // Language version when latestmajor specified
static let validOptions = [| "preview"; "default"; "latest"; "latestmajor" |]
static let languageVersions = set [| languageVersion46; languageVersion47 |]
static let features = dict [|
// Add new LanguageVersions here ...
LanguageFeature.LanguageVersion46, languageVersion46
LanguageFeature.LanguageVersion47, languageVersion47
LanguageFeature.PreviewVersion, previewVersion
LanguageFeature.SingleUnderscorePattern, languageVersion47
LanguageFeature.WildCardInForLoop, languageVersion47
LanguageFeature.RelaxWhitespace, languageVersion47
LanguageFeature.NameOf, previewVersion
LanguageFeature.ImplicitYield, languageVersion47
LanguageFeature.OpenStaticClasses, previewVersion
|]
let specified =
match specifiedVersion with
| "?" -> 0m
| "preview" -> previewVersion
| "default" -> latestVersion
| "latest" -> latestVersion
| "latestmajor" -> latestMajorVersion
| _ ->
match Decimal.TryParse(specifiedVersion) with
| true, v -> v
| _ -> 0m
/// Check if this feature is supported by the selected langversion
member __.SupportsFeature featureId =
match features.TryGetValue featureId with
| true, v -> v <= specified
| false, _ -> false
/// Does the languageVersion support this version string
member __.ContainsVersion version =
match version with
| "?" | "preview" | "default" | "latest" | "latestmajor" -> true
| _ ->
match Decimal.TryParse(specifiedVersion) with
| true, v -> languageVersions.Contains v
| _ -> false
/// Get a list of valid strings for help text
member __.ValidOptions = validOptions
/// Get a list of valid versions for help text
member __.ValidVersions = [|
for v in languageVersions |> Seq.sort do
let label = if v = defaultVersion then " (Default)" else ""
yield sprintf "%M%s" v label
|]
/// Get the specified LanguageVersion
member __.SpecifiedVerson = specified

39
src/fsharp/LanguageFeatures.fsi Normal file
Просмотреть файл

@ -0,0 +1,39 @@
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
/// Coordinating compiler operations - configuration, loading initial context, reporting errors etc.
module internal FSharp.Compiler.Features
/// LanguageFeature enumeration
[<RequireQualifiedAccess>]
type LanguageFeature =
| PreviewVersion = 0
| LanguageVersion46 = 1
| LanguageVersion47 = 2
| SingleUnderscorePattern = 3
| WildCardInForLoop = 4
| RelaxWhitespace = 5
| NameOf = 6
| ImplicitYield = 7
| OpenStaticClasses = 8
/// LanguageVersion management
type LanguageVersion =
/// Create a LanguageVersion management object
new: string -> LanguageVersion
/// Get the list of valid versions
member ContainsVersion: string -> bool
/// Does the specified LanguageVersion support the specified feature
member SupportsFeature: LanguageFeature -> bool
/// Get the list of valid versions
member ValidVersions: string array
/// Get the list of valid options
member ValidOptions: string array
/// Get the specified LanguageVersion
member SpecifiedVerson: decimal

16
src/fsharp/LexFilter.fs
Просмотреть файл

@ -12,9 +12,9 @@ open FSharp.Compiler.AbstractIL.Internal.Library
open FSharp.Compiler.AbstractIL.Diagnostics
open FSharp.Compiler.Ast
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Parser
open FSharp.Compiler.Lexhelp
let debug = false
let stringOfPos (p: Position) = sprintf "(%d:%d)" p.OriginalLine p.Column
@ -764,8 +764,17 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// 'type C = class ... ' limited by 'type'
// 'type C = interface ... ' limited by 'type'
// 'type C = struct ... ' limited by 'type'
| _, (CtxtParen ((CLASS | STRUCT | INTERFACE), _) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _)
-> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1)
| _, (CtxtParen ((CLASS | STRUCT | INTERFACE), _) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _)
-> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1)
// 'type C(' limited by 'type'
| _, (CtxtSeqBlock _ :: CtxtParen(LPAREN, _) :: (CtxtTypeDefns _ as limitCtxt) :: _ )
// 'static member C(' limited by 'static', likewise others
| _, (CtxtSeqBlock _ :: CtxtParen(LPAREN, _) :: (CtxtMemberHead _ as limitCtxt) :: _ )
// 'static member P with get() = ' limited by 'static', likewise others
| _, (CtxtWithAsLet _ :: (CtxtMemberHead _ as limitCtxt) :: _ )
when lexbuf.SupportsFeature LanguageFeature.RelaxWhitespace
-> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1)
// REVIEW: document these
| _, (CtxtSeqBlock _ :: CtxtParen((BEGIN | LPAREN | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _)
@ -780,6 +789,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// else expr
| (CtxtIf _ | CtxtElse _ | CtxtThen _), (CtxtIf _ as limitCtxt) :: _rest
-> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol)
// Permitted inner-construct precise block alignment:
// while ...
// do expr

13
src/fsharp/MethodCalls.fs
Просмотреть файл

@ -938,6 +938,19 @@ let TakeObjAddrForMethodCall g amap (minfo: MethInfo) isMutable m objArgs f =
let hasCallInfo = ccallInfo.IsSome
let mustTakeAddress = hasCallInfo || minfo.ObjArgNeedsAddress(amap, m)
let objArgTy = tyOfExpr g objArgExpr
let isMutable =
match isMutable with
| DefinitelyMutates
| NeverMutates
| AddressOfOp -> isMutable
| PossiblyMutates ->
// Check to see if the method is read-only. Perf optimization.
// If there is an extension member whose first arg is an inref, we must return NeverMutates.
if mustTakeAddress && (minfo.IsReadOnly || minfo.IsReadOnlyExtensionMember (amap, m)) then
NeverMutates
else
isMutable
let wrap, objArgExprAddr, isReadOnly, _isWriteOnly =
mkExprAddrOfExpr g mustTakeAddress hasCallInfo isMutable objArgExpr None m

470
src/fsharp/NameResolution.fs
Просмотреть файл

@ -24,6 +24,7 @@ open FSharp.Compiler.AttributeChecking
open FSharp.Compiler.InfoReader
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.Text
open FSharp.Compiler.Features
open System.Collections.Generic
#if !NO_EXTENSIONTYPING
@ -35,6 +36,7 @@ type NameResolver(g: TcGlobals,
amap: Import.ImportMap,
infoReader: InfoReader,
instantiationGenerator: (range -> Typars -> TypeInst)) =
/// Used to transform typars into new inference typars
// instantiationGenerator is a function to help us create the
// type parameters by copying them from type parameter specifications read
@ -49,6 +51,7 @@ type NameResolver(g: TcGlobals,
member nr.g = g
member nr.amap = amap
member nr.InfoReader = infoReader
member nr.languageSupportsNameOf = g.langVersion.SupportsFeature LanguageFeature.NameOf
//-------------------------------------------------------------------------
// Helpers for unionconstrs and recdfields
@ -78,7 +81,6 @@ let ActivePatternElemsOfValRef vref =
| Some apinfo -> apinfo.ActiveTags |> List.mapi (fun i _ -> APElemRef(apinfo, vref, i))
| None -> []
/// Try to make a reference to a value in a module.
//
// mkNestedValRef may fail if the assembly load set is
@ -314,6 +316,7 @@ type FullyQualifiedFlag =
| OpenQualified
type UnqualifiedItems = LayeredMap<string, Item>
[<NoEquality; NoComparison>]
/// The environment of information used to resolve names
@ -321,8 +324,8 @@ type NameResolutionEnv =
{ /// Display environment information for output
eDisplayEnv: DisplayEnv
/// Values and Data Tags available by unqualified name
eUnqualifiedItems: LayeredMap<string, Item>
/// Values, functions, methods and other items available by unqualified name
eUnqualifiedItems: UnqualifiedItems
/// Data Tags and Active Pattern Tags available by unqualified name
ePatItems: NameMap<Item>
@ -417,6 +420,12 @@ type NameResolutionEnv =
// Helpers to do with extension members
//-------------------------------------------------------------------------
/// Indicates if we only need one result or all possible results from a resolution.
[<RequireQualifiedAccess>]
type ResultCollectionSettings =
| AllResults
| AtMostOneResult
/// Allocate the next extension method priority. This is an incrementing sequence of integers
/// during type checking.
let NextExtensionMethodPriority() = uint64 (newStamp())
@ -488,6 +497,125 @@ let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap: Import.Impor
[]
/// Query the declared properties of a type (including inherited properties)
let IntrinsicPropInfosOfTypeInScope (infoReader: InfoReader) optFilter ad findFlag m ty =
let g = infoReader.g
let amap = infoReader.amap
let pinfos = GetIntrinsicPropInfoSetsOfType infoReader optFilter ad AllowMultiIntfInstantiations.Yes findFlag m ty
let pinfos = pinfos |> ExcludeHiddenOfPropInfos g amap m
pinfos
/// Select from a list of extension properties
let SelectPropInfosFromExtMembers (infoReader: InfoReader) ad optFilter declaringTy m extMemInfos =
let g = infoReader.g
let amap = infoReader.amap
// NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers, hence use a set.
let seen = HashSet(ExtensionMember.Comparer g)
let propCollector = new PropertyCollector(g, amap, m, declaringTy, optFilter, ad)
for emem in extMemInfos do
if seen.Add emem then
match emem with
| FSExtMem (vref, _pri) ->
match vref.MemberInfo with
| None -> ()
| Some membInfo -> propCollector.Collect(membInfo, vref)
| ILExtMem _ ->
// No extension properties coming from .NET
()
propCollector.Close()
/// Query the available extension properties of a type (including extension properties for inherited types)
let ExtensionPropInfosOfTypeInScope collectionSettings (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter ad m ty =
let g = infoReader.g
let extMemsDangling = SelectPropInfosFromExtMembers infoReader ad optFilter ty m nenv.eUnindexedExtensionMembers
if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then
extMemsDangling
else
let extMemsFromHierarchy =
infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes, m, ty)
|> List.collect (fun ty ->
if isAppTy g ty then
let tcref = tcrefOfAppTy g ty
let extMemInfos = nenv.eIndexedExtensionMembers.Find tcref
SelectPropInfosFromExtMembers infoReader ad optFilter ty m extMemInfos
else [])
extMemsDangling @ extMemsFromHierarchy
/// Get all the available properties of a type (both intrinsic and extension)
let AllPropInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad findFlag m ty =
IntrinsicPropInfosOfTypeInScope infoReader optFilter ad findFlag m ty
@ ExtensionPropInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad m ty
/// Get the available methods of a type (both declared and inherited)
let IntrinsicMethInfosOfType (infoReader:InfoReader) optFilter ad allowMultiIntfInst findFlag m ty =
let g = infoReader.g
let amap = infoReader.amap
let minfos = GetIntrinsicMethInfoSetsOfType infoReader optFilter ad allowMultiIntfInst findFlag m ty
let minfos = minfos |> ExcludeHiddenOfMethInfos g amap m
minfos
/// Select from a list of extension methods
let SelectMethInfosFromExtMembers (infoReader:InfoReader) optFilter apparentTy m extMemInfos =
let g = infoReader.g
// NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers
let seen = HashSet(ExtensionMember.Comparer g)
[
for emem in extMemInfos do
if seen.Add emem then
match emem with
| FSExtMem (vref, pri) ->
match vref.MemberInfo with
| None -> ()
| Some membInfo ->
match TrySelectMemberVal g optFilter apparentTy (Some pri) membInfo vref with
| Some m -> yield m
| _ -> ()
| ILExtMem (actualParent, minfo, pri) when (match optFilter with None -> true | Some nm -> nm = minfo.LogicalName) ->
// Make a reference to the type containing the extension members
match minfo with
| ILMeth(_, ilminfo, _) ->
yield (MethInfo.CreateILExtensionMeth (infoReader.amap, m, apparentTy, actualParent, Some pri, ilminfo.RawMetadata))
// F#-defined IL-style extension methods are not seen as extension methods in F# code
| FSMeth(g, _, vref, _) ->
yield (FSMeth(g, apparentTy, vref, Some pri))
#if !NO_EXTENSIONTYPING
// // Provided extension methods are not yet supported
| ProvidedMeth(amap, providedMeth, _, m) ->
yield (ProvidedMeth(amap, providedMeth, Some pri, m))
#endif
| DefaultStructCtor _ ->
()
| _ -> ()
]
/// Query the available extension properties of a methods (including extension methods for inherited types)
let ExtensionMethInfosOfTypeInScope (collectionSettings:ResultCollectionSettings) (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter m ty =
let extMemsDangling = SelectMethInfosFromExtMembers infoReader optFilter ty m nenv.eUnindexedExtensionMembers
if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then
extMemsDangling
else
let extMemsFromHierarchy =
infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes, m, ty)
|> List.collect (fun ty ->
let g = infoReader.g
if isAppTy g ty then
let tcref = tcrefOfAppTy g ty
let extValRefs = nenv.eIndexedExtensionMembers.Find tcref
SelectMethInfosFromExtMembers infoReader optFilter ty m extValRefs
else [])
extMemsDangling @ extMemsFromHierarchy
/// Get all the available methods of a type (both intrinsic and extension)
let AllMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad findFlag m ty =
let intrinsic = IntrinsicMethInfosOfType infoReader optFilter ad AllowMultiIntfInstantiations.Yes findFlag m ty
if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil intrinsic) then
intrinsic
else
intrinsic @ ExtensionMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter m ty
//-------------------------------------------------------------------------
// Helpers to do with building environments
//-------------------------------------------------------------------------
@ -504,7 +632,7 @@ type BulkAdd = Yes | No
/// bulkAddMode: true when adding the values from the 'open' of a namespace
/// or module, when we collapse the value table down to a dictionary.
let AddValRefsToItems (bulkAddMode: BulkAdd) (eUnqualifiedItems: LayeredMap<_, _>) (vrefs: ValRef[]) =
let AddValRefsToItems (bulkAddMode: BulkAdd) (eUnqualifiedItems: UnqualifiedItems) (vrefs: ValRef[]) =
// Object model members are not added to the unqualified name resolution environment
let vrefs = vrefs |> Array.filter (fun vref -> not vref.IsMember)
@ -616,7 +744,7 @@ let AddUnionCases1 (tab: Map<_, _>) (ucrefs: UnionCaseRef list) =
acc.Add (ucref.CaseName, item))
/// Add a set of union cases to the corresponding sub-table of the environment
let AddUnionCases2 bulkAddMode (eUnqualifiedItems: LayeredMap<_, _>) (ucrefs: UnionCaseRef list) =
let AddUnionCases2 bulkAddMode (eUnqualifiedItems: UnqualifiedItems) (ucrefs: UnionCaseRef list) =
match bulkAddMode with
| BulkAdd.Yes ->
let items =
@ -630,8 +758,46 @@ let AddUnionCases2 bulkAddMode (eUnqualifiedItems: LayeredMap<_, _>) (ucrefs: Un
let item = Item.UnionCase(GeneralizeUnionCaseRef ucref, false)
acc.Add (ucref.CaseName, item))
let AddStaticContentOfTyconRefToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (tcref:TyconRef) =
// If OpenStaticClasses is not enabled then don't do this
if amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses then
let ty = generalizedTyconRef tcref
let infoReader = InfoReader(g,amap)
let items =
[| let methGroups =
AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty
|> List.groupBy (fun m -> m.LogicalName)
for (methName, methGroup) in methGroups do
let methGroup = methGroup |> List.filter (fun m -> not m.IsInstance && not m.IsClassConstructor)
if not methGroup.IsEmpty then
yield KeyValuePair(methName, Item.MethodGroup(methName, methGroup, None))
let propInfos =
AllPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty
|> List.groupBy (fun m -> m.PropertyName)
for (propName, propInfos) in propInfos do
let propInfos = propInfos |> List.filter (fun m -> m.IsStatic)
for propInfo in propInfos do
yield KeyValuePair(propName , Item.Property(propName,[propInfo]))
let fields =
infoReader.GetILFieldInfosOfType(None, ad, m, ty)
|> List.groupBy (fun f -> f.FieldName)
for (fieldName, fieldInfos) in fields do
let fieldInfos = fieldInfos |> List.filter (fun fi -> fi.IsStatic)
for fieldInfo in fieldInfos do
yield KeyValuePair(fieldName, Item.ILField(fieldInfo))
|]
{ nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items }
else
nenv
/// Add any implied contents of a type definition to the environment.
let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap m nenv (tcref: TyconRef) =
let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) =
let isIL = tcref.IsILTycon
let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef
@ -679,10 +845,14 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals)
| _ -> Item.UnqualifiedType [tcref]))
else
tab
if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then
tab
else
AddUnionCases2 bulkAddMode tab ucrefs
let tab =
if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then
tab
else
AddUnionCases2 bulkAddMode tab ucrefs
tab
let ePatItems =
if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then
@ -690,17 +860,26 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals)
else
AddUnionCases1 nenv.ePatItems ucrefs
{ nenv with
eFieldLabels = eFieldLabels
eUnqualifiedItems = eUnqualifiedItems
ePatItems = ePatItems
eIndexedExtensionMembers = eIndexedExtensionMembers
eUnindexedExtensionMembers = eUnindexedExtensionMembers }
let nenv =
{ nenv with
eFieldLabels = eFieldLabels
eUnqualifiedItems = eUnqualifiedItems
ePatItems = ePatItems
eIndexedExtensionMembers = eIndexedExtensionMembers
eUnindexedExtensionMembers = eUnindexedExtensionMembers }
let nenv =
if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && isStaticClass g tcref then
AddStaticContentOfTyconRefToNameEnv g amap ad m nenv tcref
else
nenv
nenv
/// Add a set of type definitions to the name resolution environment
let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap m root nenv tcrefs =
let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs =
if isNil tcrefs then nenv else
let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m) nenv tcrefs
let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap ad m) nenv tcrefs
// Add most of the contents of the tycons en-masse, then flatten the tables if we're opening a module or namespace
let tcrefs = Array.ofList tcrefs
{ env with
@ -799,7 +978,7 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai
let tcref = modref.NestedTyconRef tycon
if IsEntityAccessible amap m ad tcref then Some tcref else None)
let nenv = (nenv, tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap m false
let nenv = (nenv, tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap ad m false
let vrefs =
mty.AllValsAndMembers.ToList()
|> List.choose (fun x -> if IsAccessible ad x.Accessibility then TryMkValRefInModRef modref x else None)
@ -817,8 +996,14 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai
// open M1
//
// The list contains [M1b; M1a]
and AddModulesAndNamespacesContentsToNameEnv g amap ad m root nenv modrefs =
(modrefs, nenv) ||> List.foldBack (fun modref acc -> AddModuleOrNamespaceContentsToNameEnv g amap ad m root acc modref)
and AddEntitiesContentsToNameEnv g amap ad m root nenv modrefs =
(modrefs, nenv) ||> List.foldBack (fun modref acc -> AddEntityContentsToNameEnv g amap ad m root acc modref)
and AddEntityContentsToNameEnv g amap ad m root nenv (modref: EntityRef) =
if modref.IsModuleOrNamespace then
AddModuleOrNamespaceContentsToNameEnv g amap ad m root nenv modref
else
AddStaticContentOfTyconRefToNameEnv g amap ad m nenv modref
/// Add a single modules or namespace to the name resolution environment
let AddModuleOrNamespaceRefToNameEnv g amap m root ad nenv (modref: EntityRef) =
@ -910,18 +1095,13 @@ let AddResults res1 res2 =
let NoResultsOrUsefulErrors = Result []
/// Indicates if we only need one result or all possible results from a resolution.
[<RequireQualifiedAccess>]
type ResultCollectionSettings =
| AllResults
| AtMostOneResult
let rec CollectResults f = function
| [] -> NoResultsOrUsefulErrors
| [h] -> OneResult (f h)
| h :: t -> AddResults (OneResult (f h)) (CollectResults f t)
let rec CollectAtMostOneResult f = function
let rec CollectAtMostOneResult f inputs =
match inputs with
| [] -> NoResultsOrUsefulErrors
| [h] -> OneResult (f h)
| h :: t ->
@ -1257,7 +1437,7 @@ type FormatStringCheckContext =
type ITypecheckResultsSink =
abstract NotifyEnvWithScope: range * NameResolutionEnv * AccessorDomain -> unit
abstract NotifyExprHasType: pos * TType * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
abstract NotifyNameResolution: pos * Item * Item * TyparInst * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range * bool -> unit
abstract NotifyNameResolution: pos * item: Item * itemMethodGroup: Item * TyparInst * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range * replace: bool -> unit
abstract NotifyFormatSpecifierLocation: range * int -> unit
abstract NotifyOpenDeclaration: OpenDeclaration -> unit
abstract CurrentSourceText: ISourceText option
@ -1828,13 +2008,16 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities
//-------------------------------------------------------------------------
/// Perform name resolution for an identifier which must resolve to be a namespace or module.
let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQualified (nenv: NameResolutionEnv) ad (id: Ident) (rest: Ident list) isOpenDecl =
let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m allowStaticClasses first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl =
// If the selected language version doesn't support open static classes then turn them off.
let allowStaticClasses = allowStaticClasses && amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses
if first && id.idText = MangledGlobalName then
match rest with
| [] ->
error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange))
| id2 :: rest2 ->
ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl
ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink atMostOne amap m allowStaticClasses false FullyQualified nenv ad id2 rest2 isOpenDecl
else
let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified
let namespaceNotFound = lazy(
@ -1847,6 +2030,8 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu
UndefinedName(0, FSComp.SR.undefinedNameNamespaceOrModule, id, suggestModulesAndNamespaces))
// Avoid generating the same error and name suggestion thunk twice It's not clear this is necessary
// since it's just saving an allocation.
let mutable moduleNotFoundErrorCache = None
let moduleNotFound (modref: ModuleOrNamespaceRef) (mty: ModuleOrNamespaceType) (id: Ident) depth =
match moduleNotFoundErrorCache with
@ -1867,36 +2052,69 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu
let occurence = if isOpenDecl then ItemOccurence.Open else ItemOccurence.Use
CallNameResolutionSink sink (m, nenv, item, item, emptyTyparInst, occurence, nenv.DisplayEnv, ad)
match moduleOrNamespaces.TryGetValue id.idText with
| true, modrefs ->
let erefs =
let modrefs =
match moduleOrNamespaces.TryGetValue id.idText with
| true, modrefs -> modrefs
| _ -> []
let tcrefs =
if allowStaticClasses then
LookupTypeNameInEnvNoArity fullyQualified id.idText nenv |> List.filter (isStaticClass amap.g)
else []
modrefs @ tcrefs
if not erefs.IsEmpty then
/// Look through the sub-namespaces and/or modules
let rec look depth (modref: ModuleOrNamespaceRef) (mty: ModuleOrNamespaceType) (lid: Ident list) =
let rec look depth allowStaticClasses (modref: ModuleOrNamespaceRef) (lid: Ident list) =
let mty = modref.ModuleOrNamespaceType
match lid with
| [] -> success (depth, modref, mty)
| [] ->
success [ (depth, modref, mty) ]
| id :: rest ->
match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with
| true, mspec ->
let subref = modref.NestedTyconRef mspec
if IsEntityAccessible amap m ad subref then
notifyNameResolution subref id.idRange
look (depth+1) subref mspec.ModuleOrNamespaceType rest
else
moduleNotFound modref mty id depth
| _ -> moduleNotFound modref mty id depth
let especs =
let mspecs =
match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with
| true, res -> [res]
| _ -> []
let tspecs =
if allowStaticClasses then
LookupTypeNameInEntityNoArity id.idRange id.idText mty
|> List.filter (modref.NestedTyconRef >> isStaticClass amap.g)
else []
mspecs @ tspecs
if not especs.IsEmpty then
especs
|> List.map (fun espec ->
let subref = modref.NestedTyconRef espec
if IsEntityAccessible amap m ad subref then
notifyNameResolution subref id.idRange
let allowStaticClasses = allowStaticClasses && (subref.IsModuleOrNamespace || isStaticClass amap.g subref)
look (depth+1) allowStaticClasses subref rest
else
moduleNotFound modref mty id depth)
|> List.reduce AddResults
else
moduleNotFound modref mty id depth
modrefs |> CollectResults2 atMostOne (fun modref ->
if IsEntityAccessible amap m ad modref then
notifyNameResolution modref id.idRange
look 1 modref modref.ModuleOrNamespaceType rest
erefs
|> List.map (fun eref ->
if IsEntityAccessible amap m ad eref then
notifyNameResolution eref id.idRange
let allowStaticClasses = allowStaticClasses && (eref.IsModuleOrNamespace || isStaticClass amap.g eref)
look 1 allowStaticClasses eref rest
else
raze (namespaceNotFound.Force()))
| _ -> raze (namespaceNotFound.Force())
|> List.reduce AddResults
else
raze (namespaceNotFound.Force())
// Note - 'rest' is annotated due to a bug currently in Unity (see: https://github.com/dotnet/fsharp/pull/7427)
let ResolveLongIndentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f =
match ResolveLongIndentAsModuleOrNamespace sink ResultCollectionSettings.AllResults amap m true fullyQualified nenv ad id [] isOpenDecl with
match ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink ResultCollectionSettings.AllResults amap m false true fullyQualified nenv ad id [] isOpenDecl with
| Result modrefs ->
match rest with
| [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), id.idRange))
@ -1944,126 +2162,6 @@ let ResolveObjectConstructor (ncenv: NameResolver) edenv m ad ty =
// Bind the "." notation (member lookup or lookup in a type)
//-------------------------------------------------------------------------
/// Query the declared properties of a type (including inherited properties)
let IntrinsicPropInfosOfTypeInScope (infoReader:InfoReader) optFilter ad findFlag m ty =
let g = infoReader.g
let amap = infoReader.amap
let pinfos = GetIntrinsicPropInfoSetsOfType infoReader optFilter ad AllowMultiIntfInstantiations.Yes findFlag m ty
let pinfos = pinfos |> ExcludeHiddenOfPropInfos g amap m
pinfos
/// Select from a list of extension properties
let SelectPropInfosFromExtMembers (infoReader:InfoReader) ad optFilter declaringTy m extMemInfos =
let g = infoReader.g
let amap = infoReader.amap
// NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers, hence setify.
let seen = HashSet(ExtensionMember.Comparer g)
let propCollector = new PropertyCollector(g, amap, m, declaringTy, optFilter, ad)
for emem in extMemInfos do
if seen.Add emem then
match emem with
| FSExtMem (vref, _pri) ->
match vref.MemberInfo with
| None -> ()
| Some membInfo -> propCollector.Collect(membInfo, vref)
| ILExtMem _ ->
// No extension properties coming from .NET
()
propCollector.Close()
/// Query the available extension properties of a type (including extension properties for inherited types)
let ExtensionPropInfosOfTypeInScope collectionSettings (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter ad m ty =
let g = infoReader.g
let extMemsDangling = SelectPropInfosFromExtMembers infoReader ad optFilter ty m nenv.eUnindexedExtensionMembers
if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then
extMemsDangling
else
let extMemsFromHierarchy =
infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes,m,ty)
|> List.collect (fun ty ->
if isAppTy g ty then
let tcref = tcrefOfAppTy g ty
let extMemInfos = nenv.eIndexedExtensionMembers.Find tcref
SelectPropInfosFromExtMembers infoReader ad optFilter ty m extMemInfos
else [])
extMemsDangling @ extMemsFromHierarchy
/// Get all the available properties of a type (both intrinsic and extension)
let AllPropInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad findFlag m ty =
IntrinsicPropInfosOfTypeInScope infoReader optFilter ad findFlag m ty
@ ExtensionPropInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad m ty
/// Get the available methods of a type (both declared and inherited)
let IntrinsicMethInfosOfType (infoReader:InfoReader) optFilter ad allowMultiIntfInst findFlag m ty =
let g = infoReader.g
let amap = infoReader.amap
let minfos = GetIntrinsicMethInfoSetsOfType infoReader optFilter ad allowMultiIntfInst findFlag m ty
let minfos = minfos |> ExcludeHiddenOfMethInfos g amap m
minfos
/// Select from a list of extension methods
let SelectMethInfosFromExtMembers (infoReader: InfoReader) optFilter apparentTy m extMemInfos =
let g = infoReader.g
// NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers
let seen = HashSet(ExtensionMember.Comparer g)
[
for emem in extMemInfos do
if seen.Add emem then
match emem with
| FSExtMem (vref, pri) ->
match vref.MemberInfo with
| None -> ()
| Some membInfo ->
match TrySelectMemberVal g optFilter apparentTy (Some pri) membInfo vref with
| Some m -> yield m
| _ -> ()
| ILExtMem (actualParent, minfo, pri) when (match optFilter with None -> true | Some nm -> nm = minfo.LogicalName) ->
// Make a reference to the type containing the extension members
match minfo with
| ILMeth(_, ilminfo, _) ->
yield (MethInfo.CreateILExtensionMeth (infoReader.amap, m, apparentTy, actualParent, Some pri, ilminfo.RawMetadata))
// F#-defined IL-style extension methods are not seen as extension methods in F# code
| FSMeth(g, _, vref, _) ->
yield (FSMeth(g, apparentTy, vref, Some pri))
#if !NO_EXTENSIONTYPING
// // Provided extension methods are not yet supported
| ProvidedMeth(amap, providedMeth, _, m) ->
yield (ProvidedMeth(amap, providedMeth, Some pri, m))
#endif
| DefaultStructCtor _ ->
()
| _ -> ()
]
/// Query the available extension properties of a methods (including extension methods for inherited types)
let ExtensionMethInfosOfTypeInScope (collectionSettings:ResultCollectionSettings) (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter m ty =
let extMemsDangling = SelectMethInfosFromExtMembers infoReader optFilter ty m nenv.eUnindexedExtensionMembers
if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then
extMemsDangling
else
let extMemsFromHierarchy =
infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes,m,ty)
|> List.collect (fun ty ->
let g = infoReader.g
if isAppTy g ty then
let tcref = tcrefOfAppTy g ty
let extValRefs = nenv.eIndexedExtensionMembers.Find tcref
SelectMethInfosFromExtMembers infoReader optFilter ty m extValRefs
else [])
extMemsDangling @ extMemsFromHierarchy
/// Get all the available methods of a type (both intrinsic and extension)
let AllMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad findFlag m ty =
let intrinsic = IntrinsicMethInfosOfType infoReader optFilter ad AllowMultiIntfInstantiations.Yes findFlag m ty
if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil intrinsic) then
intrinsic
else
intrinsic @ ExtensionMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter m ty
/// Used to report an error condition where name resolution failed due to an indeterminate type
exception IndeterminateType of range
@ -2411,6 +2509,15 @@ let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameR
/// that may represent further actions, e.g. further lookups.
let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified m ad nenv (typeNameResInfo: TypeNameResolutionInfo) (id: Ident) (rest: Ident list) isOpenDecl =
let resInfo = ResolutionInfo.Empty
let canSuggestThisItem (item:Item) =
// All items can be suggested except nameof when it comes from FSharp.Core.dll and the nameof feature is not enabled
match item with
| Item.Value v ->
let isNameOfOperator = valRefEq ncenv.g ncenv.g.nameof_vref v
if isNameOfOperator && not (ncenv.g.langVersion.SupportsFeature LanguageFeature.NameOf) then false
else true
| _ -> true
if first && id.idText = MangledGlobalName then
match rest with
| [] ->
@ -2445,7 +2552,16 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified
| Exception e -> typeError := Some e; None
| true, res ->
Some (FreshenUnqualifiedItem ncenv m res, [])
let fresh = FreshenUnqualifiedItem ncenv m res
match fresh with
| Item.Value value ->
let isNameOfOperator = valRefEq ncenv.g ncenv.g.nameof_vref value
if isNameOfOperator && not (ncenv.languageSupportsNameOf) then
// Do not resolve `nameof` if the feature is unsupported, even if it is FSharp.Core
None
else
Some (fresh, [])
| _ -> Some (fresh, [])
| _ ->
None
@ -2476,7 +2592,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified
| _ ->
let suggestNamesAndTypes (addToBuffer: string -> unit) =
for e in nenv.eUnqualifiedItems do
addToBuffer e.Value.DisplayName
if canSuggestThisItem e.Value then
addToBuffer e.Value.DisplayName
for e in nenv.TyconsByDemangledNameAndArity fullyQualified do
if IsEntityAccessible ncenv.amap m ad e.Value then
@ -2572,7 +2689,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified
addToBuffer e.Value.DisplayName
for e in nenv.eUnqualifiedItems do
addToBuffer e.Value.DisplayName
if canSuggestThisItem e.Value then
addToBuffer e.Value.DisplayName
match innerSearch with
| Exception (UndefinedName(0, _, id1, suggestionsF)) when Range.equals id.idRange id1.idRange ->
@ -3971,6 +4089,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE
ResolvePartialLongIdentInModuleOrNamespace ncenv nenv isApplicableMeth m ad modref rest allowObsolete
else
[])
// Look for values called 'id' that accept the dot-notation
let values, isItemVal =
(match nenv.eUnqualifiedItems.TryGetValue id with
@ -4131,6 +4250,7 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv:
ResolvePartialLongIdentInModuleOrNamespaceForRecordFields ncenv nenv m ad modref rest allowObsolete
else
[])
let qualifiedFields =
match rest with
| [] ->

9
src/fsharp/NameResolution.fsi
Просмотреть файл

@ -22,6 +22,7 @@ type NameResolver =
member InfoReader : InfoReader
member amap : ImportMap
member g : TcGlobals
member languageSupportsNameOf : bool
/// Get the active pattern elements defined in a module, if any. Cache in the slot in the module type.
val ActivePatternElemsOfModuleOrNamespace : ModuleOrNamespaceRef -> NameMap<ActivePatternElemRef>
@ -186,7 +187,7 @@ val internal AddValRefToNameEnv : NameResolutionEnv -> ValRef
val internal AddActivePatternResultTagsToNameEnv : ActivePatternInfo -> NameResolutionEnv -> TType -> range -> NameResolutionEnv
/// Add a list of type definitions to the name resolution environment
val internal AddTyconRefsToNameEnv : BulkAdd -> bool -> TcGlobals -> ImportMap -> range -> bool -> NameResolutionEnv -> TyconRef list -> NameResolutionEnv
val internal AddTyconRefsToNameEnv : BulkAdd -> bool -> TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> TyconRef list -> NameResolutionEnv
/// Add an F# exception definition to the name resolution environment
val internal AddExceptionDeclsToNameEnv : BulkAdd -> NameResolutionEnv -> TyconRef -> NameResolutionEnv
@ -201,7 +202,7 @@ val internal AddModuleOrNamespaceRefsToNameEnv : TcGlobals ->
val internal AddModuleOrNamespaceRefToNameEnv : TcGlobals -> ImportMap -> range -> bool -> AccessorDomain -> NameResolutionEnv -> ModuleOrNamespaceRef -> NameResolutionEnv
/// Add a list of modules or namespaces to the name resolution environment
val internal AddModulesAndNamespacesContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> ModuleOrNamespaceRef list -> NameResolutionEnv
val internal AddEntitiesContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> ModuleOrNamespaceRef list -> NameResolutionEnv
/// A flag which indicates if it is an error to have two declared type parameters with identical names
/// in the name resolution environment.
@ -468,8 +469,8 @@ type PermitDirectReferenceToGeneratedType =
| Yes
| No
/// Resolve a long identifier to a namespace or module.
val internal ResolveLongIndentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list >
/// Resolve a long identifier to a namespace, module or static class.
val internal ResolveLongIndentAsModuleOrNamespaceOrStaticClass : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> allowStaticClasses: bool -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list >
/// Resolve a long identifier to an object constructor.
val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException<Item>

4
src/fsharp/PostInferenceChecks.fs
Просмотреть файл

@ -282,7 +282,8 @@ let GetLimitValByRef cenv env m v =
{ scope = scope; flags = flags }
let LimitVal cenv (v: Val) limit =
cenv.limitVals.[v.Stamp] <- limit
if not v.IgnoresByrefScope then
cenv.limitVals.[v.Stamp] <- limit
let BindVal cenv env (v: Val) =
//printfn "binding %s..." v.DisplayName
@ -697,6 +698,7 @@ and CheckValRef (cenv: cenv) (env: env) v m (context: PermitByRefExpr) =
if isSpliceOperator cenv.g v then errorR(Error(FSComp.SR.chkNoFirstClassSplicing(), m))
if valRefEq cenv.g v cenv.g.addrof_vref then errorR(Error(FSComp.SR.chkNoFirstClassAddressOf(), m))
if valRefEq cenv.g v cenv.g.reraise_vref then errorR(Error(FSComp.SR.chkNoFirstClassRethrow(), m))
if valRefEq cenv.g v cenv.g.nameof_vref then errorR(Error(FSComp.SR.chkNoFirstClassNameOf(), m))
// ByRefLike-typed values can only occur in permitting contexts
if context.Disallow && isByrefLikeTy cenv.g m v.Type then

105
src/fsharp/TastOps.fs
Просмотреть файл

@ -22,6 +22,7 @@ open FSharp.Compiler.TcGlobals
open FSharp.Compiler.Layout
open FSharp.Compiler.Layout.TaggedTextOps
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.Features
#if !NO_EXTENSIONTYPING
open FSharp.Compiler.ExtensionTyping
#endif
@ -3003,8 +3004,8 @@ let isByrefTyconRef (g: TcGlobals) (tcref: TyconRef) =
let isByrefLikeTyconRef (g: TcGlobals) m (tcref: TyconRef) =
tcref.CanDeref &&
match tcref.TryIsByRefLike with
| Some res -> res
| None ->
| ValueSome res -> res
| _ ->
let res =
isByrefTyconRef g tcref ||
(isStructTyconRef tcref && TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref)
@ -3221,6 +3222,11 @@ let isSizeOfValRef g vref =
// There is an internal version of typeof defined in prim-types.fs that needs to be detected
|| (g.compilingFslib && vref.LogicalName = "sizeof")
let isNameOfValRef g vref =
valRefEq g vref g.nameof_vref
// There is an internal version of nameof defined in prim-types.fs that needs to be detected
|| (g.compilingFslib && vref.LogicalName = "nameof")
let isTypeDefOfValRef g vref =
valRefEq g vref g.typedefof_vref
// There is an internal version of typedefof defined in prim-types.fs that needs to be detected
@ -3246,6 +3252,16 @@ let (|TypeDefOfExpr|_|) g expr =
| Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> Some ty
| _ -> None
let (|NameOfExpr|_|) g expr =
match expr with
| Expr.App(Expr.Val(vref,_,_),_,[ty],[],_) when isNameOfValRef g vref -> Some ty
| _ -> None
let (|SeqExpr|_|) g expr =
match expr with
| Expr.App(Expr.Val(vref,_,_),_,_,_,_) when valRefEq g vref g.seq_vref -> Some()
| _ -> None
//--------------------------------------------------------------------------
// DEBUG layout
//---------------------------------------------------------------------------
@ -5925,34 +5941,56 @@ let mkAndSimplifyMatch spBind exprm matchm ty tree targets =
//-------------------------------------------------------------------------
type Mutates = AddressOfOp | DefinitelyMutates | PossiblyMutates | NeverMutates
exception DefensiveCopyWarning of string * range
exception DefensiveCopyWarning of string * range
let isRecdOrStructTyconRefAssumedImmutable (g: TcGlobals) (tcref: TyconRef) =
tcref.CanDeref &&
not (isRecdOrUnionOrStructTyconRefDefinitelyMutable tcref) ||
tyconRefEq g tcref g.decimal_tcr ||
tyconRefEq g tcref g.decimal_tcr ||
tyconRefEq g tcref g.date_tcr
let isRecdOrStructTyconRefReadOnly (g: TcGlobals) m (tcref: TyconRef) =
let isTyconRefReadOnly g m (tcref: TyconRef) =
tcref.CanDeref &&
match tcref.TryIsReadOnly with
| Some res -> res
| None ->
let isImmutable = isRecdOrStructTyconRefAssumedImmutable g tcref
let hasAttrib = TyconRefHasAttribute g m g.attrib_IsReadOnlyAttribute tcref
let res = isImmutable || hasAttrib
tcref.SetIsReadOnly res
if
match tcref.TryIsReadOnly with
| ValueSome res -> res
| _ ->
let res = TyconRefHasAttribute g m g.attrib_IsReadOnlyAttribute tcref
tcref.SetIsReadOnly res
res
then true
else tcref.IsEnumTycon
let isTyconRefAssumedReadOnly g (tcref: TyconRef) =
tcref.CanDeref &&
match tcref.TryIsAssumedReadOnly with
| ValueSome res -> res
| _ ->
let res = isRecdOrStructTyconRefAssumedImmutable g tcref
tcref.SetIsAssumedReadOnly res
res
let isRecdOrStructTyReadOnly (g: TcGlobals) m ty =
let isRecdOrStructTyconRefReadOnlyAux g m isInref (tcref: TyconRef) =
if isInref && tcref.IsILStructOrEnumTycon then
isTyconRefReadOnly g m tcref
else
isTyconRefReadOnly g m tcref || isTyconRefAssumedReadOnly g tcref
let isRecdOrStructTyconRefReadOnly g m tcref =
isRecdOrStructTyconRefReadOnlyAux g m false tcref
let isRecdOrStructTyReadOnlyAux (g: TcGlobals) m isInref ty =
match tryDestAppTy g ty with
| ValueNone -> false
| ValueSome tcref -> isRecdOrStructTyconRefReadOnly g m tcref
| ValueSome tcref -> isRecdOrStructTyconRefReadOnlyAux g m isInref tcref
let CanTakeAddressOf g m ty mut =
let isRecdOrStructTyReadOnly g m ty =
isRecdOrStructTyReadOnlyAux g m false ty
let CanTakeAddressOf g m isInref ty mut =
match mut with
| NeverMutates -> true
| PossiblyMutates -> isRecdOrStructTyReadOnly g m ty
| PossiblyMutates -> isRecdOrStructTyReadOnlyAux g m isInref ty
| DefinitelyMutates -> false
| AddressOfOp -> true // you can take the address but you might get a (readonly) inref<T> as a result
@ -5980,7 +6018,7 @@ let CanTakeAddressOfImmutableVal (g: TcGlobals) m (vref: ValRef) mut =
// || valRefInThisAssembly g.compilingFslib vref
// This is because we don't actually guarantee to generate static backing fields for all values like these, e.g. simple constants "let x = 1".
// We always generate a static property but there is no field to take an address of
CanTakeAddressOf g m vref.Type mut
CanTakeAddressOf g m false vref.Type mut
let MustTakeAddressOfVal (g: TcGlobals) (vref: ValRef) =
vref.IsMutable &&
@ -5992,7 +6030,7 @@ let MustTakeAddressOfByrefGet (g: TcGlobals) (vref: ValRef) =
let CanTakeAddressOfByrefGet (g: TcGlobals) (vref: ValRef) mut =
isInByrefTy g vref.Type &&
CanTakeAddressOf g vref.Range (destByrefTy g vref.Type) mut
CanTakeAddressOf g vref.Range true (destByrefTy g vref.Type) mut
let MustTakeAddressOfRecdField (rfref: RecdField) =
// Static mutable fields must be private, hence we don't have to take their address
@ -6005,14 +6043,18 @@ let CanTakeAddressOfRecdFieldRef (g: TcGlobals) m (rfref: RecdFieldRef) tinst mu
// We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields
entityRefInThisAssembly g.compilingFslib rfref.TyconRef &&
not rfref.RecdField.IsMutable &&
CanTakeAddressOf g m (actualTyOfRecdFieldRef rfref tinst) mut
CanTakeAddressOf g m false (actualTyOfRecdFieldRef rfref tinst) mut
let CanTakeAddressOfUnionFieldRef (g: TcGlobals) m (uref: UnionCaseRef) cidx tinst mut =
// We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields
entityRefInThisAssembly g.compilingFslib uref.TyconRef &&
let rfref = uref.FieldByIndex cidx
not rfref.IsMutable &&
CanTakeAddressOf g m (actualTyOfUnionFieldRef uref cidx tinst) mut
CanTakeAddressOf g m false (actualTyOfUnionFieldRef uref cidx tinst) mut
let mkDerefAddrExpr mAddrGet expr mExpr exprTy =
let v, _ = mkCompGenLocal mAddrGet "byrefReturn" exprTy
mkCompGenLet mExpr v expr (mkAddrGet mAddrGet (mkLocalValRef v))
/// Make the address-of expression and return a wrapper that adds any allocated locals at an appropriate scope.
/// Also return a flag that indicates if the resulting pointer is a not a pointer where writing is allowed and will
@ -6150,8 +6192,12 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress
// Take a defensive copy
let tmp, _ =
match mut with
| NeverMutates -> mkCompGenLocal m "copyOfStruct" ty
| NeverMutates -> mkCompGenLocal m "copyOfStruct" ty
| _ -> mkMutableCompGenLocal m "copyOfStruct" ty
// This local is special in that it ignore byref scoping rules.
tmp.SetIgnoresByrefScope()
let readonly = true
let writeonly = false
Some (tmp, expr), (mkValAddr m readonly (mkLocalValRef tmp)), readonly, writeonly
@ -8569,6 +8615,7 @@ let IsSimpleSyntacticConstantExpr g inputExpr =
| UncheckedDefaultOfExpr g _
| SizeOfExpr g _
| TypeOfExpr g _ -> true
| NameOfExpr g _ when g.langVersion.SupportsFeature LanguageFeature.NameOf -> true
// All others are not simple constant expressions
| _ -> false
@ -8939,3 +8986,19 @@ let isThreadOrContextStatic g attrs =
let mkUnitDelayLambda (g: TcGlobals) m e =
let uv, _ = mkCompGenLocal m "unitVar" g.unit_ty
mkLambda m uv (e, tyOfExpr g e)
let isStaticClass (g:TcGlobals) (x: EntityRef) =
not x.IsModuleOrNamespace &&
x.TyparsNoRange.IsEmpty &&
((x.IsILTycon &&
x.ILTyconRawMetadata.IsSealed &&
x.ILTyconRawMetadata.IsAbstract)
#if !NO_EXTENSIONTYPING
|| (x.IsProvided &&
match x.TypeReprInfo with
| TProvidedTypeExtensionPoint info -> info.IsSealed && info.IsAbstract
| _ -> false)
#endif
|| (not x.IsILTycon && not x.IsProvided && HasFSharpAttribute g g.attrib_AbstractClassAttribute x.Attribs)) &&
not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute x.Attribs)

6
src/fsharp/TastOps.fsi
Просмотреть файл

@ -369,6 +369,9 @@ exception DefensiveCopyWarning of string * range
type Mutates = AddressOfOp | DefinitelyMutates | PossiblyMutates | NeverMutates
/// Helper to create an expression that dereferences an address.
val mkDerefAddrExpr: mAddrGet: range -> expr: Expr -> mExpr: range -> exprTy: TType -> Expr
/// Helper to take the address of an expression
val mkExprAddrOfExprAux : TcGlobals -> bool -> bool -> Mutates -> Expr -> ValRef option -> range -> (Val * Expr) option * Expr * bool * bool
@ -2240,6 +2243,8 @@ val (|EnumExpr|_|) : TcGlobals -> Expr -> Expr option
val (|TypeOfExpr|_|) : TcGlobals -> Expr -> TType option
val (|TypeDefOfExpr|_|) : TcGlobals -> Expr -> TType option
val (|NameOfExpr|_|) : TcGlobals -> Expr -> TType option
val (|SeqExpr|_|) : TcGlobals -> Expr -> unit option
val EvalLiteralExprOrAttribArg: TcGlobals -> Expr -> Expr
@ -2302,3 +2307,4 @@ val isThreadOrContextStatic: TcGlobals -> Attrib list -> bool
val mkUnitDelayLambda: TcGlobals -> range -> Expr -> Expr
val isStaticClass: g: TcGlobals -> tcref: TyconRef -> bool

29
src/fsharp/TcGlobals.fs
Просмотреть файл

@ -22,6 +22,7 @@ open FSharp.Compiler.Range
open FSharp.Compiler.Ast
open FSharp.Compiler.Lib
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.Features
open Internal.Utilities
@ -180,8 +181,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
// The helper to find system types amongst referenced DLLs
tryFindSysTypeCcu,
emitDebugInfoInQuotations: bool, noDebugData: bool,
pathMap: PathMap) =
pathMap: PathMap, langVersion: LanguageVersion) =
let vara = NewRigidTypar "a" envRange
let varb = NewRigidTypar "b" envRange
let varc = NewRigidTypar "c" envRange
@ -239,7 +240,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
// Search for a type. If it is not found, leave a dangling CCU reference with some useful diagnostic information should
// the type actually be dereferenced
let findSysTypeCcu path typeName =
match tryFindSysTypeCcu path typeName with
match tryFindSysTypeCcu path typeName with
| None -> CcuThunk.CreateDelayed(dummyAssemblyNameCarryingUsefulErrorInformation path typeName)
| Some ccu -> ccu
@ -664,6 +665,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
let v_typeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typeof" , None , Some "TypeOf" , [vara], ([], v_system_Type_ty))
let v_methodhandleof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "methodhandleof" , None , Some "MethodHandleOf", [vara;varb], ([[varaTy --> varbTy]], v_system_RuntimeMethodHandle_ty))
let v_sizeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "sizeof" , None , Some "SizeOf" , [vara], ([], v_int_ty))
let v_nameof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "nameof" , None , Some "NameOf" , [vara], ([[varaTy]], v_string_ty))
let v_unchecked_defaultof_info = makeIntrinsicValRef(fslib_MFOperatorsUnchecked_nleref, "defaultof" , None , Some "DefaultOf", [vara], ([], varaTy))
let v_typedefof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typedefof" , None , Some "TypeDefOf", [vara], ([], v_system_Type_ty))
let v_range_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Range" , None , None , [vara], ([[varaTy];[varaTy]], mkSeqTy varaTy))
@ -902,6 +905,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
member __.emitDebugInfoInQuotations = emitDebugInfoInQuotations
member __.directoryToResolveRelativePaths= directoryToResolveRelativePaths
member __.pathMap = pathMap
member __.langVersion = langVersion
member __.unionCaseRefEq x y = primUnionCaseRefEq compilingFslib fslibCcu x y
member __.valRefEq x y = primValRefEq compilingFslib fslibCcu x y
member __.fslibCcu = fslibCcu
@ -1331,6 +1335,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
member val methodhandleof_vref = ValRefForIntrinsic v_methodhandleof_info
member val typeof_vref = ValRefForIntrinsic v_typeof_info
member val sizeof_vref = ValRefForIntrinsic v_sizeof_info
member val nameof_vref = ValRefForIntrinsic v_nameof_info
member val typedefof_vref = ValRefForIntrinsic v_typedefof_info
member val enum_vref = ValRefForIntrinsic v_enum_operator_info
member val enumOfValue_vref = ValRefForIntrinsic v_enumOfValue_info
@ -1358,15 +1363,15 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
member val unbox_fast_vref = ValRefForIntrinsic v_unbox_fast_info
member val istype_vref = ValRefForIntrinsic v_istype_info
member val istype_fast_vref = ValRefForIntrinsic v_istype_fast_info
member val query_source_vref = ValRefForIntrinsic v_query_source_info
member val query_value_vref = ValRefForIntrinsic v_query_value_info
member val query_run_value_vref = ValRefForIntrinsic v_query_run_value_info
member val query_run_enumerable_vref = ValRefForIntrinsic v_query_run_enumerable_info
member val query_for_vref = ValRefForIntrinsic v_query_for_value_info
member val query_yield_vref = ValRefForIntrinsic v_query_yield_value_info
member val query_yield_from_vref = ValRefForIntrinsic v_query_yield_from_value_info
member val query_select_vref = ValRefForIntrinsic v_query_select_value_info
member val query_where_vref = ValRefForIntrinsic v_query_where_value_info
member val query_source_vref = ValRefForIntrinsic v_query_source_info
member val query_value_vref = ValRefForIntrinsic v_query_value_info
member val query_run_value_vref = ValRefForIntrinsic v_query_run_value_info
member val query_run_enumerable_vref = ValRefForIntrinsic v_query_run_enumerable_info
member val query_for_vref = ValRefForIntrinsic v_query_for_value_info
member val query_yield_vref = ValRefForIntrinsic v_query_yield_value_info
member val query_yield_from_vref = ValRefForIntrinsic v_query_yield_from_value_info
member val query_select_vref = ValRefForIntrinsic v_query_select_value_info
member val query_where_vref = ValRefForIntrinsic v_query_where_value_info
member val query_zero_vref = ValRefForIntrinsic v_query_zero_value_info
member __.seq_collect_info = v_seq_collect_info

477
src/fsharp/TypeChecker.fs
Просмотреть файл

@ -36,6 +36,7 @@ open FSharp.Compiler.ConstraintSolver
open FSharp.Compiler.NameResolution
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.InfoReader
open FSharp.Compiler.Features
#if !NO_EXTENSIONTYPING
open FSharp.Compiler.ExtensionTyping
@ -357,7 +358,7 @@ let AddLocalExnDefnAndReport tcSink scopem env (exnc: Tycon) =
/// Add a list of type definitions to TcEnv
let AddLocalTyconRefs ownDefinition g amap m tcrefs env =
if isNil tcrefs then env else
{ env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.No ownDefinition g amap m false env.eNameResEnv tcrefs }
{ env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.No ownDefinition g amap env.eAccessRights m false env.eNameResEnv tcrefs }
/// Add a list of type definitions to TcEnv
let AddLocalTycons g amap m (tycons: Tycon list) env =
@ -370,11 +371,11 @@ let AddLocalTyconsAndReport tcSink scopem g amap m tycons env =
CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights)
env
/// Adjust the TcEnv to account for opening the set of modules and namespaces implied by an `open` declaration
let OpenModulesOrNamespaces tcSink g amap scopem root env mvvs openDeclaration =
/// Adjust the TcEnv to account for opening the set of modules, namespaces or static classes implied by an `open` declaration
let OpenEntities tcSink g amap scopem root env mvvs openDeclaration =
let env =
if isNil mvvs then env else
{ env with eNameResEnv = AddModulesAndNamespacesContentsToNameEnv g amap env.eAccessRights scopem root env.eNameResEnv mvvs }
{ env with eNameResEnv = AddEntitiesContentsToNameEnv g amap env.eAccessRights scopem root env.eNameResEnv mvvs }
CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights)
CallOpenDeclarationSink tcSink openDeclaration
env
@ -406,7 +407,7 @@ let AddNonLocalCcu g amap scopem env assemblyName (ccu: CcuThunk, internalsVisib
let env = AddRootModuleOrNamespaceRefs g amap scopem env modrefs
let env =
if isNil tcrefs then env else
{ env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.Yes false g amap scopem true env.eNameResEnv tcrefs }
{ env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.Yes false g amap env.eAccessRights scopem true env.eNameResEnv tcrefs }
env
/// Adjust the TcEnv to account for a fully processed "namespace" declaration in thie file
@ -417,7 +418,7 @@ let AddLocalRootModuleOrNamespace tcSink g amap scopem env (mtyp: ModuleOrNamesp
let tcrefs = mtyp.TypeAndExceptionDefinitions |> List.map mkLocalTyconRef
let env = AddRootModuleOrNamespaceRefs g amap scopem env modrefs
let env = { env with
eNameResEnv = if isNil tcrefs then env.eNameResEnv else AddTyconRefsToNameEnv BulkAdd.No false g amap scopem true env.eNameResEnv tcrefs
eNameResEnv = if isNil tcrefs then env.eNameResEnv else AddTyconRefsToNameEnv BulkAdd.No false g amap env.eAccessRights scopem true env.eNameResEnv tcrefs
eUngeneralizableItems = addFreeItemOfModuleTy mtyp env.eUngeneralizableItems }
CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights)
env
@ -644,11 +645,11 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env =
match enclosingNamespacePathToOpen with
| id :: rest ->
let ad = env.eAccessRights
match ResolveLongIndentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap scopem true OpenQualified env.eNameResEnv ad id rest true with
match ResolveLongIndentAsModuleOrNamespaceOrStaticClass tcSink ResultCollectionSettings.AllResults amap scopem true true OpenQualified env.eNameResEnv ad id rest true with
| Result modrefs ->
let modrefs = List.map p23 modrefs
let openDecl = OpenDeclaration.Create (enclosingNamespacePathToOpen, modrefs, scopem, true)
OpenModulesOrNamespaces tcSink g amap scopem false env modrefs openDecl
OpenEntities tcSink g amap scopem false env modrefs openDecl
| Exception _ -> env
| _ -> env
@ -846,6 +847,10 @@ let UnifyUnitType cenv (env: TcEnv) m ty expr =
false
let TryUnifyUnitTypeWithoutWarning cenv (env:TcEnv) m ty =
let denv = env.DisplayEnv
AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv cenv.css m ty cenv.g.unit_ty
// Logically extends System.AttributeTargets
module AttributeTargets =
let FieldDecl = AttributeTargets.Field ||| AttributeTargets.Property
@ -3389,8 +3394,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr
let currentExpr, enumElemTy =
// Implicitly dereference byref for expr 'for x in ...'
if isByrefTy cenv.g enumElemTy then
let v, _ = mkCompGenLocal m "byrefReturn" enumElemTy
let expr = mkCompGenLet currentExpr.Range v currentExpr (mkAddrGet m (mkLocalValRef v))
let expr = mkDerefAddrExpr m currentExpr currentExpr.Range enumElemTy
expr, destByrefTy cenv.g enumElemTy
else
currentExpr, enumElemTy
@ -3513,35 +3517,84 @@ let (|ExprAsPat|_|) (f: SynExpr) =
None
| _ -> None
/// Check if a computation or sequence expression is syntactically free of 'yield' (though not yield!)
let YieldFree cenv expr =
if cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield then
// Implement yield free logic for F# Language including the LanguageFeature.ImplicitYield
let rec YieldFree expr =
match expr with
| SynExpr.Sequential (_, _, e1, e2, _) ->
YieldFree e1 && YieldFree e2
| SynExpr.IfThenElse (_, e2, e3opt, _, _, _, _) ->
YieldFree e2 && Option.forall YieldFree e3opt
| SynExpr.TryWith (e1, _, clauses, _, _, _, _) ->
YieldFree e1 && clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
| (SynExpr.Match (_, _, clauses, _) | SynExpr.MatchBang (_, _, clauses, _)) ->
clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
| SynExpr.For (_, _, _, _, _, body, _)
| SynExpr.TryFinally (body, _, _, _, _)
| SynExpr.LetOrUse (_, _, _, body, _)
| SynExpr.While (_, _, body, _)
| SynExpr.ForEach (_, _, _, _, _, body, _) ->
YieldFree body
| SynExpr.LetOrUseBang(_, _, _, _, _, body, _) ->
YieldFree body
| SynExpr.YieldOrReturn((true, _), _, _) -> false
| _ -> true
YieldFree expr
else
// Implement yield free logic for F# Language without the LanguageFeature.ImplicitYield
let rec YieldFree expr =
match expr with
| SynExpr.Sequential (_, _, e1, e2, _) ->
YieldFree e1 && YieldFree e2
| SynExpr.IfThenElse (_, e2, e3opt, _, _, _, _) ->
YieldFree e2 && Option.forall YieldFree e3opt
| SynExpr.TryWith (e1, _, clauses, _, _, _, _) ->
YieldFree e1 && clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
| (SynExpr.Match (_, _, clauses, _) | SynExpr.MatchBang (_, _, clauses, _)) ->
clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
| SynExpr.For (_, _, _, _, _, body, _)
| SynExpr.TryFinally (body, _, _, _, _)
| SynExpr.LetOrUse (_, _, _, body, _)
| SynExpr.While (_, _, body, _)
| SynExpr.ForEach (_, _, _, _, _, body, _) ->
YieldFree body
| SynExpr.LetOrUseBang _
| SynExpr.YieldOrReturnFrom _
| SynExpr.YieldOrReturn _
| SynExpr.ImplicitZero _
| SynExpr.Do _ -> false
| _ -> true
YieldFree expr
/// Determine if a syntactic expression inside 'seq { ... }' or '[...]' counts as a "simple sequence
/// of semicolon separated values". For example [1;2;3].
/// 'acceptDeprecated' is true for the '[ ... ]' case, where we allow the syntax '[ if g then t else e ]' but ask it to be parenthesized
///
let (|SimpleSemicolonSequence|_|) acceptDeprecated c =
let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr =
let rec YieldFree expr =
match expr with
| SynExpr.Sequential (_, _, e1, e2, _) -> YieldFree e1 && YieldFree e2
| SynExpr.IfThenElse (_, e2, e3opt, _, _, _, _) -> YieldFree e2 && Option.forall YieldFree e3opt
| SynExpr.TryWith (e1, _, clauses, _, _, _, _) -> YieldFree e1 && clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
| (SynExpr.Match (_, _, clauses, _) | SynExpr.MatchBang (_, _, clauses, _)) ->
clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
| SynExpr.For (_, _, _, _, _, body, _)
| SynExpr.TryFinally (body, _, _, _, _)
| SynExpr.LetOrUse (_, _, _, body, _)
| SynExpr.While (_, _, body, _)
| SynExpr.ForEach (_, _, _, _, _, body, _) -> YieldFree body
| SynExpr.YieldOrReturnFrom _
| SynExpr.YieldOrReturn _
| SynExpr.LetOrUseBang _
| SynExpr.ImplicitZero _
| SynExpr.Do _ -> false
| _ -> true
let rec IsSimpleSemicolonSequenceElement expr =
match expr with
| SynExpr.IfThenElse _ when acceptDeprecated && YieldFree expr -> true
| SynExpr.IfThenElse _
let IsSimpleSemicolonSequenceElement expr =
match expr with
| SynExpr.IfThenElse _ when acceptDeprecated && YieldFree cenv expr -> true
| SynExpr.IfThenElse _
| SynExpr.TryWith _
| SynExpr.Match _
| SynExpr.For _
@ -3553,15 +3606,14 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c =
| SynExpr.Do _
| SynExpr.MatchBang _
| SynExpr.LetOrUseBang _
| SynExpr.ImplicitZero _
| SynExpr.While _ -> false
| _ -> true
let rec GetSimpleSemicolonSequenceOfComprehension expr acc =
let rec TryGetSimpleSemicolonSequenceOfComprehension expr acc =
match expr with
| SynExpr.Sequential (_, true, e1, e2, _) ->
if IsSimpleSemicolonSequenceElement e1 then
GetSimpleSemicolonSequenceOfComprehension e2 (e1 :: acc)
TryGetSimpleSemicolonSequenceOfComprehension e2 (e1 :: acc)
else
None
| e ->
@ -3570,10 +3622,7 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c =
else
None
if YieldFree c then
GetSimpleSemicolonSequenceOfComprehension c []
else
None
TryGetSimpleSemicolonSequenceOfComprehension cexpr []
//-------------------------------------------------------------------------
// Mutually recursive shapes
@ -4089,9 +4138,8 @@ let buildApp cenv expr resultTy arg m =
| _ when isByrefTy g resultTy ->
// Handle byref returns, byref-typed returns get implicitly dereferenced
let v, _ = mkCompGenLocal m "byrefReturn" resultTy
let expr = expr.SupplyArgument (arg, m)
let expr = mkCompGenLet m v expr.Expr (mkAddrGet m (mkLocalValRef v))
let expr = mkDerefAddrExpr m expr.Expr m resultTy
let resultTy = destByrefTy g resultTy
MakeApplicableExprNoFlex cenv expr, resultTy
@ -5680,6 +5728,12 @@ and TcStmt cenv env tpenv synExpr =
else
mkCompGenSequential m expr (mkUnit cenv.g m), tpenv
and TryTcStmt cenv env tpenv synExpr =
let expr, ty, tpenv = TcExprOfUnknownType cenv env tpenv synExpr
let m = synExpr.Range
let hasTypeUnit = TryUnifyUnitTypeWithoutWarning cenv env m ty
hasTypeUnit, expr, tpenv
/// During checking of expressions of the form (x(y)).z(w1, w2)
/// keep a stack of things on the right. This lets us recognize
/// method applications and other item-based syntax.
@ -5748,6 +5802,13 @@ and TcExprUndelayedNoType cenv env tpenv synExpr: Expr * TType * _ =
expr, overallTy, tpenv
and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) =
// LanguageFeatures.ImplicitYield do not require this validation
let implicitYieldEnabled = cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield
let validateObjectSequenceOrRecordExpression = not implicitYieldEnabled
let validateExpressionWithIfRequiresParenethesis = not implicitYieldEnabled
let acceptDeprecatedIfThenExpression = not implicitYieldEnabled
match synExpr with
| SynExpr.Paren (expr2, _, _, mWholeExprIncludingParentheses) ->
// We invoke CallExprHasTypeSink for every construct which is atomic in the syntax, i.e. where a '.' immediately following the
@ -5946,25 +6007,23 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) =
match comp with
| SynExpr.New _ ->
errorR(Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm(), m))
| SimpleSemicolonSequence false _ ->
| SimpleSemicolonSequence cenv false _ when validateObjectSequenceOrRecordExpression ->
errorR(Error(FSComp.SR.tcInvalidObjectSequenceOrRecordExpression(), m))
| _ ->
()
if not !isNotNakedRefCell && not cenv.g.compilingFslib then
error(Error(FSComp.SR.tcInvalidSequenceExpressionSyntaxForm(), m))
TcComputationOrSequenceExpression cenv env overallTy m None tpenv comp
TcSequenceExpression cenv env tpenv comp overallTy m
| SynExpr.ArrayOrListOfSeqExpr (isArray, comp, m) ->
CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights)
match comp with
| SynExpr.CompExpr (_, _, (SimpleSemicolonSequence true elems as body), _) ->
match body with
| SimpleSemicolonSequence false _ ->
()
| _ ->
errorR(Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis(), m))
| SynExpr.CompExpr (_, _, (SimpleSemicolonSequence cenv acceptDeprecatedIfThenExpression elems as body), _) ->
match body with
| SimpleSemicolonSequence cenv false _ -> ()
| _ when validateExpressionWithIfRequiresParenethesis -> errorR(Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis(), m))
| _ -> ()
let replacementExpr =
if isArray then
@ -6063,6 +6122,19 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) =
let expr2, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv synExpr2
Expr.Sequential (expr1, expr2, ThenDoSeq, sp, m), tpenv
// Used to implement the type-directed 'implicit yield' rule for computation expressions
| SynExpr.SequentialOrImplicitYield (sp, synExpr1, synExpr2, otherExpr, m) ->
let isStmt, expr1, tpenv = TryTcStmt cenv env tpenv synExpr1
if isStmt then
let env = ShrinkContext env m synExpr2.Range
let expr2, tpenv = TcExprThatCanBeCtorBody cenv overallTy env tpenv synExpr2
Expr.Sequential(expr1, expr2, NormalSeq, sp, m), tpenv
else
// The first expression wasn't unit-typed, so proceed to the alternative interpretation
// Note a copy of the first expression is embedded in 'otherExpr' and thus
// this will type-check the first expression over again.
TcExpr cenv overallTy env tpenv otherExpr
| SynExpr.Do (synInnerExpr, m) ->
UnifyTypes cenv env m overallTy cenv.g.unit_ty
TcStmtThatCantBeCtorBody cenv env tpenv synInnerExpr
@ -6892,7 +6964,7 @@ and TcConstExpr cenv overallTy env m tpenv c =
let expr =
let modName = "NumericLiteral" + suffix
let ad = env.eAccessRights
match ResolveLongIndentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AtMostOneResult cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with
match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AtMostOneResult cenv.amap m true true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with
| Result []
| Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule modName, m))
| Result ((_, mref, _) :: _) ->
@ -7336,24 +7408,13 @@ and TcQuotationExpr cenv overallTy env tpenv (_oper, raw, ast, isFromQueryExpres
// We serialize the quoted expression to bytes in IlxGen after type inference etc. is complete.
expr, tpenv
//-------------------------------------------------------------------------
// TcComputationOrSequenceExpression
//-------------------------------------------------------------------------
and TcComputationOrSequenceExpression cenv (env: TcEnv) overallTy m interpValOpt tpenv comp =
match interpValOpt with
| Some (interpExpr: Expr, builderTy) ->
TcComputationExpression cenv env overallTy m interpExpr builderTy tpenv comp
| None ->
TcSequenceExpression cenv env tpenv comp overallTy m
/// Ignores an attribute
and IgnoreAttribute _ = None
// Used for all computation expressions except sequence expressions
and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv comp =
/// Used for all computation expressions except sequence expressions
and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builderTy tpenv (comp: SynExpr) =
//dprintfn "TcComputationOrSequenceExpression, comp = \n%A\n-------------------\n" comp
//dprintfn "TcComputationExpression, comp = \n%A\n-------------------\n" comp
let ad = env.eAccessRights
let mkSynDelay2 (e: SynExpr) = mkSynDelay (e.Range.MakeSynthetic()) e
@ -7382,19 +7443,18 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
let builderVal = mkSynIdGet m builderValName
mkSynApp1 (SynExpr.DotGet (builderVal, range0, LongIdentWithDots([mkSynId m nm], []), m)) args m
let sourceMethInfo = TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Source" builderTy
let hasMethInfo nm = TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad nm builderTy |> isNil |> not
let sourceMethInfo = TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Source" builderTy
// Optionally wrap sources of "let!", "yield!", "use!" in "query.Source"
let mkSourceExpr callExpr =
match sourceMethInfo with
| [] -> callExpr
| _ -> mkSynCall "Source" callExpr.Range [callExpr]
/// Decide if the builder is an auto-quote builder
let isAutoQuote =
match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Quote" builderTy with
| [] -> false
| _ -> true
let isAutoQuote = hasMethInfo "Quote"
let customOperationMethods =
AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv None ad IgnoreOverrides mBuilderVal builderTy
@ -7552,7 +7612,6 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
let (_, argInfo) = List.item i argInfos
HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs
let (|ForEachThen|_|) e =
match e with
| SynExpr.ForEach (_spBind, SeqExprOnly false, isFromSource, pat1, expr1, SynExpr.Sequential (_, true, clause, rest, _), _) -> Some (isFromSource, pat1, expr1, clause, rest)
@ -7705,7 +7764,6 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
| _ ->
None
let (|StripApps|) e =
let rec strip e =
match e with
@ -7764,6 +7822,20 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
| SynExpr.Sequential (_sp, true, dataComp1, dataComp2, _) -> (dataComp1, Some dataComp2)
| _ -> (e, None)
// "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1)
// This is not pretty - we have to decide which range markers we use for the calls to Combine and Delay
// NOTE: we should probably suppress these sequence points altogether
let rangeForCombine innerComp1 =
match innerComp1 with
| SynExpr.IfThenElse (_, _, _, _, _, mIfToThen, _m) -> mIfToThen
| SynExpr.Match (SequencePointAtBinding mMatch, _, _, _) -> mMatch
| SynExpr.TryWith (_, _, _, _, _, SequencePointAtTry mTry, _) -> mTry
| SynExpr.TryFinally (_, _, _, SequencePointAtTry mTry, _) -> mTry
| SynExpr.For (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind
| SynExpr.ForEach (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind
| SynExpr.While (SequencePointAtWhileLoop mWhile, _, _, _) -> mWhile
| _ -> innerComp1.Range
// Check for 'where x > y', 'select x, y' and other mis-applications of infix operators, give a good error message, and return a flag
let checkForBinaryApp comp =
match comp with
@ -7794,6 +7866,13 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
let emptyVarSpace = LazyWithContext.NotLazy ([], env)
// If there are no 'yield' in the computation expression, and the builder supports 'Yield',
// then allow the type-directed rule interpreting non-unit-typed expressions in statement
// positions as 'yield'. 'yield!' may be present in the computation expression.
let enableImplicitYield =
cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield
&& (hasMethInfo "Yield" && hasMethInfo "Combine" && hasMethInfo "Delay" && YieldFree cenv comp)
// q - a flag indicating if custom operators are allowed. They are not allowed inside try/with, try/finally, if/then/else etc.
// varSpace - a lazy data structure indicating the variables bound so far in the overall computation
// comp - the computation expression being analyzed
@ -8160,16 +8239,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
// "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1)
// This is not pretty - we have to decide which range markers we use for the calls to Combine and Delay
// NOTE: we should probably suppress these sequence points altogether
let m1 =
match innerComp1 with
| SynExpr.IfThenElse (_, _, _, _, _, mIfToThen, _m) -> mIfToThen
| SynExpr.Match (SequencePointAtBinding mMatch, _, _, _) -> mMatch
| SynExpr.TryWith (_, _, _, _, _, SequencePointAtTry mTry, _) -> mTry
| SynExpr.TryFinally (_, _, _, SequencePointAtTry mTry, _) -> mTry
| SynExpr.For (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind
| SynExpr.ForEach (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind
| SynExpr.While (SequencePointAtWhileLoop mWhile, _, _, _) -> mWhile
| _ -> innerComp1.Range
let m1 = rangeForCombine innerComp1
if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Combine" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"), m))
if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), m))
Some (translatedCtxt (mkSynCall "Combine" m1 [c; mkSynCall "Delay" m1 [mkSynDelay innerComp2.Range (transNoQueryOps innerComp2)]]))
@ -8185,7 +8255,20 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
Some(trans true q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, innerComp2, m)) translatedCtxt)
// "expr; cexpr" is treated as sequential execution
| _ ->
Some (trans true q varSpace innerComp2 (fun holeFill -> translatedCtxt (SynExpr.Sequential (sp, true, innerComp1, holeFill, m))))
Some (trans true q varSpace innerComp2 (fun holeFill ->
let fillExpr =
if enableImplicitYield then
// When implicit yields are enabled, then if the 'innerComp1' checks as type
// 'unit' we interpret the expression as a sequential, and when it doesn't
// have type 'unit' we interpret it as a 'Yield + Combine'.
let combineExpr =
let m1 = rangeForCombine innerComp1
let implicitYieldExpr = mkSynCall "Yield" comp.Range [innerComp1]
mkSynCall "Combine" m1 [implicitYieldExpr; mkSynCall "Delay" m1 [mkSynDelay holeFill.Range holeFill]]
SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m)
else
SynExpr.Sequential(sp, true, innerComp1, holeFill, m)
translatedCtxt fillExpr))
| SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch) ->
match elseCompOpt with
@ -8314,7 +8397,6 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
Some (translatedCtxt yieldExpr)
else
Some (translatedCtxt (mkSynCall "ReturnFrom" m [yieldExpr]))
| SynExpr.YieldOrReturn ((isYield, _), yieldExpr, m) ->
let methName = (if isYield then "Yield" else "Return")
@ -8324,7 +8406,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
| _ -> None
and transNoQueryOps comp = trans true false emptyVarSpace comp id
and transNoQueryOps comp =
trans true false emptyVarSpace comp id
and trans firstTry q varSpace comp translatedCtxt =
match tryTrans firstTry q varSpace comp translatedCtxt with
| Some e -> e
@ -8340,8 +8424,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Return" builderTy) then
SynExpr.ImplicitZero m
else
SynExpr.YieldOrReturn ((false, true), SynExpr.Const (SynConst.Unit, m), m)
trans true q varSpace (SynExpr.LetOrUseBang (NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt
SynExpr.YieldOrReturn((false, true), SynExpr.Const (SynConst.Unit, m), m)
trans true q varSpace (SynExpr.LetOrUseBang(NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt
// "expr;" in final position is treated as { expr; zero }
// Suppress the sequence point on the "zero"
| _ ->
@ -8353,21 +8438,27 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
match comp with
| SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential
| _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(), comp.RangeOfFirstPortion))
trans true q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> translatedCtxt (SynExpr.Sequential (SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range)))
trans true q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill ->
let fillExpr =
if enableImplicitYield then
let implicitYieldExpr = mkSynCall "Yield" comp.Range [comp]
SynExpr.SequentialOrImplicitYield(SuppressSequencePointOnStmtOfSequential, comp, holeFill, implicitYieldExpr, comp.Range)
else
SynExpr.Sequential(SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range)
translatedCtxt fillExpr)
let basicSynExpr = trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([], env)) comp (fun holeFill -> holeFill)
let basicSynExpr =
trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([], env)) comp (fun holeFill -> holeFill)
let delayedExpr =
match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Delay" builderTy with
| [] -> basicSynExpr
| _ -> mkSynCall "Delay" mBuilderVal [(mkSynDelay2 basicSynExpr)]
let quotedSynExpr =
if isAutoQuote then
SynExpr.Quote (mkSynIdGet (mBuilderVal.MakeSynthetic()) (CompileOpName "<@ @>"), (*isRaw=*)false, delayedExpr, (*isFromQueryExpression=*)true, mWhole)
else delayedExpr
let runExpr =
match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Run" builderTy with
@ -8405,6 +8496,13 @@ and TcSequenceExpression cenv env tpenv comp overallTy m =
// Allow subsumption at 'yield' if the element type is nominal prior to the analysis of the body of the sequence expression
let flex = not (isTyparTy cenv.g genEnumElemTy)
// If there are no 'yield' in the computation expression then allow the type-directed rule
// interpreting non-unit-typed expressions in statement positions as 'yield'. 'yield!' may be
// present in the computation expression.
let enableImplicitYield =
cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield
&& (YieldFree cenv comp)
let mkDelayedExpr (coreExpr: Expr) =
let m = coreExpr.Range
let overallTy = tyOfExpr cenv.g coreExpr
@ -8464,7 +8562,8 @@ and TcSequenceExpression cenv env tpenv comp overallTy m =
let innerExprMark = innerExpr.Range
Some(mkSeqFinally cenv env innerExprMark genOuterTy innerExpr unwindExpr, tpenv)
| SynExpr.Paren (_, _, _, m) ->
| SynExpr.Paren (_, _, _, m) when not (cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield)->
error(Error(FSComp.SR.tcConstructIsAmbiguousInSequenceExpression(), m))
| SynExpr.ImplicitZero m ->
@ -8476,17 +8575,15 @@ and TcSequenceExpression cenv env tpenv comp overallTy m =
| SynExpr.Sequential (sp, true, innerComp1, innerComp2, m) ->
// "expr; cexpr" is treated as sequential execution
// "cexpr; cexpr" is treated as append
match tryTcSequenceExprBody env genOuterTy tpenv innerComp1 with
| None ->
let innerExpr1, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv innerComp1
let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2
Some(Expr.Sequential (innerExpr1, innerExpr2, NormalSeq, sp, m), tpenv)
| Some (innerExpr1, tpenv) ->
let res, tpenv = tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv innerComp1
match res with
| Choice1Of2 innerExpr1 ->
let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2
let innerExpr2 = mkDelayedExpr innerExpr2
Some(mkSeqAppend cenv env innerComp1.Range genOuterTy innerExpr1 innerExpr2, tpenv)
| Choice2Of2 stmt1 ->
let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2
Some(Expr.Sequential(stmt1, innerExpr2, NormalSeq, sp, m), tpenv)
| SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, _isRecovery, mIfToThen, mIfToEndOfElseBranch) ->
let guardExpr', tpenv = TcExpr cenv cenv.g.bool_ty env tpenv guardExpr
@ -8560,15 +8657,34 @@ and TcSequenceExpression cenv env tpenv comp overallTy m =
| _ -> None
and tcSequenceExprBody env genOuterTy tpenv comp =
match tryTcSequenceExprBody env genOuterTy tpenv comp with
| Some e -> e
| None ->
// seq { ...; expr } is treated as 'seq { ... ; expr; yield! Seq.empty }'
// Note this means seq { ...; () } is treated as 'seq { ... ; (); yield! Seq.empty }'
let res, tpenv = tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp
match res with
| Choice1Of2 expr ->
expr, tpenv
| Choice2Of2 stmt ->
let m = comp.Range
let resExpr = Expr.Sequential(stmt, mkSeqEmpty cenv env m genOuterTy, NormalSeq, SuppressSequencePointOnStmtOfSequential, m)
resExpr, tpenv
and tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp =
match tryTcSequenceExprBody env genOuterTy tpenv comp with
| Some (expr, tpenv) -> Choice1Of2 expr, tpenv
| None ->
let env = { env with eContextInfo = ContextInfo.SequenceExpression genOuterTy }
let expr, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp
Expr.Sequential (expr, mkSeqEmpty cenv env m genOuterTy, NormalSeq, SuppressSequencePointOnStmtOfSequential, m), tpenv
if enableImplicitYield then
let hasTypeUnit, expr, tpenv = TryTcStmt cenv env tpenv comp
if hasTypeUnit then
Choice2Of2 expr, tpenv
else
let genResultTy = NewInferenceType ()
UnifyTypes cenv env m genOuterTy (mkSeqTy cenv.g genResultTy)
let exprTy = tyOfExpr cenv.g expr
AddCxTypeMustSubsumeType env.eContextInfo env.DisplayEnv cenv.css m NoTrace genResultTy exprTy
let resExpr = mkCallSeqSingleton cenv.g m genResultTy (mkCoerceExpr(expr, genResultTy, m, exprTy))
Choice1Of2 resExpr, tpenv
else
let stmt, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp
Choice2Of2 stmt, tpenv
let coreExpr, tpenv = tcSequenceExprBody env overallTy tpenv comp
let delayedExpr = mkDelayedExpr coreExpr
@ -8704,41 +8820,91 @@ and delayRest rest mPrior delayed =
let mPriorAndLongId = unionRanges mPrior (rangeOfLid longId)
DelayedDotLookup (rest, mPriorAndLongId) :: delayed
/// Typecheck "nameof" expressions
and TcNameOfExpr cenv env tpenv (synArg: SynExpr) =
let rec stripParens expr =
match expr with
| SynExpr.Paren(expr, _, _, _) -> stripParens expr
| _ -> expr
let cleanSynArg = stripParens synArg
let m = cleanSynArg.Range
let rec check overallTyOpt expr (delayed: DelayedItem list) =
match expr with
| LongOrSingleIdent (false, (LongIdentWithDots(longId, _) as lidd), _, _) when longId.Length > 0 ->
let ad = env.eAccessRights
let id, rest = List.headAndTail longId
match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest true with
| Result modref when delayed.IsEmpty && modref |> List.exists (p23 >> IsEntityAccessible cenv.amap m ad) ->
() // resolved to a module or namespace, done with checks
| _ ->
let (TypeNameResolutionInfo(_, staticArgsInfo)) = GetLongIdentTypeNameInfo delayed
match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with
| Result tcref when IsEntityAccessible cenv.amap m ad tcref ->
() // resolved to a type name, done with checks
| _ ->
let overallTy = match overallTyOpt with None -> NewInferenceType() | Some t -> t
let _, _ = TcLongIdentThen cenv overallTy env tpenv lidd delayed
() // checked as an expression, done with checks
List.last longId
| SynExpr.TypeApp (hd, _, types, _, _, _, m) ->
check overallTyOpt hd (DelayedTypeApp(types, m, m) :: delayed)
| SynExpr.Paren(expr, _, _, _) when overallTyOpt.IsNone && delayed.IsEmpty ->
check overallTyOpt expr []
| SynExpr.Typed (synBodyExpr, synType, _m) when delayed.IsEmpty && overallTyOpt.IsNone ->
let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType
check (Some tgtTy) synBodyExpr []
| _ ->
error (Error(FSComp.SR.expressionHasNoName(), m))
let lastIdent = check None cleanSynArg []
let constRange = mkRange m.FileName m.Start (mkPos m.StartLine (m.StartColumn + lastIdent.idText.Length + 2)) // `2` are for quotes
Expr.Const(Const.String(lastIdent.idText), constRange, cenv.g.string_ty)
//-------------------------------------------------------------------------
// TcFunctionApplicationThen: Typecheck "expr x" + projections
//-------------------------------------------------------------------------
and TcFunctionApplicationThen cenv overallTy env tpenv mExprAndArg expr exprty (synArg: SynExpr) atomicFlag delayed =
let denv = env.DisplayEnv
let mArg = synArg.Range
let mFunExpr = expr.Range
// If the type of 'synArg' unifies as a function type, then this is a function application, otherwise
// it is an error or a computation expression
match UnifyFunctionTypeUndoIfFailed cenv denv mFunExpr exprty with
| ValueSome (domainTy, resultTy) ->
// Notice the special case 'seq { ... }'. In this case 'seq' is actually a function in the F# library.
// Set a flag in the syntax tree to say we noticed a leading 'seq'
match synArg with
| SynExpr.CompExpr (false, isNotNakedRefCell, _comp, _m) ->
isNotNakedRefCell :=
!isNotNakedRefCell
||
(match expr with
| ApplicableExpr(_, Expr.Op (TOp.Coerce, _, [Expr.App (Expr.Val (vf, _, _), _, _, _, _)], _), _) when valRefEq cenv.g vf cenv.g.seq_vref -> true
| _ -> false)
| _ -> ()
let arg, tpenv = TcExpr cenv domainTy env tpenv synArg
let exprAndArg, resultTy = buildApp cenv expr resultTy arg mExprAndArg
TcDelayed cenv overallTy env tpenv mExprAndArg exprAndArg resultTy atomicFlag delayed
| _ ->
| ValueSome (domainTy, resultTy) ->
match expr with
| ApplicableExpr(_, NameOfExpr cenv.g _, _) when cenv.g.langVersion.SupportsFeature LanguageFeature.NameOf ->
let replacementExpr = TcNameOfExpr cenv env tpenv synArg
TcDelayed cenv overallTy env tpenv mExprAndArg (ApplicableExpr(cenv, replacementExpr, true)) cenv.g.string_ty ExprAtomicFlag.Atomic delayed
| _ ->
// Notice the special case 'seq { ... }'. In this case 'seq' is actually a function in the F# library.
// Set a flag in the syntax tree to say we noticed a leading 'seq'
match synArg with
| SynExpr.CompExpr (false, isNotNakedRefCell, _comp, _m) ->
isNotNakedRefCell :=
!isNotNakedRefCell
||
(match expr with
| ApplicableExpr(_, Expr.Op(TOp.Coerce, _, [SeqExpr cenv.g], _), _) -> true
| _ -> false)
| _ -> ()
let arg, tpenv = TcExpr cenv domainTy env tpenv synArg
let exprAndArg, resultTy = buildApp cenv expr resultTy arg mExprAndArg
TcDelayed cenv overallTy env tpenv mExprAndArg exprAndArg resultTy atomicFlag delayed
| ValueNone ->
// OK, 'expr' doesn't have function type, but perhaps 'expr' is a computation expression builder, and 'arg' is '{ ... }'
match synArg with
| SynExpr.CompExpr (false, _isNotNakedRefCell, comp, _m) ->
let bodyOfCompExpr, tpenv = TcComputationOrSequenceExpression cenv env overallTy mFunExpr (Some(expr.Expr, exprty)) tpenv comp
let bodyOfCompExpr, tpenv = TcComputationExpression cenv env overallTy mFunExpr expr.Expr exprty tpenv comp
TcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv bodyOfCompExpr) (tyOfExpr cenv.g bodyOfCompExpr) ExprAtomicFlag.NonAtomic delayed
| _ ->
error (NotAFunction(denv, overallTy, mFunExpr, mArg))
@ -8747,25 +8913,26 @@ and TcFunctionApplicationThen cenv overallTy env tpenv mExprAndArg expr exprty (
// TcLongIdentThen: Typecheck "A.B.C<D>.E.F ... " constructs
//-------------------------------------------------------------------------
and GetLongIdentTypeNameInfo delayed =
// Given 'MyOverloadedType<int>.MySubType...' use the number of given type arguments to help
// resolve type name lookup of 'MyOverloadedType'
// Also determine if type names should resolve to Item.Types or Item.CtorGroup
match delayed with
| DelayedTypeApp (tyargs, _, _) :: (DelayedDot | DelayedDotLookup _) :: _ ->
// cases like 'MyType<int>.Sth'
TypeNameResolutionInfo(ResolveTypeNamesToTypeRefs, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length)
| DelayedTypeApp (tyargs, _, _) :: _ ->
// Note, this also covers the case 'MyType<int>.' (without LValue_get), which is needed for VS (when typing)
TypeNameResolutionInfo(ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length)
| _ ->
TypeNameResolutionInfo.Default
and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) delayed =
let ad = env.eAccessRights
let typeNameResInfo =
// Given 'MyOverloadedType<int>.MySubType...' use arity of #given type arguments to help
// resolve type name lookup of 'MyOverloadedType'
// Also determine if type names should resolve to Item.Types or Item.CtorGroup
match delayed with
| DelayedTypeApp (tyargs, _, _) :: (DelayedDot | DelayedDotLookup _) :: _ ->
// cases like 'MyType<int>.Sth'
TypeNameResolutionInfo(ResolveTypeNamesToTypeRefs, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length)
| DelayedTypeApp (tyargs, _, _) :: _ ->
// Note, this also covers the case 'MyType<int>.' (without LValue_get), which is needed for VS (when typing)
TypeNameResolutionInfo(ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length)
| _ ->
TypeNameResolutionInfo.Default
let typeNameResInfo = GetLongIdentTypeNameInfo delayed
let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId
TcItemThen cenv overallTy env tpenv nameResolutionResult delayed
@ -9121,6 +9288,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del
| SynExpr.TryFinally _
| SynExpr.Lazy _
| SynExpr.Sequential _
| SynExpr.SequentialOrImplicitYield _
| SynExpr.LetOrUse _
| SynExpr.DotSet _
| SynExpr.DotIndexedSet _
@ -10044,8 +10212,7 @@ and TcMethodApplication
// byref-typed returns get implicitly dereferenced
let vty = tyOfExpr cenv.g callExpr0
if isByrefTy cenv.g vty then
let v, _ = mkCompGenLocal mMethExpr "byrefReturn" vty
mkCompGenLet mMethExpr v callExpr0 (mkAddrGet mMethExpr (mkLocalValRef v))
mkDerefAddrExpr mMethExpr callExpr0 mMethExpr vty
else
callExpr0
@ -12288,19 +12455,19 @@ let TcTyconMemberSpecs cenv env containerInfo declKind tpenv (augSpfn: SynMember
// Bind 'open' declarations
//-------------------------------------------------------------------------
let TcModuleOrNamespaceLidAndPermitAutoResolve tcSink env amap (longId: Ident list) =
let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) =
let ad = env.eAccessRights
match longId with
| [] -> []
| id :: rest ->
let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges
match ResolveLongIndentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.eNameResEnv ad id rest true with
match ResolveLongIndentAsModuleOrNamespaceOrStaticClass tcSink ResultCollectionSettings.AllResults amap m true true OpenQualified env.eNameResEnv ad id rest true with
| Result res -> res
| Exception err ->
errorR(err); []
let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) =
match TcModuleOrNamespaceLidAndPermitAutoResolve tcSink env amap longId with
match TcOpenLidAndPermitAutoResolve tcSink env amap longId with
| [] -> env
| modrefs ->
@ -12352,7 +12519,7 @@ let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) =
modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult)
let openDecl = OpenDeclaration.Create (longId, modrefs, scopem, false)
let env = OpenModulesOrNamespaces tcSink g amap scopem false env modrefs openDecl
let env = OpenEntities tcSink g amap scopem false env modrefs openDecl
env
@ -13827,7 +13994,7 @@ module MutRecBindingChecking =
let resolved =
match p with
| [] -> Result []
| id :: rest -> ResolveLongIndentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest false
| id :: rest -> ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest false
let mvvs = ForceRaise resolved
if isNil mvvs then env else
let modrefs = mvvs |> List.map p23
@ -16659,7 +16826,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS
let resolved =
match p with
| [] -> Result []
| id :: rest -> ResolveLongIndentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest false
| id :: rest -> ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest false
let mvvs = ForceRaise resolved
let scopem = unionRanges m endm
let unfilteredModrefs = mvvs |> List.map p23
@ -17213,7 +17380,7 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env
| ValueNone -> warn()
| ValueSome _ ->
let openDecl = OpenDeclaration.Create ([], [modref], scopem, false)
OpenModulesOrNamespaces TcResultsSink.NoSink g amap scopem root env [modref] openDecl
OpenEntities TcResultsSink.NoSink g amap scopem root env [modref] openDecl
// Add the CCU and apply the "AutoOpen" attributes
let AddCcuToTcEnv(g, amap, scopem, env, assemblyName, ccu, autoOpens, internalsVisible) =

23
src/fsharp/UnicodeLexing.fs
Просмотреть файл

@ -7,22 +7,23 @@ module internal FSharp.Compiler.UnicodeLexing
//
open FSharp.Compiler.AbstractIL.Internal.Library
open FSharp.Compiler.Features
open Internal.Utilities
open System.IO
open System.IO
open Internal.Utilities.Text.Lexing
type Lexbuf = LexBuffer<char>
let StringAsLexbuf (s:string) : Lexbuf =
LexBuffer<_>.FromChars (s.ToCharArray())
let FunctionAsLexbuf (bufferFiller: char[] * int * int -> int) : Lexbuf =
LexBuffer<_>.FromFunction bufferFiller
let StringAsLexbuf (supportsFeature: Features.LanguageFeature -> bool, s:string) : Lexbuf =
LexBuffer<_>.FromChars (supportsFeature, s.ToCharArray())
let FunctionAsLexbuf (supportsFeature: Features.LanguageFeature -> bool, bufferFiller: char[] * int * int -> int) : Lexbuf =
LexBuffer<_>.FromFunction(supportsFeature, bufferFiller)
let SourceTextAsLexbuf (supportsFeature: Features.LanguageFeature -> bool, sourceText) =
LexBuffer<char>.FromSourceText(supportsFeature, sourceText)
let SourceTextAsLexbuf sourceText =
LexBuffer<char>.FromSourceText(sourceText)
// The choice of 60 retries times 50 ms is not arbitrary. The NTFS FILETIME structure
// uses 2 second resolution for LastWriteTime. We retry long enough to surpass this threshold
// plus 1 second. Once past the threshold the incremental builder will be able to retry asynchronously based
@ -41,7 +42,7 @@ let numRetries = 60
/// we can't just return the LexBuffer object, since the file it wraps wouldn't
/// get closed when we're finished with the LexBuffer. Hence we return the stream,
/// the reader and the LexBuffer. The caller should dispose the first two when done.
let UnicodeFileAsLexbuf (filename,codePage : int option, retryLocked:bool) : Lexbuf =
let UnicodeFileAsLexbuf (supportsFeature: Features.LanguageFeature -> bool, filename, codePage: int option, retryLocked: bool): Lexbuf =
// Retry multiple times since other processes may be writing to this file.
let rec getSource retryNumber =
try
@ -68,5 +69,5 @@ let UnicodeFileAsLexbuf (filename,codePage : int option, retryLocked:bool) : Le
else
reraise()
let source = getSource 0
let lexbuf = LexBuffer<_>.FromChars(source.ToCharArray())
let lexbuf = LexBuffer<_>.FromChars(supportsFeature, source.ToCharArray())
lexbuf

9
src/fsharp/UnicodeLexing.fsi
Просмотреть файл

@ -2,12 +2,13 @@
module internal FSharp.Compiler.UnicodeLexing
open FSharp.Compiler.Features
open FSharp.Compiler.Text
open Microsoft.FSharp.Text
open Internal.Utilities.Text.Lexing
type Lexbuf = LexBuffer<char>
val internal StringAsLexbuf : string -> Lexbuf
val public FunctionAsLexbuf : (char [] * int * int -> int) -> Lexbuf
val public UnicodeFileAsLexbuf :string * int option * (*retryLocked*) bool -> Lexbuf
val public SourceTextAsLexbuf : ISourceText -> Lexbuf
val internal StringAsLexbuf: (Features.LanguageFeature -> bool) * string -> Lexbuf
val public FunctionAsLexbuf: (Features.LanguageFeature -> bool) * (char [] * int * int -> int) -> Lexbuf
val public UnicodeFileAsLexbuf: (Features.LanguageFeature -> bool) * string * int option * (*retryLocked*) bool -> Lexbuf
val public SourceTextAsLexbuf: (Features.LanguageFeature -> bool) * ISourceText -> Lexbuf

23
src/fsharp/XmlAdapters.fs Normal file
Просмотреть файл

@ -0,0 +1,23 @@
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
namespace Microsoft.FSharp.Core
open System.Reflection
//Replacement for: System.Security.SecurityElement.Escape(line) All platforms
module internal XmlAdapters =
open System.Text
open Microsoft.FSharp.Collections
let s_escapeChars = [| '<'; '>'; '\"'; '\''; '&' |]
let getEscapeSequence c =
match c with
| '<' -> "&lt;"
| '>' -> "&gt;"
| '\"' -> "&quot;"
| '\'' -> "&apos;"
| '&' -> "&amp;"
| _ as ch -> ch.ToString()
let escape str = String.collect getEscapeSequence str

168
src/fsharp/ast.fs
Просмотреть файл

@ -12,6 +12,7 @@ open FSharp.Compiler.AbstractIL.Internal.Library
open FSharp.Compiler
open FSharp.Compiler.UnicodeLexing
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.Range
@ -671,7 +672,7 @@ and
/// F# syntax: lazy expr
| Lazy of SynExpr * range: range
/// Seq(seqPoint, isTrueSeq, e1, e2, m)
/// Sequential(seqPoint, isTrueSeq, e1, e2, m)
/// isTrueSeq: false indicates "let v = a in b; v"
///
/// F# syntax: expr; expr
@ -749,10 +750,12 @@ and
/// Computation expressions only, based on JOIN_IN token from lex filter
| JoinIn of SynExpr * range * SynExpr * range: range
/// F# syntax: <implicit>
/// Computation expressions only, implied by final "do" or "do!"
/// Used internally during type checking for translating computation expressions.
| ImplicitZero of range: range
/// Used internally during type checking for translating computation expressions.
| SequentialOrImplicitYield of seqPoint:SequencePointInfoForSeq * expr1:SynExpr * expr2:SynExpr * ifNotStmt:SynExpr * range:range
/// F# syntax: yield expr
/// F# syntax: return expr
/// Computation expressions only
@ -833,6 +836,7 @@ and
| SynExpr.TryWith (range=m)
| SynExpr.TryFinally (range=m)
| SynExpr.Sequential (range=m)
| SynExpr.SequentialOrImplicitYield (range=m)
| SynExpr.ArbitraryAfterError (range=m)
| SynExpr.FromParseError (range=m)
| SynExpr.DiscardAfterMissingQualificationAfterDot (range=m)
@ -872,138 +876,25 @@ and
/// range ignoring any (parse error) extra trailing dots
member e.RangeSansAnyExtraDot =
match e with
| SynExpr.Paren (range=m)
| SynExpr.Quote (range=m)
| SynExpr.Const (range=m)
| SynExpr.Typed (range=m)
| SynExpr.Tuple (range=m)
| SynExpr.ArrayOrList (range=m)
| SynExpr.AnonRecd (range=m)
| SynExpr.Record (range=m)
| SynExpr.New (range=m)
| SynExpr.ObjExpr (range=m)
| SynExpr.While (range=m)
| SynExpr.For (range=m)
| SynExpr.ForEach (range=m)
| SynExpr.CompExpr (range=m)
| SynExpr.ArrayOrListOfSeqExpr (range=m)
| SynExpr.Lambda (range=m)
| SynExpr.Match (range=m)
| SynExpr.MatchLambda (range=m)
| SynExpr.Do (range=m)
| SynExpr.Assert (range=m)
| SynExpr.App (range=m)
| SynExpr.TypeApp (range=m)
| SynExpr.LetOrUse (range=m)
| SynExpr.TryWith (range=m)
| SynExpr.TryFinally (range=m)
| SynExpr.Sequential (range=m)
| SynExpr.ArbitraryAfterError (range=m)
| SynExpr.FromParseError (range=m)
| SynExpr.IfThenElse (range=m)
| SynExpr.LongIdentSet (range=m)
| SynExpr.NamedIndexedPropertySet (range=m)
| SynExpr.DotIndexedGet (range=m)
| SynExpr.DotIndexedSet (range=m)
| SynExpr.DotSet (range=m)
| SynExpr.Set (range=m)
| SynExpr.DotNamedIndexedPropertySet (range=m)
| SynExpr.LibraryOnlyUnionCaseFieldGet (range=m)
| SynExpr.LibraryOnlyUnionCaseFieldSet (range=m)
| SynExpr.LibraryOnlyILAssembly (range=m)
| SynExpr.LibraryOnlyStaticOptimization (range=m)
| SynExpr.TypeTest (range=m)
| SynExpr.Upcast (range=m)
| SynExpr.AddressOf (range=m)
| SynExpr.Downcast (range=m)
| SynExpr.JoinIn (range=m)
| SynExpr.InferredUpcast (range=m)
| SynExpr.InferredDowncast (range=m)
| SynExpr.Null (range=m)
| SynExpr.Lazy (range=m)
| SynExpr.TraitCall (range=m)
| SynExpr.ImplicitZero (range=m)
| SynExpr.YieldOrReturn (range=m)
| SynExpr.YieldOrReturnFrom (range=m)
| SynExpr.LetOrUseBang (range=m)
| SynExpr.MatchBang (range=m)
| SynExpr.DoBang (range=m) -> m
| SynExpr.DotGet (expr, _, lidwd, m) -> if lidwd.ThereIsAnExtraDotAtTheEnd then unionRanges expr.Range lidwd.RangeSansAnyExtraDot else m
| SynExpr.LongIdent (_, lidwd, _, _) -> lidwd.RangeSansAnyExtraDot
| SynExpr.DiscardAfterMissingQualificationAfterDot (expr, _) -> expr.Range
| SynExpr.Fixed (_, m) -> m
| SynExpr.Ident id -> id.idRange
| _ -> e.Range
/// Attempt to get the range of the first token or initial portion only - this is extremely ad-hoc, just a cheap way to improve a certain 'query custom operation' error range
member e.RangeOfFirstPortion =
match e with
// haven't bothered making these cases better than just .Range
| SynExpr.Quote (range=m)
| SynExpr.Const (range=m)
| SynExpr.Typed (range=m)
| SynExpr.Tuple (range=m)
| SynExpr.ArrayOrList (range=m)
| SynExpr.AnonRecd (range=m)
| SynExpr.Record (range=m)
| SynExpr.New (range=m)
| SynExpr.ObjExpr (range=m)
| SynExpr.While (range=m)
| SynExpr.For (range=m)
| SynExpr.CompExpr (range=m)
| SynExpr.ArrayOrListOfSeqExpr (range=m)
| SynExpr.Lambda (range=m)
| SynExpr.Match (range=m)
| SynExpr.MatchLambda (range=m)
| SynExpr.Do (range=m)
| SynExpr.Assert (range=m)
| SynExpr.TypeApp (range=m)
| SynExpr.LetOrUse (range=m)
| SynExpr.TryWith (range=m)
| SynExpr.TryFinally (range=m)
| SynExpr.ArbitraryAfterError (range=m)
| SynExpr.FromParseError (range=m)
| SynExpr.DiscardAfterMissingQualificationAfterDot (range=m)
| SynExpr.IfThenElse (range=m)
| SynExpr.LongIdent (range=m)
| SynExpr.LongIdentSet (range=m)
| SynExpr.NamedIndexedPropertySet (range=m)
| SynExpr.DotIndexedGet (range=m)
| SynExpr.DotIndexedSet (range=m)
| SynExpr.DotGet (range=m)
| SynExpr.DotSet (range=m)
| SynExpr.Set (range=m)
| SynExpr.DotNamedIndexedPropertySet (range=m)
| SynExpr.LibraryOnlyUnionCaseFieldGet (range=m)
| SynExpr.LibraryOnlyUnionCaseFieldSet (range=m)
| SynExpr.LibraryOnlyILAssembly (range=m)
| SynExpr.LibraryOnlyStaticOptimization (range=m)
| SynExpr.TypeTest (range=m)
| SynExpr.Upcast (range=m)
| SynExpr.AddressOf (range=m)
| SynExpr.Downcast (range=m)
| SynExpr.JoinIn (range=m)
| SynExpr.InferredUpcast (range=m)
| SynExpr.InferredDowncast (range=m)
| SynExpr.Null (range=m)
| SynExpr.Lazy (range=m)
| SynExpr.TraitCall (range=m)
| SynExpr.ImplicitZero (range=m)
| SynExpr.YieldOrReturn (range=m)
| SynExpr.YieldOrReturnFrom (range=m)
| SynExpr.LetOrUseBang (range=m)
| SynExpr.MatchBang (range=m)
| SynExpr.DoBang (range=m) -> m
// these are better than just .Range, and also commonly applicable inside queries
| SynExpr.Paren (_, m, _, _) -> m
| SynExpr.Sequential (_, _, e1, _, _)
| SynExpr.SequentialOrImplicitYield (_, e1, _, _, _)
| SynExpr.App (_, _, e1, _, _) ->
e1.RangeOfFirstPortion
| SynExpr.ForEach (_, _, _, pat, _, _, r) ->
let start = r.Start
let e = (pat.Range: range).Start
mkRange r.FileName start e
| SynExpr.Ident id -> id.idRange
| SynExpr.Fixed (_, m) -> m
| _ -> e.Range
and
[<NoEquality; NoComparison; RequireQualifiedAccess>]
@ -1972,36 +1863,51 @@ let PushCurriedPatternsToExpr synArgNameGenerator wholem isMember pats rhs =
expr
spatsl, expr
/// Helper for parsing the inline IL fragments.
let internal internalParseAssemblyCodeInstructions s isFeatureSupported m =
#if NO_INLINE_IL_PARSER
let ParseAssemblyCodeInstructions _s m =
ignore s
ignore isFeatureSupported
errorR(Error((193, "Inline IL not valid in a hosted environment"), m))
[| |]
#else
let ParseAssemblyCodeInstructions s m =
try FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilInstrs
try
FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilInstrs
FSharp.Compiler.AbstractIL.Internal.AsciiLexer.token
(UnicodeLexing.StringAsLexbuf s)
(UnicodeLexing.StringAsLexbuf(isFeatureSupported, s))
with _ ->
errorR(Error(FSComp.SR.astParseEmbeddedILError(), m)); [| |]
errorR(Error(FSComp.SR.astParseEmbeddedILError(), m)); [||]
#endif
let ParseAssemblyCodeInstructions s m =
// Public API can not answer the isFeatureSupported questions, so here we support everything
let isFeatureSupported (_featureId:LanguageFeature) = true
internalParseAssemblyCodeInstructions s isFeatureSupported m
let internal internalParseAssemblyCodeType s isFeatureSupported m =
ignore s
ignore isFeatureSupported
/// Helper for parsing the inline IL fragments.
#if NO_INLINE_IL_PARSER
let ParseAssemblyCodeType _s m =
errorR(Error((193, "Inline IL not valid in a hosted environment"), m))
IL.EcmaMscorlibILGlobals.typ_Object
#else
let ParseAssemblyCodeType s m =
try FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilType
let isFeatureSupported (_featureId:LanguageFeature) = true
try
FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilType
FSharp.Compiler.AbstractIL.Internal.AsciiLexer.token
(UnicodeLexing.StringAsLexbuf s)
(UnicodeLexing.StringAsLexbuf(isFeatureSupported, s))
with RecoverableParseError ->
errorR(Error(FSComp.SR.astParseEmbeddedILTypeError(), m));
IL.EcmaMscorlibILGlobals.typ_Object
#endif
/// Helper for parsing the inline IL fragments.
let ParseAssemblyCodeType s m =
// Public API can not answer the isFeatureSupported questions, so here we support everything
let isFeatureSupported (_featureId:LanguageFeature) = true
internalParseAssemblyCodeType s isFeatureSupported m
//------------------------------------------------------------------------
// AST constructors
//------------------------------------------------------------------------
@ -2564,6 +2470,8 @@ let rec synExprContainsError inpExpr =
walkExpr e1 || walkExpr e2
| SynExpr.Sequential (_, _, e1, e2, _) ->
walkExpr e1 || walkExpr e2
| SynExpr.SequentialOrImplicitYield (_, e1, e2, _, _) ->
walkExpr e1 || walkExpr e2
| SynExpr.IfThenElse (e1, e2, e3opt, _, _, _, _) ->
walkExpr e1 || walkExpr e2 || walkExprOpt e3opt
| SynExpr.DotIndexedGet (e1, es, _, _) ->

15
src/fsharp/fsc.fs
Просмотреть файл

@ -1063,13 +1063,10 @@ module MainModuleBuilder =
elif not(tcConfig.target.IsExe) || not(tcConfig.includewin32manifest) || not(tcConfig.win32res = "") || runningOnMono then ""
// otherwise, include the default manifest
else
#if FX_NO_RUNTIMEENVIRONMENT
// On coreclr default manifest is alongside the compiler
Path.Combine(System.AppContext.BaseDirectory, @"default.win32manifest")
#else
// On the desktop default manifest is alongside the clr
Path.Combine(System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(), @"default.win32manifest")
#endif
let path = Path.Combine(System.AppContext.BaseDirectory, @"default.win32manifest")
if File.Exists(path) then path
else Path.Combine(System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(), @"default.win32manifest")
let nativeResources =
[ for av in assemblyVersionResources findAttribute assemblyVersion do
yield ILNativeResource.Out av
@ -1723,11 +1720,7 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted,
let directoryBuildingFrom = Directory.GetCurrentDirectory()
let setProcessThreadLocals tcConfigB =
match tcConfigB.preferredUiLang with
#if FX_RESHAPED_GLOBALIZATION
| Some s -> CultureInfo.CurrentUICulture <- new CultureInfo(s)
#else
| Some s -> Thread.CurrentThread.CurrentUICulture <- new CultureInfo(s)
#endif
| None -> ()
if tcConfigB.utf8output then
Console.OutputEncoding <- Encoding.UTF8

3
src/fsharp/fsi/console.fs
Просмотреть файл

@ -13,8 +13,6 @@ open System.Collections.Generic
module internal ConsoleOptions =
let readKeyFixup (c:char) =
#if FX_NO_SERVERCODEPAGES
#else
// Assumes the c:char is actually a byte in the System.Console.InputEncoding.
// Convert it to a Unicode char through the encoding.
if 0 <= int c && int c <= 255 then
@ -26,7 +24,6 @@ module internal ConsoleOptions =
c // no fix up
else
assert("readKeyFixHook: given char is outside the 0..255 byte range" = "")
#endif
c
type internal Style = Prompt | Out | Error

55
src/fsharp/fsi/fsi.fs
Просмотреть файл

@ -27,13 +27,14 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader
open FSharp.Compiler.AbstractIL.Internal
open FSharp.Compiler.AbstractIL.Internal.Library
open FSharp.Compiler.AbstractIL.Extensions.ILX
open FSharp.Compiler.AbstractIL.ILRuntimeWriter
open FSharp.Compiler.AbstractIL.ILRuntimeWriter
open FSharp.Compiler.Lib
open FSharp.Compiler.AccessibilityLogic
open FSharp.Compiler.Ast
open FSharp.Compiler.CompileOptions
open FSharp.Compiler.CompileOps
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Infos
open FSharp.Compiler.InfoReader
open FSharp.Compiler.NameResolution
@ -389,9 +390,7 @@ type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, g: TcGlobals,
| PrintExpr ->
anyToLayoutCall.AnyToLayout(opts, x, ty)
with
#if !FX_REDUCED_EXCEPTIONS
| :? ThreadAbortException -> Layout.wordL (TaggedTextOps.tagText "")
#endif
| e ->
#if DEBUG
printf "\n\nPrintValue: x = %+A and ty=%s\n" x (ty.FullName)
@ -803,7 +802,6 @@ let internal InstallErrorLoggingOnThisThread errorLogger =
SetThreadErrorLoggerNoUnwind(errorLogger)
SetThreadBuildPhaseNoUnwind(BuildPhase.Interactive)
#if !FX_NO_SERVERCODEPAGES
/// Set the input/output encoding. The use of a thread is due to a known bug on
/// on Vista where calls to Console.InputEncoding can block the process.
let internal SetServerCodePages(fsiOptions: FsiCommandLineOptions) =
@ -833,7 +831,6 @@ let internal SetServerCodePages(fsiOptions: FsiCommandLineOptions) =
if not !successful then
System.Windows.Forms.MessageBox.Show(FSIstrings.SR.fsiConsoleProblem()) |> ignore
#endif
#endif
//----------------------------------------------------------------------------
// Prompt printing
@ -1618,9 +1615,11 @@ type internal FsiStdinLexerProvider
let initialLightSyntaxStatus = tcConfigB.light <> Some false
LightSyntaxStatus (initialLightSyntaxStatus, false (* no warnings *))
let isFeatureSupported featureId = tcConfigB.langVersion.SupportsFeature featureId
let LexbufFromLineReader (fsiStdinSyphon: FsiStdinSyphon) readf =
UnicodeLexing.FunctionAsLexbuf
(fun (buf: char[], start, len) ->
UnicodeLexing.FunctionAsLexbuf
(isFeatureSupported, (fun (buf: char[], start, len) ->
//fprintf fsiConsoleOutput.Out "Calling ReadLine\n"
let inputOption = try Some(readf()) with :? EndOfStreamException -> None
inputOption |> Option.iter (fun t -> fsiStdinSyphon.Add (t + "\n"))
@ -1636,7 +1635,7 @@ type internal FsiStdinLexerProvider
for i = 0 to ntrimmed-1 do
buf.[i+start] <- input.[i]
ntrimmed
)
))
//----------------------------------------------------------------------------
// Reading stdin as a lex stream
@ -1657,6 +1656,7 @@ type internal FsiStdinLexerProvider
let tokenizer = LexFilter.LexFilter(interactiveInputLightSyntaxStatus, tcConfigB.compilingFslib, Lexer.token lexargs skip, lexbuf)
tokenizer
let isFeatureSupported featureId = tcConfigB.langVersion.SupportsFeature featureId
// Create a new lexer to read stdin
member __.CreateStdinLexer (errorLogger) =
@ -1675,12 +1675,12 @@ type internal FsiStdinLexerProvider
// Create a new lexer to read an "included" script file
member __.CreateIncludedScriptLexer (sourceFileName, errorLogger) =
let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(sourceFileName,tcConfigB.inputCodePage,(*retryLocked*)false)
let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(isFeatureSupported, sourceFileName, tcConfigB.inputCodePage, (*retryLocked*)false)
CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger)
// Create a new lexer to read a string
member this.CreateStringLexer (sourceFileName, source, errorLogger) =
let lexbuf = UnicodeLexing.StringAsLexbuf(source)
let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, source)
CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger)
member __.ConsoleInput = fsiConsoleInput
@ -1738,6 +1738,7 @@ type internal FsiInteractionProcessor
stopProcessingRecovery e range0
istate,CompletedWithReportedError e
let isFeatureSupported featureId = tcConfigB.langVersion.SupportsFeature featureId
let rangeStdin = rangeN Lexhelp.stdinMockFilename 0
@ -1944,13 +1945,11 @@ type internal FsiInteractionProcessor
fsiInterruptController.InterruptAllowed <- InterruptIgnored;
res
with
#if !FX_REDUCED_EXCEPTIONS
| :? ThreadAbortException ->
fsiInterruptController.ClearInterruptRequest()
fsiInterruptController.InterruptAllowed <- InterruptIgnored;
(try Thread.ResetAbort() with _ -> ());
(istate,CtrlC)
#endif
| e ->
fsiInterruptController.ClearInterruptRequest()
fsiInterruptController.InterruptAllowed <- InterruptIgnored;
@ -1964,11 +1963,7 @@ type internal FsiInteractionProcessor
let parseExpression (tokenizer:LexFilter.LexFilter) =
reusingLexbufForParsing tokenizer.LexBuffer (fun () ->
Parser.typedSeqExprEOF tokenizer.Lexer tokenizer.LexBuffer)
// let parseType (tokenizer:LexFilter.LexFilter) =
// reusingLexbufForParsing tokenizer.LexBuffer (fun () ->
// Parser.typEOF tokenizer.Lexer tokenizer.LexBuffer)
let mainThreadProcessParsedExpression ctok errorLogger (expr, istate) =
istate |> InteractiveCatch errorLogger (fun istate ->
istate |> mainThreadProcessAction ctok (fun ctok _tcConfig istate ->
@ -2096,7 +2091,7 @@ type internal FsiInteractionProcessor
use _unwind1 = ErrorLogger.PushThreadBuildPhaseUntilUnwind(ErrorLogger.BuildPhase.Interactive)
use _unwind2 = ErrorLogger.PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger)
use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID
let lexbuf = UnicodeLexing.StringAsLexbuf(sourceText)
let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, sourceText)
let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger)
currState
|> InteractiveCatch errorLogger (fun istate ->
@ -2113,7 +2108,7 @@ type internal FsiInteractionProcessor
use _unwind1 = ErrorLogger.PushThreadBuildPhaseUntilUnwind(ErrorLogger.BuildPhase.Interactive)
use _unwind2 = ErrorLogger.PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger)
use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID
let lexbuf = UnicodeLexing.StringAsLexbuf(sourceText)
let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, sourceText)
let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger)
currState
|> InteractiveCatch errorLogger (fun istate ->
@ -2263,7 +2258,6 @@ let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiConsoleO
if !progress then fprintfn fsiConsoleOutput.Out "MAIN: entering event loop...";
fsi.EventLoopRun()
with
#if !FX_REDUCED_EXCEPTIONS
| :? ThreadAbortException ->
// If this TAE handler kicks it's almost certainly too late to save the
// state of the process - the state of the message loop may have been corrupted
@ -2271,7 +2265,6 @@ let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiConsoleO
(try Thread.ResetAbort() with _ -> ());
true
// Try again, just case we can restart
#endif
| e ->
stopProcessingRecovery e range0;
true
@ -2368,20 +2361,14 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i
do
match tcConfigB.preferredUiLang with
#if FX_RESHAPED_GLOBALIZATION
| Some s -> System.Globalization.CultureInfo.CurrentUICulture <- new System.Globalization.CultureInfo(s)
#else
| Some s -> Thread.CurrentThread.CurrentUICulture <- new System.Globalization.CultureInfo(s)
#endif
| None -> ()
#if !FX_NO_SERVERCODEPAGES
do
try
SetServerCodePages fsiOptions
with e ->
do
try
SetServerCodePages fsiOptions
with e ->
warning(e)
#endif
do
updateBannerText() // resetting banner text after parsing options
@ -2572,8 +2559,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i
member x.FormatValue(obj:obj, objTy) =
fsiDynamicCompiler.FormatValue(obj, objTy)
member x.EvalExpression(sourceText) =
member x.EvalExpression(sourceText) =
// Explanation: When the user of the FsiInteractiveSession object calls this method, the
// code is parsed, checked and evaluated on the calling thread. This means EvalExpression
// is not safe to call concurrently.
@ -2582,7 +2569,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i
fsiInteractionProcessor.EvalExpression(ctok, sourceText, dummyScriptFileName, errorLogger)
|> commitResult
member x.EvalExpressionNonThrowing(sourceText) =
member x.EvalExpressionNonThrowing(sourceText) =
// Explanation: When the user of the FsiInteractiveSession object calls this method, the
// code is parsed, checked and evaluated on the calling thread. This means EvalExpression
// is not safe to call concurrently.

3
src/fsharp/fsi/fsi.fsproj
Просмотреть файл

@ -34,9 +34,6 @@
<ProjectReference Include="$(MSBuildThisFileDirectory)..\FSharp.Compiler.Private\FSharp.Compiler.Private.fsproj" />
<ProjectReference Include="$(MSBuildThisFileDirectory)..\FSharp.Compiler.Interactive.Settings\FSharp.Compiler.Interactive.Settings.fsproj" />
<!-- only used when '$(TargetFramework)' == 'netstandard2.0' -->
<ProjectReference Include="..\FSharp.Build\FSharp.Build.fsproj" Condition="'$(TargetFramework)' == 'netstandard2.0'" />
<!-- only used when '$(TargetFramework)' == 'net472' -->
<ProjectReference Include="$(MSBuildThisFileDirectory)..\FSharp.Compiler.Server.Shared\FSharp.Compiler.Server.Shared.fsproj" Condition="'$(TargetFramework)' == 'net472'" />
</ItemGroup>

12
src/fsharp/fsi/xlf/FSIstrings.txt.de.xlf
Просмотреть файл

@ -14,27 +14,27 @@
</trans-unit>
<trans-unit id="fsiInputFiles">
<source>- INPUT FILES -</source>
<target state="translated">- EINGABEDATEIEN -</target>
<target state="translated">– EINGABEDATEIEN –</target>
<note />
</trans-unit>
<trans-unit id="fsiCodeGeneration">
<source>- CODE GENERATION -</source>
<target state="translated">- CODEGENERIERUNG -</target>
<target state="translated">– CODEGENERIERUNG –</target>
<note />
</trans-unit>
<trans-unit id="fsiErrorsAndWarnings">
<source>- ERRORS AND WARNINGS -</source>
<target state="translated">- FEHLER UND WARNUNGEN -</target>
<target state="translated">– FEHLER UND WARNUNGEN –</target>
<note />
</trans-unit>
<trans-unit id="fsiLanguage">
<source>- LANGUAGE -</source>
<target state="translated">- SPRACHE -</target>
<target state="translated">– SPRACHE –</target>
<note />
</trans-unit>
<trans-unit id="fsiMiscellaneous">
<source>- MISCELLANEOUS -</source>
<target state="translated">- VERSCHIEDENES -</target>
<target state="translated">– VERSCHIEDENES –</target>
<note />
</trans-unit>
<trans-unit id="fsiAdvanced">
@ -199,7 +199,7 @@
</trans-unit>
<trans-unit id="fsiAbortingMainThread">
<source>- Aborting main thread...</source>
<target state="translated">- Hauptthread wird abgebrochen...</target>
<target state="translated">– Hauptthread wird abgebrochen...</target>
<note />
</trans-unit>
<trans-unit id="fsiCouldNotInstallCtrlCHandler">

2
src/fsharp/fsi/xlf/FSIstrings.txt.ja.xlf
Просмотреть файл

@ -129,7 +129,7 @@
</trans-unit>
<trans-unit id="fsiTimeInfoGCGenerationLabelSomeShorthandForTheWordGeneration">
<source>gen</source>
<target state="translated">gen</target>
<target state="translated">全般</target>
<note />
</trans-unit>
<trans-unit id="fsiExceptionDuringPrettyPrinting">

12
src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hant.xlf
Просмотреть файл

@ -74,7 +74,7 @@
</trans-unit>
<trans-unit id="fsiGui">
<source>Execute interactions on a Windows Forms event loop (on by default)</source>
<target state="translated">在 Windows Form 事件迴圈上執行互動 (預設為開啟)</target>
<target state="translated">在 Windows Forms 事件迴圈上執行互動 (預設為開啟)</target>
<note />
</trans-unit>
<trans-unit id="fsiQuiet">
@ -99,7 +99,7 @@
</trans-unit>
<trans-unit id="fsiConsoleProblem">
<source>A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools-&gt;Options-&gt;F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'.</source>
<target state="translated">啟動 F# Interactive 處理序時發生問題。這可能是因為背景處理序主控台對於支援某些 Windows 系統上具備 Unicode 支援功能之應用程式的已知問題所造成。請嘗試選取 [工具]5D; -&gt; [選項]5D; -&gt; [F# Interactive for Visual Studio]5D;，然後輸入 '--fsi-server-no-unicode'。</target>
<target state="translated">啟動 F# 互動處理序時發生問題。這可能是因為背景處理序主控台對於支援某些 Windows 系統上具備 Unicode 支援功能之應用程式的已知問題所造成。請嘗試選取 [工具] -&gt; [選項] -&gt; [F# Interactive for Visual Studio]，然後輸入 '--fsi-server-no-unicode'。</target>
<note />
</trans-unit>
<trans-unit id="fsiInvalidAssembly">
@ -139,7 +139,7 @@
</trans-unit>
<trans-unit id="fsiIntroTextHeader1directives">
<source> F# Interactive directives:</source>
<target state="translated"> F# Interactive 指示詞:</target>
<target state="translated">F# 互動指示詞:</target>
<note />
</trans-unit>
<trans-unit id="fsiIntroTextHashrInfo">
@ -174,7 +174,7 @@
</trans-unit>
<trans-unit id="fsiIntroTextHeader2commandLine">
<source> F# Interactive command line options:</source>
<target state="translated"> F# Interactive 命令列選項:</target>
<target state="translated">F# 互動命令列選項:</target>
<note />
</trans-unit>
<trans-unit id="fsiIntroTextHeader3">
@ -214,7 +214,7 @@
</trans-unit>
<trans-unit id="fsiDidAHashrWithLockWarning">
<source>--&gt; Referenced '{0}' (file may be locked by F# Interactive process)</source>
<target state="translated">--&gt; 參考的 '{0}' (檔案可能已被 F# Interactive 處理序鎖定)</target>
<target state="translated">--&gt; 參考的 '{0}' (檔案可能已被 F# 互動處理序鎖定)</target>
<note />
</trans-unit>
<trans-unit id="fsiDidAHashrWithStaleWarning">
@ -264,7 +264,7 @@
</trans-unit>
<trans-unit id="shadowCopyReferences">
<source>Prevents references from being locked by the F# Interactive process</source>
<target state="translated">避免參考遭 F# 互動式處理序封鎖</target>
<target state="translated">避免參考遭 F# 互動處理序封鎖</target>
<note />
</trans-unit>
</body>

29
src/fsharp/infos.fs
Просмотреть файл

@ -835,7 +835,15 @@ type ILMethInfo =
member x.IsDllImport (g: TcGlobals) =
match g.attrib_DllImportAttribute with
| None -> false
| Some (AttribInfo(tref, _)) ->x.RawMetadata.CustomAttrs |> TryDecodeILAttribute g tref |> Option.isSome
| Some attr ->
x.RawMetadata.CustomAttrs
|> TryFindILAttribute attr
/// Indicates if the method is marked with the [<IsReadOnly>] attribute. This is done by looking at the IL custom attributes on
/// the method.
member x.IsReadOnly (g: TcGlobals) =
x.RawMetadata.CustomAttrs
|> TryFindILAttribute g.attrib_IsReadOnlyAttribute
/// Get the (zero or one) 'self'/'this'/'object' arguments associated with an IL method.
/// An instance extension method returns one object argument.
@ -1238,6 +1246,25 @@ type MethInfo =
member x.IsStruct =
isStructTy x.TcGlobals x.ApparentEnclosingType
/// Indicates if this method is read-only; usually by the [<IsReadOnly>] attribute.
/// Must be an instance method.
/// Receiver must be a struct type.
member x.IsReadOnly =
// Perf Review: Is there a way we can cache this result?
x.IsInstance &&
x.IsStruct &&
match x with
| ILMeth (g, ilMethInfo, _) -> ilMethInfo.IsReadOnly g
| FSMeth _ -> false // F# defined methods not supported yet. Must be a language feature.
| _ -> false
/// Indicates if this method is an extension member that is read-only.
/// An extension member is considered read-only if the first argument is a read-only byref (inref) type.
member x.IsReadOnlyExtensionMember (amap: Import.ImportMap, m) =
x.IsExtensionMember &&
x.TryObjArgByrefType(amap, m, x.FormalMethodInst)
|> Option.exists (isInByrefTy amap.g)
/// Build IL method infos.
static member CreateILMeth (amap: Import.ImportMap, m, ty: TType, md: ILMethodDef) =
let tinfo = ILTypeInfo.FromType amap.g ty

17
src/fsharp/lex.fsl
Просмотреть файл

@ -23,6 +23,7 @@ open FSharp.Compiler
open FSharp.Compiler.Range
open FSharp.Compiler.Ast
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Parser
open FSharp.Compiler.Lexhelp
open FSharp.Compiler.Lib
@ -83,11 +84,7 @@ let parseInt32 (s:string) =
let mutable p = 0
let sign = getSign32 s &p l
let specifier = get0OXB s &p l
#if FX_RESHAPED_GLOBALIZATION
match CultureInfo.InvariantCulture.TextInfo.ToLower(specifier) with
#else
match Char.ToLower(specifier,CultureInfo.InvariantCulture) with
#endif
| 'x' -> sign * (int32 (Convert.ToUInt32(UInt64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture))))
| 'b' -> sign * (int32 (Convert.ToUInt32(parseBinaryUInt64 (s.Substring(p)))))
| 'o' -> sign * (int32 (Convert.ToUInt32(parseOctalUInt64 (s.Substring(p)))))
@ -144,19 +141,17 @@ let tryAppendXmlDoc (buff:option<System.Text.StringBuilder>) (s:string) =
let shouldStartLine args lexbuf (m:range) err tok =
if (m.StartColumn <> 0) then fail args lexbuf err tok
else tok
let shouldStartFile args lexbuf (m:range) err tok =
if (m.StartColumn <> 0 || m.StartLine <> 1) then fail args lexbuf err tok
else tok
let evalIfDefExpression startPos args (lookup:string->bool) (lexed:string) =
let lexbuf = LexBuffer<char>.FromChars (lexed.ToCharArray ())
let evalIfDefExpression startPos isFeatureSupported args (lookup:string->bool) (lexed:string) =
let lexbuf = LexBuffer<char>.FromChars (isFeatureSupported, lexed.ToCharArray ())
lexbuf.StartPos <- startPos
lexbuf.EndPos <- startPos
let tokenStream = FSharp.Compiler.PPLexer.tokenstream args
let expr = FSharp.Compiler.PPParser.start tokenStream lexbuf
LexerIfdefEval lookup expr
}
@ -614,7 +609,7 @@ rule token args skip = parse
{ let m = lexbuf.LexemeRange
let lookup id = List.contains id args.defines
let lexed = lexeme lexbuf
let isTrue = evalIfDefExpression lexbuf.StartPos args lookup lexed
let isTrue = evalIfDefExpression lexbuf.StartPos lexbuf.SupportsFeature args lookup lexed
args.ifdefStack := (IfDefIf,m) :: !(args.ifdefStack)
// Get the token; make sure it starts at zero position & return

2
src/fsharp/lib.fs
Просмотреть файл

@ -513,9 +513,7 @@ module UnmanagedProcessExecutionOptions =
extern UInt32 private GetLastError()
// Translation of C# from http://swikb/v1/DisplayOnlineDoc.aspx?entryID=826 and copy in bug://5018
#if !FX_NO_SECURITY_PERMISSIONS
[<System.Security.Permissions.SecurityPermission(System.Security.Permissions.SecurityAction.Assert, UnmanagedCode = true)>]
#endif
let EnableHeapTerminationOnCorruption() =
if (System.Environment.OSVersion.Version.Major >= 6 && // If OS is Vista or higher
System.Environment.Version.Major < 3) then // and CLR not 3.0 or higher

29
src/fsharp/pars.fsy
Просмотреть файл

@ -18,6 +18,7 @@ open FSharp.Compiler.Ast
open FSharp.Compiler.Lib
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
#if DEBUG
let debugPrint(s) =
@ -129,9 +130,11 @@ let mkDefnBindings (mWhole,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs,_bindi
let attrDecls = if not (isNil freeAttrs) then [ SynModuleDecl.Attributes (freeAttrs,attrsm) ] else []
attrDecls @ letDecls
let idOfPat m p =
match p with
| SynPat.Named (SynPat.Wild _,id,false,_,_) -> id
let idOfPat (parseState:IParseState) m p =
match p with
| SynPat.Wild r when parseState.LexBuffer.SupportsFeature LanguageFeature.WildCardInForLoop ->
mkSynId r "_"
| SynPat.Named (SynPat.Wild _,id,false,_,_) -> id
| SynPat.LongIdent(LongIdentWithDots([id],_),_,None, SynConstructorArgs.Pats [], None,_) -> id
| _ -> raiseParseErrorAt m (FSComp.SR.parsIntegerForLoopRequiresSimpleIdentifier())
@ -1913,8 +1916,12 @@ opt_typ:
| /* EMPTY */ { None }
| COLON typ { Some $2 }
atomicPatternLongIdent:
| UNDERSCORE DOT pathOp {
if not (parseState.LexBuffer.SupportsFeature LanguageFeature.SingleUnderscorePattern) then
raiseParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnexpectedSymbolDot())
let (LongIdentWithDots(lid,dotms)) = $3 in (None,LongIdentWithDots(ident("_",rhs parseState 1)::lid, rhs parseState 2::dotms))
}
| GLOBAL DOT pathOp { let (LongIdentWithDots(lid,dotms)) = $3 in (None,LongIdentWithDots(ident(MangledGlobalName,rhs parseState 1) :: lid, rhs parseState 2 :: dotms)) }
| pathOp { (None,$1) }
| access pathOp { (Some($1), $2) }
@ -2106,7 +2113,7 @@ inlineAssemblyTyconRepr:
| HASH stringOrKeywordString HASH
{ libraryOnlyError (lhs parseState)
let lhsm = lhs parseState
SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (ParseAssemblyCodeType $2 (rhs parseState 2),lhsm) }
SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (internalParseAssemblyCodeType $2 parseState.LexBuffer.SupportsFeature (rhs parseState 2),lhsm) }
classOrInterfaceOrStruct:
| CLASS { TyconClass }
@ -4002,7 +4009,7 @@ forLoopBinder:
forLoopRange:
| parenPattern EQUALS declExpr forLoopDirection declExpr
{ idOfPat (rhs parseState 1) $1,$3,$4,$5 }
{ idOfPat parseState (rhs parseState 1) $1,$3,$4,$5 }
| parenPattern EQUALS rangeSequenceExpr
{ raiseParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnexpectedSymbolEqualsInsteadOfIn()) }
@ -4015,11 +4022,11 @@ inlineAssemblyExpr:
| HASH stringOrKeywordString opt_inlineAssemblyTypeArg opt_curriedArgExprs opt_inlineAssemblyReturnTypes HASH
{ libraryOnlyWarning (lhs parseState)
let s,sm = $2,rhs parseState 2
(fun m -> SynExpr.LibraryOnlyILAssembly (ParseAssemblyCodeInstructions s sm,$3,List.rev $4,$5,m)) }
opt_curriedArgExprs:
| opt_curriedArgExprs argExpr %prec expr_args
{ $2 :: $1 }
(fun m -> SynExpr.LibraryOnlyILAssembly (internalParseAssemblyCodeInstructions s parseState.LexBuffer.SupportsFeature sm, $3, List.rev $4, $5, m)) }
opt_curriedArgExprs:
| opt_curriedArgExprs argExpr %prec expr_args
{ $2 :: $1 }
|
{ [] }

25
src/fsharp/service/FSharpCheckerResults.fs
Просмотреть файл

@ -21,6 +21,7 @@ open FSharp.Compiler.Ast
open FSharp.Compiler.CompileOps
open FSharp.Compiler.CompileOptions
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Lib
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.Parser
@ -849,7 +850,12 @@ type internal TypeCheckInfo
| Some(CompletionContext.OpenDeclaration) ->
GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck, false, getAllSymbols)
|> Option.map (fun (items, denv, m) ->
items |> List.filter (fun x -> match x.Item with Item.ModuleOrNamespaces _ -> true | _ -> false), denv, m)
items
|> List.filter (fun x ->
match x.Item with
| Item.ModuleOrNamespaces _ -> true
| Item.Types (_, tcrefs) when tcrefs |> List.exists (fun ty -> isAppTy g ty && isStaticClass g (tcrefOfAppTy g ty)) -> true
| _ -> false), denv, m)
// Completion at '(x: ...)"
| Some (CompletionContext.PatternType) ->
@ -1276,9 +1282,8 @@ type internal TypeCheckInfo
valRefEq g g.reraise_vref vref ||
valRefEq g g.typeof_vref vref ||
valRefEq g g.typedefof_vref vref ||
valRefEq g g.sizeof_vref vref
// TODO uncomment this after `nameof` operator is implemented
// || valRefEq g g.nameof_vref vref
valRefEq g g.sizeof_vref vref ||
valRefEq g g.nameof_vref vref
then Some()
else None
@ -1525,8 +1530,12 @@ module internal ParseAndCheckFile =
let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf)
tokenizer.Lexer
let createLexbuf sourceText =
UnicodeLexing.SourceTextAsLexbuf(sourceText)
// Public callers are unable to answer LanguageVersion feature support questions.
// External Tools including the VS IDE will enable the default LanguageVersion
let isFeatureSupported (_featureId:LanguageFeature) = true
let createLexbuf sourceText isFeatureSupported =
UnicodeLexing.SourceTextAsLexbuf(isFeatureSupported, sourceText)
let matchBraces(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) =
let delayedLogger = CapturingErrorLogger("matchBraces")
@ -1541,7 +1550,7 @@ module internal ParseAndCheckFile =
use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse
let matchingBraces = new ResizeArray<_>()
Lexhelp.usingLexbufForParsing(createLexbuf sourceText, fileName) (fun lexbuf ->
Lexhelp.usingLexbufForParsing(createLexbuf sourceText isFeatureSupported, fileName) (fun lexbuf ->
let errHandler = ErrorHandler(false, fileName, options.ErrorSeverityOptions, sourceText, suggestNamesForErrors)
let lexfun = createLexerFunction fileName options lexbuf errHandler
let parenTokensBalance t1 t2 =
@ -1577,7 +1586,7 @@ module internal ParseAndCheckFile =
use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse
let parseResult =
Lexhelp.usingLexbufForParsing(createLexbuf sourceText, fileName) (fun lexbuf ->
Lexhelp.usingLexbufForParsing(createLexbuf sourceText isFeatureSupported, fileName) (fun lexbuf ->
let lexfun = createLexerFunction fileName options lexbuf errHandler
let isLastCompiland =
fileName.Equals(options.LastFileName, StringComparison.CurrentCultureIgnoreCase) ||

13
src/fsharp/service/IncrementalBuild.fs
Просмотреть файл

@ -1052,7 +1052,7 @@ type TypeCheckAccumulator =
/// Global service state
type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*TargetFrameworkDirectories*)string list* (*fsharpBinaries*)string
type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*TargetFrameworkDirectories*)string list * (*fsharpBinaries*)string * (*langVersion*)decimal
/// Represents a cache of 'framework' references that can be shared betweeen multiple incremental builds
type FrameworkImportsCache(keepStrongly) =
@ -1083,12 +1083,13 @@ type FrameworkImportsCache(keepStrongly) =
// The data elements in this key are very important. There should be nothing else in the TcConfig that logically affects
// the import of a set of framework DLLs into F# CCUs. That is, the F# CCUs that result from a set of DLLs (including
// FSharp.Core.dll and mscorlib.dll) must be logically invariant of all the other compiler configuration parameters.
let key = (frameworkDLLsKey,
tcConfig.primaryAssembly.Name,
tcConfig.GetTargetFrameworkDirectories(),
tcConfig.fsharpBinariesDir)
let key = (frameworkDLLsKey,
tcConfig.primaryAssembly.Name,
tcConfig.GetTargetFrameworkDirectories(),
tcConfig.fsharpBinariesDir,
tcConfig.langVersion.SpecifiedVerson)
match frameworkTcImportsCache.TryGet (ctok, key) with
match frameworkTcImportsCache.TryGet (ctok, key) with
| Some res -> return res
| None ->
let tcConfigP = TcConfigProvider.Constant tcConfig

4
src/fsharp/service/Reactor.fs
Просмотреть файл

@ -64,11 +64,7 @@ type Reactor() =
Trace.TraceInformation("Reactor: {0:n3} pausing {1} milliseconds", DateTime.Now.TimeOfDay.TotalSeconds, pauseBeforeBackgroundWork)
pauseBeforeBackgroundWork
return! inbox.TryReceive(timeout) }
#if FX_RESHAPED_GLOBALIZATION
CultureInfo.CurrentUICulture <- culture
#else
Thread.CurrentThread.CurrentUICulture <- culture
#endif
match msg with
| Some (SetBackgroundOp bgOpOpt) ->
//Trace.TraceInformation("Reactor: --> set background op, remaining {0}", inbox.CurrentQueueLength)

11
src/fsharp/service/ServiceLexing.fs
Просмотреть файл

@ -15,6 +15,7 @@ open FSharp.Compiler.Parser
open FSharp.Compiler.Range
open FSharp.Compiler.Ast
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Lexhelp
open FSharp.Compiler.Lib
open Internal.Utilities
@ -767,18 +768,22 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf,
[<Sealed>]
type FSharpSourceTokenizer(defineConstants: string list, filename: string option) =
// Public callers are unable to answer LanguageVersion feature support questions.
// External Tools including the VS IDE will enable the default LanguageVersion
let isFeatureSupported (_featureId:LanguageFeature) = true
let lexResourceManager = new Lexhelp.LexResourceManager()
let lexArgsLightOn = mkLexargs(filename, defineConstants, LightSyntaxStatus(true, false), lexResourceManager, ref [], DiscardErrorsLogger, PathMap.empty)
let lexArgsLightOff = mkLexargs(filename, defineConstants, LightSyntaxStatus(false, false), lexResourceManager, ref [], DiscardErrorsLogger, PathMap.empty)
member this.CreateLineTokenizer(lineText: string) =
let lexbuf = UnicodeLexing.StringAsLexbuf lineText
let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, lineText)
FSharpLineTokenizer(lexbuf, Some lineText.Length, filename, lexArgsLightOn, lexArgsLightOff)
member this.CreateBufferTokenizer bufferFiller =
let lexbuf = UnicodeLexing.FunctionAsLexbuf bufferFiller
let lexbuf = UnicodeLexing.FunctionAsLexbuf(isFeatureSupported, bufferFiller)
FSharpLineTokenizer(lexbuf, None, filename, lexArgsLightOn, lexArgsLightOff)
module Keywords =

1
src/fsharp/service/ServiceParseTreeWalk.fs
Просмотреть файл

@ -412,6 +412,7 @@ module public AstTraversal =
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
| SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
| SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSeq, synExpr, synExpr2, _, _range)
| SynExpr.Sequential (_sequencePointInfoForSeq, _, synExpr, synExpr2, _range) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]

Некоторые файлы не были показаны из-за слишком большого количества измененных файлов Показать больше