From c445c578d234a52190bcca06ac59a9c288799d6f Mon Sep 17 00:00:00 2001 From: "Kevin Ransom (msft)" Date: Mon, 15 Nov 2021 17:17:19 -0800 Subject: [PATCH 01/26] Fix issues with package management subdirectories (#12381) --- .../FSharp.DependencyManager.fs | 45 +++++++++++-------- 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs index e63da04ccb5..dc3e8781910 100644 --- a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs +++ b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs @@ -176,31 +176,40 @@ type FSharpDependencyManager (outputDirectory:string option) = let key = "nuget" let name = "MsBuild Nuget DependencyManager" - let workingDirectory = - let path = Path.Combine(Path.GetTempPath(), key, Process.GetCurrentProcess().Id.ToString() + "--"+ Guid.NewGuid().ToString()) - match outputDirectory with - | None -> path - | Some v -> Path.Combine(path, v) let generatedScripts = ConcurrentDictionary() + let workingDirectory = + // Calculate the working directory for dependency management + // if a path wasn't supplied to the dependency manager then use the temporary directory as the root + // if a path was supplied if it was rooted then use the rooted path as the root + // if the path wasn't supplied or not rooted use the temp directory as the root. + let directory = + let path = Path.Combine(Process.GetCurrentProcess().Id.ToString() + "--"+ Guid.NewGuid().ToString()) + match outputDirectory with + | None -> Path.Combine(Path.GetTempPath(), path) + | Some v -> + if Path.IsPathRooted(v) then Path.Combine(v, path) + else Path.Combine(Path.GetTempPath(), path) + + lazy + try + if not (Directory.Exists(directory)) then + Directory.CreateDirectory(directory) |> ignore + directory + with | _ -> directory + let deleteScripts () = try -#if !Debug - if Directory.Exists(workingDirectory) then - Directory.Delete(workingDirectory, true) +#if !DEBUG + if workingDirectory.IsValueCreated then + if Directory.Exists(workingDirectory.Value) then + Directory.Delete(workingDirectory.Value, true) #else () #endif with | _ -> () - let deleteAtExit = - try - if not (Directory.Exists(workingDirectory)) then - Directory.CreateDirectory(workingDirectory) |> ignore - true - with | _ -> false - let emitFile filename (body:string) = try // Create a file to write to @@ -226,7 +235,7 @@ type FSharpDependencyManager (outputDirectory:string option) = let packageReferenceText = String.Join(Environment.NewLine, packageReferenceLines) - let projectPath = Path.Combine(workingDirectory, "Project.fsproj") + let projectPath = Path.Combine(workingDirectory.Value, "Project.fsproj") let generateAndBuildProjectArtifacts = let writeFile path body = @@ -249,7 +258,7 @@ type FSharpDependencyManager (outputDirectory:string option) = generateAndBuildProjectArtifacts - do if deleteAtExit then AppDomain.CurrentDomain.ProcessExit |> Event.add(fun _ -> deleteScripts () ) + do AppDomain.CurrentDomain.ProcessExit |> Event.add(fun _ -> deleteScripts () ) member _.Name = name @@ -268,7 +277,7 @@ type FSharpDependencyManager (outputDirectory:string option) = | _ -> "#r @\"" let generateAndBuildProjectArtifacts = - let configIncludes = generateSourcesFromNugetConfigs scriptDirectory workingDirectory timeout + let configIncludes = generateSourcesFromNugetConfigs scriptDirectory workingDirectory.Value timeout let directiveLines = Seq.append packageManagerTextLines configIncludes let resolutionResult = prepareDependencyResolutionFiles (scriptExt, directiveLines, targetFrameworkMoniker, runtimeIdentifier, timeout) match resolutionResult.resolutionsFile with From db2c9da8d1e76d11217d6da53a64253fd0df0246 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 16 Nov 2021 11:56:36 +0000 Subject: [PATCH 02/26] split large methods sensibly (#12397) --- src/fsharp/CheckExpressions.fs | 1094 +++++++++++++++-------------- src/fsharp/PostInferenceChecks.fs | 317 +++++---- 2 files changed, 749 insertions(+), 662 deletions(-) diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 638bb52d35a..3bf0cb89921 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -8085,592 +8085,634 @@ and TcLongIdentThen cenv (overallTy: OverallTy) env tpenv (LongIdentWithDots(lon //------------------------------------------------------------------------- // Typecheck "item+projections" //------------------------------------------------------------------------- *) + // mItem is the textual range covered by the long identifiers that make up the item and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mItem, rest, afterResolution) delayed = - let g = cenv.g let delayed = delayRest rest mItem delayed - let ad = env.eAccessRights match item with // x where x is a union case or active pattern result tag. | Item.UnionCase _ | Item.ExnCase _ | Item.ActivePatternResult _ as item -> - // ucaseAppTy is the type of the union constructor applied to its (optional) argument - let ucaseAppTy = NewInferenceType () - let mkConstrApp, argTys, argNames = - match item with - | Item.ActivePatternResult(apinfo, _apOverallTy, n, _) -> - let aparity = apinfo.Names.Length - match aparity with - | 0 | 1 -> - let mkConstrApp _mArgs = function [arg] -> arg | _ -> error(InternalError("ApplyUnionCaseOrExn", mItem)) - mkConstrApp, [ucaseAppTy], [ for s, m in apinfo.ActiveTagsWithRanges -> mkSynId m s ] - | _ -> - let ucref = mkChoiceCaseRef g mItem aparity n - let _, _, tinst, _ = FreshenTyconRef2 mItem ucref.TyconRef - let ucinfo = UnionCaseInfo (tinst, ucref) - ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy (Item.UnionCase(ucinfo, false)) - | _ -> - ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy item - let numArgTys = List.length argTys - - // Subsumption at data constructions if argument type is nominal prior to equations for any arguments or return types - let flexes = argTys |> List.map (isTyparTy g >> not) - - let (|FittedArgs|_|) arg = - match arg with - | SynExprParen(SynExpr.Tuple (false, args, _, _), _, _, _) - | SynExpr.Tuple (false, args, _, _) when numArgTys > 1 -> Some args - | SynExprParen(arg, _, _, _) - | arg when numArgTys = 1 -> Some [arg] - | _ -> None + TcUnionCaseOrExnCaseOrActivePatternResultItemThen cenv overallTy env item tpenv mItem delayed - match delayed with - // This is where the constructor is applied to an argument - | DelayedApp (atomicFlag, _, _, (FittedArgs args as origArg), mExprAndArg) :: otherDelayed -> - // assert the overall result type if possible - if isNil otherDelayed then - UnifyOverallType cenv env mExprAndArg overallTy ucaseAppTy - - let numArgs = List.length args - UnionCaseOrExnCheck env numArgTys numArgs mExprAndArg - - // if we manage to get here - number of formal arguments = number of actual arguments - // apply named parameters - let args = - // GetMethodArgs checks that no named parameters are located before positional - let unnamedArgs, namedCallerArgs = GetMethodArgs origArg - match namedCallerArgs with - | [] -> - args - | _ -> - let fittedArgs = Array.zeroCreate numArgTys + | Item.Types(nm, ty :: _) -> + TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed - // first: put all positional arguments - let mutable currentIndex = 0 - for arg in unnamedArgs do - fittedArgs.[currentIndex] <- arg - currentIndex <- currentIndex + 1 + | Item.MethodGroup (methodName, minfos, _) -> + TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution delayed - let SEEN_NAMED_ARGUMENT = -1 + | Item.CtorGroup(nm, minfos) -> + TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed - // dealing with named arguments is a bit tricky since prior to these changes we have an ambiguous situation: - // regular notation for named parameters Some(Value = 5) can mean either 1) create option with value - result of equality operation or 2) create option using named arg syntax. - // so far we've used 1) so we cannot immediately switch to 2) since it will be a definite breaking change. + | Item.FakeInterfaceCtor _ -> + error(Error(FSComp.SR.tcInvalidUseOfInterfaceType(), mItem)) - for _, id, arg in namedCallerArgs do - match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with - | Some i -> - if isNull(box fittedArgs.[i]) then - fittedArgs.[i] <- arg - let argItem = - match item with - | Item.UnionCase (uci, _) -> Item.UnionCaseField (uci, i) - | Item.ExnCase tref -> Item.RecdField (RecdFieldInfo ([], RecdFieldRef (tref, id.idText))) - | _ -> failwithf "Expecting union case or exception item, got: %O" item - CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, argItem, emptyTyparInst, ItemOccurence.Use, ad) - else error(Error(FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce(id.idText), id.idRange)) - currentIndex <- SEEN_NAMED_ARGUMENT - | None -> - // ambiguity may appear only when if argument is boolean\generic. - // if - // - we didn't find argument with specified name AND - // - we have not seen any named arguments so far AND - // - type of current argument is bool\generic - // then we'll favor old behavior and treat current argument as positional. - let isSpecialCaseForBackwardCompatibility = - (currentIndex <> SEEN_NAMED_ARGUMENT) && - (currentIndex < numArgTys) && - match stripTyEqns g argTys.[currentIndex] with - | TType_app(tcref, _) -> tyconRefEq g g.bool_tcr tcref || tyconRefEq g g.system_Bool_tcref tcref - | TType_var _ -> true - | _ -> false - - if isSpecialCaseForBackwardCompatibility then - assert (isNull(box fittedArgs.[currentIndex])) - fittedArgs.[currentIndex] <- List.item currentIndex args // grab original argument, not item from the list of named parameters - currentIndex <- currentIndex + 1 - else - match item with - | Item.UnionCase(uci, _) -> - error(Error(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(uci.DisplayName, id.idText), id.idRange)) - | Item.ExnCase tcref -> - error(Error(FSComp.SR.tcExceptionConstructorDoesNotHaveFieldWithGivenName(tcref.DisplayName, id.idText), id.idRange)) - | Item.ActivePatternResult _ -> - error(Error(FSComp.SR.tcActivePatternsDoNotHaveFields(), id.idRange)) - | _ -> - error(Error(FSComp.SR.tcConstructorDoesNotHaveFieldWithGivenName(id.idText), id.idRange)) - - assert (Seq.forall (box >> ((<>) null) ) fittedArgs) - List.ofArray fittedArgs - - let args', tpenv = TcExprsWithFlexes cenv env mExprAndArg tpenv flexes argTys args - PropagateThenTcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv (mkConstrApp mExprAndArg args')) ucaseAppTy atomicFlag otherDelayed - - | DelayedTypeApp (_x, mTypeArgs, _mExprAndTypeArgs) :: _delayed' -> - error(Error(FSComp.SR.tcUnexpectedTypeArguments(), mTypeArgs)) - | _ -> - // Work out how many syntactic arguments we really expect. Also return a function that builds the overall - // expression, but don't apply this function until after we've checked that the number of arguments is OK - // (or else we would be building an invalid expression) + | Item.ImplicitOp(id, sln) -> + TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed - // Unit-taking active pattern result can be applied to no args - let numArgs, mkExpr = - // This is where the constructor is an active pattern result applied to no argument - // Unit-taking active pattern result can be applied to no args - if (numArgTys = 1 && match item with Item.ActivePatternResult _ -> true | _ -> false) then - UnifyTypes cenv env mItem (List.head argTys) g.unit_ty - 1, (fun () -> mkConstrApp mItem [mkUnit g mItem]) - - // This is where the constructor expects no arguments and is applied to no argument - elif numArgTys = 0 then - 0, (fun () -> mkConstrApp mItem []) - else - // This is where the constructor expects arguments but is not applied to arguments, hence build a lambda - numArgTys, - (fun () -> - let vs, args = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip - let constrApp = mkConstrApp mItem args - let lam = mkMultiLambda mItem vs (constrApp, tyOfExpr g constrApp) - lam) - UnionCaseOrExnCheck env numArgTys numArgs mItem - let expr = mkExpr() - let exprTy = tyOfExpr g expr - PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) exprTy ExprAtomicFlag.Atomic delayed + | Item.DelegateCtor ty -> + TcDelegateCtorItemThen cenv overallTy env ty tinstEnclosing tpenv mItem delayed - | Item.Types(nm, ty :: _) -> + | Item.Value vref -> + TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed - match delayed with - | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: DelayedDotLookup (longId, mLongId) :: otherDelayed -> - // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs - // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args - // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs - - // Report information about the whole expression including type arguments to VS - let item = Item.Types(nm, [ty]) - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed - let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true - TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) otherDelayed - - | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: _delayed' -> - // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs - let item = Item.Types(nm, [ty]) - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - - // Same error as in the following case - error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) + | Item.Property (nm, pinfos) -> + TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution delayed + | Item.ILField finfo -> + TcILFieldItemThen cenv overallTy env finfo tpenv mItem delayed + + | Item.RecdField rfinfo -> + TcRecdFieldItemThen cenv overallTy env rfinfo tpenv mItem delayed + + | Item.Event einfo -> + TcEventItemThen cenv overallTy env tpenv mItem mItem None einfo delayed + + | Item.CustomOperation (nm, usageTextOpt, _) -> + // 'delayed' is about to be dropped on the floor, first do rudimentary checking to get name resolutions in its body + RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects_Delayed cenv env tpenv delayed + match usageTextOpt() with + | None -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly nm, mItem)) + | Some usageText -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly2(nm, usageText), mItem)) + + | _ -> error(Error(FSComp.SR.tcLookupMayNotBeUsedHere(), mItem)) + +/// Type check the application of a union case. Also used to cover constructions of F# exception values, and +/// applications of active pattern result labels. +// +// NOTE: the code for this is all a bit convoluted and should really be simplified/regularized. +and TcUnionCaseOrExnCaseOrActivePatternResultItemThen cenv overallTy env item tpenv mItem delayed = + let g = cenv.g + let ad = env.eAccessRights + // ucaseAppTy is the type of the union constructor applied to its (optional) argument + let ucaseAppTy = NewInferenceType () + let mkConstrApp, argTys, argNames = + match item with + | Item.ActivePatternResult(apinfo, _apOverallTy, n, _) -> + let aparity = apinfo.Names.Length + match aparity with + | 0 | 1 -> + let mkConstrApp _mArgs = function [arg] -> arg | _ -> error(InternalError("ApplyUnionCaseOrExn", mItem)) + mkConstrApp, [ucaseAppTy], [ for s, m in apinfo.ActiveTagsWithRanges -> mkSynId m s ] + | _ -> + let ucref = mkChoiceCaseRef g mItem aparity n + let _, _, tinst, _ = FreshenTyconRef2 mItem ucref.TyconRef + let ucinfo = UnionCaseInfo (tinst, ucref) + ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy (Item.UnionCase(ucinfo, false)) | _ -> - // In this case the type is not generic, and indeed we should never have returned Item.Types. - // That's because ResolveTypeNamesToCtors should have been set at the original - // call to ResolveLongIdentAsExprAndComputeRange - error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) + ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy item + let numArgTys = List.length argTys - | Item.MethodGroup (methodName, minfos, _) -> - // Static method calls Type.Foo(arg1, ..., argn) - let meths = List.map (fun minfo -> minfo, None) minfos - match delayed with - | DelayedApp (atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed + // Subsumption at data constructions if argument type is nominal prior to equations for any arguments or return types + let flexes = argTys |> List.map (isTyparTy g >> not) - | DelayedTypeApp(tys, mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> + let (|FittedArgs|_|) arg = + match arg with + | SynExprParen(SynExpr.Tuple (false, args, _, _), _, _, _) + | SynExpr.Tuple (false, args, _, _) when numArgTys > 1 -> Some args + | SynExprParen(arg, _, _, _) + | arg when numArgTys = 1 -> Some [arg] + | _ -> None -#if !NO_EXTENSIONTYPING - match TryTcMethodAppToStaticConstantArgs cenv env tpenv (minfos, Some (tys, mTypeArgs), mExprAndTypeArgs, mItem) with - | Some minfoAfterStaticArguments -> + match delayed with + // This is where the constructor is applied to an argument + | DelayedApp (atomicFlag, _, _, (FittedArgs args as origArg), mExprAndArg) :: otherDelayed -> + // assert the overall result type if possible + if isNil otherDelayed then + UnifyOverallType cenv env mExprAndArg overallTy ucaseAppTy + + let numArgs = List.length args + UnionCaseOrExnCheck env numArgTys numArgs mExprAndArg + + // if we manage to get here - number of formal arguments = number of actual arguments + // apply named parameters + let args = + // GetMethodArgs checks that no named parameters are located before positional + let unnamedArgs, namedCallerArgs = GetMethodArgs origArg + match namedCallerArgs with + | [] -> + args + | _ -> + let fittedArgs = Array.zeroCreate numArgTys - // Replace the resolution including the static parameters, plus the extra information about the original method info - let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos.[0]) - CallNameResolutionSinkReplacing cenv.tcSink (mItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) + // first: put all positional arguments + let mutable currentIndex = 0 + for arg in unnamedArgs do + fittedArgs.[currentIndex] <- arg + currentIndex <- currentIndex + 1 - match otherDelayed with - | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag otherDelayed - | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic otherDelayed + let SEEN_NAMED_ARGUMENT = -1 - | None -> -#endif + // dealing with named arguments is a bit tricky since prior to these changes we have an ambiguous situation: + // regular notation for named parameters Some(Value = 5) can mean either 1) create option with value - result of equality operation or 2) create option using named arg syntax. + // so far we've used 1) so we cannot immediately switch to 2) since it will be a definite breaking change. - let tyargs, tpenv = TcTypesOrMeasures None cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mTypeArgs + for _, id, arg in namedCallerArgs do + match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with + | Some i -> + if isNull(box fittedArgs.[i]) then + fittedArgs.[i] <- arg + let argItem = + match item with + | Item.UnionCase (uci, _) -> Item.UnionCaseField (uci, i) + | Item.ExnCase tref -> Item.RecdField (RecdFieldInfo ([], RecdFieldRef (tref, id.idText))) + | _ -> failwithf "Expecting union case or exception item, got: %O" item + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, argItem, emptyTyparInst, ItemOccurence.Use, ad) + else error(Error(FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce(id.idText), id.idRange)) + currentIndex <- SEEN_NAMED_ARGUMENT + | None -> + // ambiguity may appear only when if argument is boolean\generic. + // if + // - we didn't find argument with specified name AND + // - we have not seen any named arguments so far AND + // - type of current argument is bool\generic + // then we'll favor old behavior and treat current argument as positional. + let isSpecialCaseForBackwardCompatibility = + (currentIndex <> SEEN_NAMED_ARGUMENT) && + (currentIndex < numArgTys) && + match stripTyEqns g argTys.[currentIndex] with + | TType_app(tcref, _) -> tyconRefEq g g.bool_tcr tcref || tyconRefEq g g.system_Bool_tcref tcref + | TType_var _ -> true + | _ -> false + + if isSpecialCaseForBackwardCompatibility then + assert (isNull(box fittedArgs.[currentIndex])) + fittedArgs.[currentIndex] <- List.item currentIndex args // grab original argument, not item from the list of named parameters + currentIndex <- currentIndex + 1 + else + match item with + | Item.UnionCase(uci, _) -> + error(Error(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(uci.DisplayName, id.idText), id.idRange)) + | Item.ExnCase tcref -> + error(Error(FSComp.SR.tcExceptionConstructorDoesNotHaveFieldWithGivenName(tcref.DisplayName, id.idText), id.idRange)) + | Item.ActivePatternResult _ -> + error(Error(FSComp.SR.tcActivePatternsDoNotHaveFields(), id.idRange)) + | _ -> + error(Error(FSComp.SR.tcConstructorDoesNotHaveFieldWithGivenName(id.idText), id.idRange)) + + assert (Seq.forall (box >> ((<>) null) ) fittedArgs) + List.ofArray fittedArgs + + let args', tpenv = TcExprsWithFlexes cenv env mExprAndArg tpenv flexes argTys args + PropagateThenTcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv (mkConstrApp mExprAndArg args')) ucaseAppTy atomicFlag otherDelayed + + | DelayedTypeApp (_x, mTypeArgs, _mExprAndTypeArgs) :: _delayed' -> + error(Error(FSComp.SR.tcUnexpectedTypeArguments(), mTypeArgs)) + | _ -> + // Work out how many syntactic arguments we really expect. Also return a function that builds the overall + // expression, but don't apply this function until after we've checked that the number of arguments is OK + // (or else we would be building an invalid expression) + + // Unit-taking active pattern result can be applied to no args + let numArgs, mkExpr = + // This is where the constructor is an active pattern result applied to no argument + // Unit-taking active pattern result can be applied to no args + if (numArgTys = 1 && match item with Item.ActivePatternResult _ -> true | _ -> false) then + UnifyTypes cenv env mItem (List.head argTys) g.unit_ty + 1, (fun () -> mkConstrApp mItem [mkUnit g mItem]) + + // This is where the constructor expects no arguments and is applied to no argument + elif numArgTys = 0 then + 0, (fun () -> mkConstrApp mItem []) + else + // This is where the constructor expects arguments but is not applied to arguments, hence build a lambda + numArgTys, + (fun () -> + let vs, args = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip + let constrApp = mkConstrApp mItem args + let lam = mkMultiLambda mItem vs (constrApp, tyOfExpr g constrApp) + lam) + UnionCaseOrExnCheck env numArgTys numArgs mItem + let expr = mkExpr() + let exprTy = tyOfExpr g expr + PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) exprTy ExprAtomicFlag.Atomic delayed + +and TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed = + let g = cenv.g + let ad = env.eAccessRights + match delayed with + | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: DelayedDotLookup (longId, mLongId) :: otherDelayed -> + // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs + // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args + // and replace them by 'tyargs' + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs + + // Report information about the whole expression including type arguments to VS + let item = Item.Types(nm, [ty]) + CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed + let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true + TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) otherDelayed + + | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: _delayed' -> + // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs + let item = Item.Types(nm, [ty]) + CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + + // Same error as in the following case + error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) + + | _ -> + // In this case the type is not generic, and indeed we should never have returned Item.Types. + // That's because ResolveTypeNamesToCtors should have been set at the original + // call to ResolveLongIdentAsExprAndComputeRange + error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) + +and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution delayed = + let ad = env.eAccessRights + // Static method calls Type.Foo(arg1, ..., argn) + let meths = List.map (fun minfo -> minfo, None) minfos + match delayed with + | DelayedApp (atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed - // FUTURE: can we do better than emptyTyparInst here, in order to display instantiations - // of type variables in the quick info provided in the IDE? But note we haven't yet even checked if the - // number of type arguments is correct... - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + | DelayedTypeApp(tys, mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> + +#if !NO_EXTENSIONTYPING + match TryTcMethodAppToStaticConstantArgs cenv env tpenv (minfos, Some (tys, mTypeArgs), mExprAndTypeArgs, mItem) with + | Some minfoAfterStaticArguments -> + + // Replace the resolution including the static parameters, plus the extra information about the original method info + let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos.[0]) + CallNameResolutionSinkReplacing cenv.tcSink (mItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag otherDelayed | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic otherDelayed - | _ -> -#if !NO_EXTENSIONTYPING - if not minfos.IsEmpty && minfos.[0].ProvidedStaticParameterInfo.IsSome then - error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) + | None -> #endif - TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic delayed - | Item.CtorGroup(nm, minfos) -> - let objTy = - match minfos with - | minfo :: _ -> minfo.ApparentEnclosingType - | [] -> error(Error(FSComp.SR.tcTypeHasNoAccessibleConstructor(), mItem)) - match delayed with - | DelayedApp(_, _, _, arg, mExprAndArg) :: otherDelayed -> + let tyargs, tpenv = TcTypesOrMeasures None cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mTypeArgs - CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTy, env.eAccessRights) - TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [arg] mExprAndArg otherDelayed (Some afterResolution) + // FUTURE: can we do better than emptyTyparInst here, in order to display instantiations + // of type variables in the quick info provided in the IDE? But note we haven't yet even checked if the + // number of type arguments is correct... + CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: DelayedApp(_, _, _, arg, mExprAndArg) :: otherDelayed -> + match otherDelayed with + | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed + | _ -> + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic otherDelayed - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs - CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) - let itemAfterTyArgs, minfosAfterTyArgs = + | _ -> #if !NO_EXTENSIONTYPING - // If the type is provided and took static arguments then the constructor will have changed - // to a provided constructor on the statically instantiated type. Re-resolve that constructor. - match objTyAfterTyArgs with - | AppTy g (tcref, _) when tcref.Deref.IsProvided -> - let newItem = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mExprAndArg ad objTyAfterTyArgs) - match newItem with - | Item.CtorGroup(_, newMinfos) -> newItem, newMinfos - | _ -> item, minfos - | _ -> + if not minfos.IsEmpty && minfos.[0].ProvidedStaticParameterInfo.IsSome then + error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) #endif - item, minfos + TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic delayed - minfosAfterTyArgs |> List.iter (fun minfo -> UnifyTypes cenv env mExprAndTypeArgs minfo.ApparentEnclosingType objTyAfterTyArgs) - TcCtorCall true cenv env tpenv overallTy objTyAfterTyArgs (Some mExprAndTypeArgs) itemAfterTyArgs false [arg] mExprAndArg otherDelayed (Some afterResolution) - - | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> +and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed = + let g = cenv.g + let ad = env.eAccessRights + let objTy = + match minfos with + | minfo :: _ -> minfo.ApparentEnclosingType + | [] -> error(Error(FSComp.SR.tcTypeHasNoAccessibleConstructor(), mItem)) + match delayed with + | DelayedApp(_, _, _, arg, mExprAndArg) :: otherDelayed -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs + CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTy, env.eAccessRights) + TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [arg] mExprAndArg otherDelayed (Some afterResolution) - // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let resolvedItem = Item.Types(nm, [objTy]) - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, resolvedItem, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: DelayedApp(_, _, _, arg, mExprAndArg) :: otherDelayed -> - minfos |> List.iter (fun minfo -> UnifyTypes cenv env mExprAndTypeArgs minfo.ApparentEnclosingType objTy) - TcCtorCall true cenv env tpenv overallTy objTy (Some mExprAndTypeArgs) item false [] mExprAndTypeArgs otherDelayed (Some afterResolution) + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs + CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) + let itemAfterTyArgs, minfosAfterTyArgs = +#if !NO_EXTENSIONTYPING + // If the type is provided and took static arguments then the constructor will have changed + // to a provided constructor on the statically instantiated type. Re-resolve that constructor. + match objTyAfterTyArgs with + | AppTy g (tcref, _) when tcref.Deref.IsProvided -> + let newItem = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mExprAndArg ad objTyAfterTyArgs) + match newItem with + | Item.CtorGroup(_, newMinfos) -> newItem, newMinfos + | _ -> item, minfos + | _ -> +#endif + item, minfos - | _ -> + minfosAfterTyArgs |> List.iter (fun minfo -> UnifyTypes cenv env mExprAndTypeArgs minfo.ApparentEnclosingType objTyAfterTyArgs) + TcCtorCall true cenv env tpenv overallTy objTyAfterTyArgs (Some mExprAndTypeArgs) itemAfterTyArgs false [arg] mExprAndArg otherDelayed (Some afterResolution) - TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [] mItem delayed (Some afterResolution) + | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> - | Item.FakeInterfaceCtor _ -> - error(Error(FSComp.SR.tcInvalidUseOfInterfaceType(), mItem)) + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs - | Item.ImplicitOp(id, sln) -> + // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! + let resolvedItem = Item.Types(nm, [objTy]) + CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, resolvedItem, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - let isPrefix = IsPrefixOperator id.idText - let isTernary = IsTernaryOperator id.idText - - let argData = - if isPrefix then - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] - elif isTernary then - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] - else - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] - - let retTyData = SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - let argTypars = argData |> List.map (fun d -> Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, d, false, TyparDynamicReq.Yes, [], false, false)) - let retTypar = Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, retTyData, false, TyparDynamicReq.Yes, [], false, false) - let argTys = argTypars |> List.map mkTyparTy - let retTy = mkTyparTy retTypar - - let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip - - let memberFlags = StaticMemberFlags SynMemberKind.Member - let logicalCompiledName = ComputeLogicalName id memberFlags - let traitInfo = TTrait(argTys, logicalCompiledName, memberFlags, argTys, Some retTy, sln) - - let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) - let expr = mkLambdas mItem [] vs (expr, retTy) - - let rec isSimpleArgument e = - match e with - | SynExpr.New (_, _, synExpr, _) - | SynExpr.Paren (synExpr, _, _, _) - | SynExpr.Typed (synExpr, _, _) - | SynExpr.TypeApp (synExpr, _, _, _, _, _, _) - | SynExpr.TypeTest (synExpr, _, _) - | SynExpr.Upcast (synExpr, _, _) - | SynExpr.DotGet (synExpr, _, _, _) - | SynExpr.Downcast (synExpr, _, _) - | SynExpr.InferredUpcast (synExpr, _) - | SynExpr.InferredDowncast (synExpr, _) - | SynExpr.AddressOf (_, synExpr, _, _) - | SynExpr.Quote (_, _, synExpr, _, _) -> isSimpleArgument synExpr - - | SynExpr.InterpolatedString _ - | SynExpr.Null _ - | SynExpr.Ident _ - | SynExpr.Const _ - | SynExpr.LongIdent _ -> true - - | SynExpr.Tuple (_, synExprs, _, _) - | SynExpr.ArrayOrList (_, synExprs, _) -> synExprs |> List.forall isSimpleArgument - | SynExpr.Record (copyInfo=copyOpt; recordFields=fields) -> copyOpt |> Option.forall (fst >> isSimpleArgument) && fields |> List.forall ((fun (SynExprRecordField(expr=e)) -> e) >> Option.forall isSimpleArgument) - | SynExpr.App (_, _, synExpr, synExpr2, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 - | SynExpr.IfThenElse (_, _, synExpr, _, synExpr2, _, synExprOpt, _, _, _, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 && Option.forall isSimpleArgument synExprOpt - | SynExpr.DotIndexedGet (synExpr, _, _, _) -> isSimpleArgument synExpr - | SynExpr.ObjExpr _ - | SynExpr.AnonRecd _ - | SynExpr.While _ - | SynExpr.For _ - | SynExpr.ForEach _ - | SynExpr.ArrayOrListComputed _ - | SynExpr.ComputationExpr _ - | SynExpr.Lambda _ - | SynExpr.MatchLambda _ - | SynExpr.Match _ - | SynExpr.Do _ - | SynExpr.Assert _ - | SynExpr.Fixed _ - | SynExpr.TryWith _ - | SynExpr.TryFinally _ - | SynExpr.Lazy _ - | SynExpr.Sequential _ - | SynExpr.SequentialOrImplicitYield _ - | SynExpr.LetOrUse _ - | SynExpr.DotSet _ - | SynExpr.DotIndexedSet _ - | SynExpr.LongIdentSet _ - | SynExpr.Set _ - | SynExpr.JoinIn _ - | SynExpr.NamedIndexedPropertySet _ - | SynExpr.DotNamedIndexedPropertySet _ - | SynExpr.LibraryOnlyILAssembly _ - | SynExpr.LibraryOnlyStaticOptimization _ - | SynExpr.LibraryOnlyUnionCaseFieldGet _ - | SynExpr.LibraryOnlyUnionCaseFieldSet _ - | SynExpr.ArbitraryAfterError _ - | SynExpr.FromParseError _ - | SynExpr.DiscardAfterMissingQualificationAfterDot _ - | SynExpr.ImplicitZero _ - | SynExpr.YieldOrReturn _ - | SynExpr.YieldOrReturnFrom _ - | SynExpr.MatchBang _ - | SynExpr.LetOrUseBang _ - | SynExpr.DoBang _ - | SynExpr.TraitCall _ - | SynExpr.IndexFromEnd _ - | SynExpr.IndexRange _ - -> false - - // Propagate the known application structure into function types - Propagate cenv overallTy env tpenv (MakeApplicableExprNoFlex cenv expr) (tyOfExpr g expr) delayed - - // Take all simple arguments and process them before applying the constraint. - let delayed1, delayed2 = - let pred = (function DelayedApp (_, _, _, arg, _) -> isSimpleArgument arg | _ -> false) - List.takeWhile pred delayed, List.skipWhile pred delayed - - let intermediateTy = if isNil delayed2 then overallTy.Commit else NewInferenceType () - - let resultExpr, tpenv = TcDelayed cenv (MustEqual intermediateTy) env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr g expr) ExprAtomicFlag.NonAtomic delayed1 - - // Add the constraint after the application arguments have been checked to allow annotations to kick in on rigid type parameters - AddCxMethodConstraint env.DisplayEnv cenv.css mItem NoTrace traitInfo - - // Process all remaining arguments after the constraint is asserted - let resultExpr2, tpenv2 = TcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv resultExpr) intermediateTy ExprAtomicFlag.NonAtomic delayed2 - resultExpr2, tpenv2 + minfos |> List.iter (fun minfo -> UnifyTypes cenv env mExprAndTypeArgs minfo.ApparentEnclosingType objTy) + TcCtorCall true cenv env tpenv overallTy objTy (Some mExprAndTypeArgs) item false [] mExprAndTypeArgs otherDelayed (Some afterResolution) + | _ -> - | Item.DelegateCtor ty -> - match delayed with - | DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> - TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed - | DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs) :: DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty tinstEnclosing tyargs - - // Report information about the whole expression including type arguments to VS - let item = Item.DelegateCtor ty - CallNameResolutionSink cenv.tcSink (mItemAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed - | _ -> - error(Error(FSComp.SR.tcInvalidUseOfDelegate(), mItem)) + TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [] mItem delayed (Some afterResolution) - | Item.Value vref -> +and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = + let g = cenv.g + let isPrefix = IsPrefixOperator id.idText + let isTernary = IsTernaryOperator id.idText + + let argData = + if isPrefix then + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + elif isTernary then + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + else + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + + let retTyData = SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) + let argTypars = argData |> List.map (fun d -> Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, d, false, TyparDynamicReq.Yes, [], false, false)) + let retTypar = Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, retTyData, false, TyparDynamicReq.Yes, [], false, false) + let argTys = argTypars |> List.map mkTyparTy + let retTy = mkTyparTy retTypar + + let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip + + let memberFlags = StaticMemberFlags SynMemberKind.Member + let logicalCompiledName = ComputeLogicalName id memberFlags + let traitInfo = TTrait(argTys, logicalCompiledName, memberFlags, argTys, Some retTy, sln) + + let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) + let expr = mkLambdas mItem [] vs (expr, retTy) + + let rec isSimpleArgument e = + match e with + | SynExpr.New (_, _, synExpr, _) + | SynExpr.Paren (synExpr, _, _, _) + | SynExpr.Typed (synExpr, _, _) + | SynExpr.TypeApp (synExpr, _, _, _, _, _, _) + | SynExpr.TypeTest (synExpr, _, _) + | SynExpr.Upcast (synExpr, _, _) + | SynExpr.DotGet (synExpr, _, _, _) + | SynExpr.Downcast (synExpr, _, _) + | SynExpr.InferredUpcast (synExpr, _) + | SynExpr.InferredDowncast (synExpr, _) + | SynExpr.AddressOf (_, synExpr, _, _) + | SynExpr.Quote (_, _, synExpr, _, _) -> isSimpleArgument synExpr + + | SynExpr.InterpolatedString _ + | SynExpr.Null _ + | SynExpr.Ident _ + | SynExpr.Const _ + | SynExpr.LongIdent _ -> true + + | SynExpr.Tuple (_, synExprs, _, _) + | SynExpr.ArrayOrList (_, synExprs, _) -> synExprs |> List.forall isSimpleArgument + | SynExpr.Record (copyInfo=copyOpt; recordFields=fields) -> copyOpt |> Option.forall (fst >> isSimpleArgument) && fields |> List.forall ((fun (SynExprRecordField(expr=e)) -> e) >> Option.forall isSimpleArgument) + | SynExpr.App (_, _, synExpr, synExpr2, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 + | SynExpr.IfThenElse (_, _, synExpr, _, synExpr2, _, synExprOpt, _, _, _, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 && Option.forall isSimpleArgument synExprOpt + | SynExpr.DotIndexedGet (synExpr, _, _, _) -> isSimpleArgument synExpr + | SynExpr.ObjExpr _ + | SynExpr.AnonRecd _ + | SynExpr.While _ + | SynExpr.For _ + | SynExpr.ForEach _ + | SynExpr.ArrayOrListComputed _ + | SynExpr.ComputationExpr _ + | SynExpr.Lambda _ + | SynExpr.MatchLambda _ + | SynExpr.Match _ + | SynExpr.Do _ + | SynExpr.Assert _ + | SynExpr.Fixed _ + | SynExpr.TryWith _ + | SynExpr.TryFinally _ + | SynExpr.Lazy _ + | SynExpr.Sequential _ + | SynExpr.SequentialOrImplicitYield _ + | SynExpr.LetOrUse _ + | SynExpr.DotSet _ + | SynExpr.DotIndexedSet _ + | SynExpr.LongIdentSet _ + | SynExpr.Set _ + | SynExpr.JoinIn _ + | SynExpr.NamedIndexedPropertySet _ + | SynExpr.DotNamedIndexedPropertySet _ + | SynExpr.LibraryOnlyILAssembly _ + | SynExpr.LibraryOnlyStaticOptimization _ + | SynExpr.LibraryOnlyUnionCaseFieldGet _ + | SynExpr.LibraryOnlyUnionCaseFieldSet _ + | SynExpr.ArbitraryAfterError _ + | SynExpr.FromParseError _ + | SynExpr.DiscardAfterMissingQualificationAfterDot _ + | SynExpr.ImplicitZero _ + | SynExpr.YieldOrReturn _ + | SynExpr.YieldOrReturnFrom _ + | SynExpr.MatchBang _ + | SynExpr.LetOrUseBang _ + | SynExpr.DoBang _ + | SynExpr.TraitCall _ + | SynExpr.IndexFromEnd _ + | SynExpr.IndexRange _ + -> false + + // Propagate the known application structure into function types + Propagate cenv overallTy env tpenv (MakeApplicableExprNoFlex cenv expr) (tyOfExpr g expr) delayed + + // Take all simple arguments and process them before applying the constraint. + let delayed1, delayed2 = + let pred = (function DelayedApp (_, _, _, arg, _) -> isSimpleArgument arg | _ -> false) + List.takeWhile pred delayed, List.skipWhile pred delayed + + let intermediateTy = if isNil delayed2 then overallTy.Commit else NewInferenceType () + + let resultExpr, tpenv = TcDelayed cenv (MustEqual intermediateTy) env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr g expr) ExprAtomicFlag.NonAtomic delayed1 + + // Add the constraint after the application arguments have been checked to allow annotations to kick in on rigid type parameters + AddCxMethodConstraint env.DisplayEnv cenv.css mItem NoTrace traitInfo + + // Process all remaining arguments after the constraint is asserted + let resultExpr2, tpenv2 = TcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv resultExpr) intermediateTy ExprAtomicFlag.NonAtomic delayed2 + resultExpr2, tpenv2 + +and TcDelegateCtorItemThen cenv overallTy env ty tinstEnclosing tpenv mItem delayed = + match delayed with + | DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> + TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed + | DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs) :: DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty tinstEnclosing tyargs + + // Report information about the whole expression including type arguments to VS + let item = Item.DelegateCtor ty + CallNameResolutionSink cenv.tcSink (mItemAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed + | _ -> + error(Error(FSComp.SR.tcInvalidUseOfDelegate(), mItem)) - match delayed with - // Mutable value set: 'v <- e' - | DelayedSet(e2, mStmt) :: otherDelayed -> - if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) - UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty - vref.Deref.SetHasBeenReferenced() - CheckValAccessible mItem env.AccessRights vref - CheckValAttributes g vref mItem |> CommitOperationResult - let vty = vref.Type - let vty2 = - if isByrefTy g vty then - destByrefTy g vty - else - if not vref.IsMutable then - errorR (ValNotMutable (env.DisplayEnv, vref, mStmt)) - vty - // Always allow subsumption on assignment to fields - let e2', tpenv = TcExprFlex cenv true false vty2 env tpenv e2 - let vexp = - if isInByrefTy g vty then - errorR(Error(FSComp.SR.writeToReadOnlyByref(), mStmt)) - mkAddrSet mStmt vref e2' - elif isByrefTy g vty then - mkAddrSet mStmt vref e2' - else - mkValSet mStmt vref e2' - - PropagateThenTcDelayed cenv overallTy env tpenv mStmt (MakeApplicableExprNoFlex cenv vexp) (tyOfExpr g vexp) ExprAtomicFlag.NonAtomic otherDelayed - - // Value instantiation: v ... - | DelayedTypeApp(tys, _mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> - // Note: we know this is a NormalValUse or PossibleConstrainedCall because: - // - it isn't a CtorValUsedAsSuperInit - // - it isn't a CtorValUsedAsSelfInit - // - it isn't a VSlotDirectCall (uses of base values do not take type arguments - // Allow `nameof<'T>` for a generic parameter - match vref with - | _ when isNameOfValRef cenv.g vref && cenv.g.langVersion.SupportsFeature LanguageFeature.NameOf -> - match tys with - | [SynType.Var(SynTypar(id, _, false) as tp, _m)] -> - let _tp', tpenv = TcTyparOrMeasurePar None cenv env ImplicitlyBoundTyparsAllowed.NoNewTypars tpenv tp - let vexp = TcNameOfExprResult cenv id mExprAndTypeArgs - let vexpFlex = MakeApplicableExprNoFlex cenv vexp - PropagateThenTcDelayed cenv overallTy env tpenv mExprAndTypeArgs vexpFlex cenv.g.string_ty ExprAtomicFlag.Atomic otherDelayed - | _ -> - error (Error(FSComp.SR.expressionHasNoName(), mExprAndTypeArgs)) +and TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed = + let g = cenv.g + match delayed with + // Mutable value set: 'v <- e' + | DelayedSet(e2, mStmt) :: otherDelayed -> + if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) + UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty + vref.Deref.SetHasBeenReferenced() + CheckValAccessible mItem env.AccessRights vref + CheckValAttributes g vref mItem |> CommitOperationResult + let vty = vref.Type + let vty2 = + if isByrefTy g vty then + destByrefTy g vty + else + if not vref.IsMutable then + errorR (ValNotMutable (env.DisplayEnv, vref, mStmt)) + vty + // Always allow subsumption on assignment to fields + let e2', tpenv = TcExprFlex cenv true false vty2 env tpenv e2 + let vexp = + if isInByrefTy g vty then + errorR(Error(FSComp.SR.writeToReadOnlyByref(), mStmt)) + mkAddrSet mStmt vref e2' + elif isByrefTy g vty then + mkAddrSet mStmt vref e2' + else + mkValSet mStmt vref e2' + + PropagateThenTcDelayed cenv overallTy env tpenv mStmt (MakeApplicableExprNoFlex cenv vexp) (tyOfExpr g vexp) ExprAtomicFlag.NonAtomic otherDelayed + + // Value instantiation: v ... + | DelayedTypeApp(tys, _mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> + // Note: we know this is a NormalValUse or PossibleConstrainedCall because: + // - it isn't a CtorValUsedAsSuperInit + // - it isn't a CtorValUsedAsSelfInit + // - it isn't a VSlotDirectCall (uses of base values do not take type arguments + // Allow `nameof<'T>` for a generic parameter + match vref with + | _ when isNameOfValRef cenv.g vref && cenv.g.langVersion.SupportsFeature LanguageFeature.NameOf -> + match tys with + | [SynType.Var(SynTypar(id, _, false) as tp, _m)] -> + let _tp', tpenv = TcTyparOrMeasurePar None cenv env ImplicitlyBoundTyparsAllowed.NoNewTypars tpenv tp + let vexp = TcNameOfExprResult cenv id mExprAndTypeArgs + let vexpFlex = MakeApplicableExprNoFlex cenv vexp + PropagateThenTcDelayed cenv overallTy env tpenv mExprAndTypeArgs vexpFlex cenv.g.string_ty ExprAtomicFlag.Atomic otherDelayed | _ -> - let checkTys tpenv kinds = TcTypesOrMeasures (Some kinds) cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mItem - let _, vexp, isSpecial, _, _, tpenv = TcVal true cenv env tpenv vref (Some (NormalValUse, checkTys)) (Some afterResolution) mItem + error (Error(FSComp.SR.expressionHasNoName(), mExprAndTypeArgs)) + | _ -> + let checkTys tpenv kinds = TcTypesOrMeasures (Some kinds) cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mItem + let _, vexp, isSpecial, _, _, tpenv = TcVal true cenv env tpenv vref (Some (NormalValUse, checkTys)) (Some afterResolution) mItem - let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp) - // We need to eventually record the type resolution for an expression, but this is done - // inside PropagateThenTcDelayed, so we don't have to explicitly call 'CallExprHasTypeSink' here - PropagateThenTcDelayed cenv overallTy env tpenv mExprAndTypeArgs vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic otherDelayed + let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp) + // We need to eventually record the type resolution for an expression, but this is done + // inside PropagateThenTcDelayed, so we don't have to explicitly call 'CallExprHasTypeSink' here + PropagateThenTcDelayed cenv overallTy env tpenv mExprAndTypeArgs vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic otherDelayed - // Value get - | _ -> - let _, vexp, isSpecial, _, _, tpenv = TcVal true cenv env tpenv vref None (Some afterResolution) mItem - let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp) - PropagateThenTcDelayed cenv overallTy env tpenv mItem vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic delayed + // Value get + | _ -> + let _, vexp, isSpecial, _, _, tpenv = TcVal true cenv env tpenv vref None (Some afterResolution) mItem + let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp) + PropagateThenTcDelayed cenv overallTy env tpenv mItem vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic delayed - | Item.Property (nm, pinfos) -> - if isNil pinfos then error (InternalError ("Unexpected error: empty property list", mItem)) - // if there are both intrinsics and extensions in pinfos, intrinsics will be listed first. - // by looking at List.Head we are letting the intrinsics determine indexed/non-indexed - let pinfo = List.head pinfos - let _, tyargsOpt, args, delayed, tpenv = - if pinfo.IsIndexer - then GetMemberApplicationArgs delayed cenv env tpenv - else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv - if not pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsNotStatic nm, mItem)) - match delayed with - | DelayedSet(e2, mStmt) :: otherDelayed -> - if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) - // Static Property Set (possibly indexer) - UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty - let meths = pinfos |> SettersOfPropInfos - if meths.IsEmpty then - let meths = pinfos |> GettersOfPropInfos - let isByrefMethReturnSetter = meths |> List.exists (function _,Some pinfo -> isByrefTy g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false) - if not isByrefMethReturnSetter then - errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) - // x.P <- ... byref setter - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed - else - let args = if pinfo.IsIndexer then args else [] - if isNil meths then - errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) - // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[e2]) ExprAtomicFlag.NonAtomic otherDelayed - | _ -> - // Static Property Get (possibly indexer) +and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution delayed = + let g = cenv.g + let ad = env.eAccessRights + if isNil pinfos then error (InternalError ("Unexpected error: empty property list", mItem)) + // if there are both intrinsics and extensions in pinfos, intrinsics will be listed first. + // by looking at List.Head we are letting the intrinsics determine indexed/non-indexed + let pinfo = List.head pinfos + let _, tyargsOpt, args, delayed, tpenv = + if pinfo.IsIndexer + then GetMemberApplicationArgs delayed cenv env tpenv + else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv + if not pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsNotStatic nm, mItem)) + match delayed with + | DelayedSet(e2, mStmt) :: otherDelayed -> + if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) + // Static Property Set (possibly indexer) + UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty + let meths = pinfos |> SettersOfPropInfos + if meths.IsEmpty then let meths = pinfos |> GettersOfPropInfos + let isByrefMethReturnSetter = meths |> List.exists (function _,Some pinfo -> isByrefTy g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false) + if not isByrefMethReturnSetter then + errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) + // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - // Note: static calls never mutate a struct object argument TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed + else + let args = if pinfo.IsIndexer then args else [] + if isNil meths then + errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) + // Note: static calls never mutate a struct object argument + TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[e2]) ExprAtomicFlag.NonAtomic otherDelayed + | _ -> + // Static Property Get (possibly indexer) + let meths = pinfos |> GettersOfPropInfos + if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) + // Note: static calls never mutate a struct object argument + TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed - | Item.ILField finfo -> +and TcILFieldItemThen cenv overallTy env finfo tpenv mItem delayed = + let g = cenv.g + let ad = env.eAccessRights + ILFieldStaticChecks g cenv.amap cenv.infoReader ad mItem finfo + let fref = finfo.ILFieldRef + let exprty = finfo.FieldType(cenv.amap, mItem) + match delayed with + | DelayedSet(e2, mStmt) :: _delayed' -> + UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty + // Always allow subsumption on assignment to fields + let e2', tpenv = TcExprFlex cenv true false exprty env tpenv e2 + let expr = BuildILStaticFieldSet mStmt finfo e2' + expr, tpenv + | _ -> + // Get static IL field + let expr = + match finfo.LiteralValue with + | Some lit -> + Expr.Const (TcFieldInit mItem lit, mItem, exprty) + | None -> + let isValueType = finfo.IsValueType + let valu = if isValueType then AsValue else AsObject - ILFieldStaticChecks g cenv.amap cenv.infoReader ad mItem finfo - let fref = finfo.ILFieldRef - let exprty = finfo.FieldType(cenv.amap, mItem) - match delayed with - | DelayedSet(e2, mStmt) :: _delayed' -> - UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty - // Always allow subsumption on assignment to fields - let e2', tpenv = TcExprFlex cenv true false exprty env tpenv e2 - let expr = BuildILStaticFieldSet mStmt finfo e2' - expr, tpenv - | _ -> - // Get static IL field - let expr = - match finfo.LiteralValue with - | Some lit -> - Expr.Const (TcFieldInit mItem lit, mItem, exprty) - | None -> - let isValueType = finfo.IsValueType - let valu = if isValueType then AsValue else AsObject + // The empty instantiation on the fspec is OK, since we make the correct fspec in IlxGen.GenAsm + // This ensures we always get the type instantiation right when doing this from + // polymorphic code, after inlining etc. + let fspec = mkILFieldSpec(fref, mkILNamedTy valu fref.DeclaringTypeRef []) - // The empty instantiation on the fspec is OK, since we make the correct fspec in IlxGen.GenAsm - // This ensures we always get the type instantiation right when doing this from - // polymorphic code, after inlining etc. - let fspec = mkILFieldSpec(fref, mkILNamedTy valu fref.DeclaringTypeRef []) + // Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr. + mkAsmExpr ([ mkNormalLdsfld fspec ] @ (if finfo.IsInitOnly then [ AI_nop ] else []), finfo.TypeInst, [], [exprty], mItem) + PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed - // Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr. - mkAsmExpr ([ mkNormalLdsfld fspec ] @ (if finfo.IsInitOnly then [ AI_nop ] else []), finfo.TypeInst, [], [exprty], mItem) - PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed +and TcRecdFieldItemThen cenv overallTy env rfinfo tpenv mItem delayed = + let g = cenv.g + let ad = env.eAccessRights + // Get static F# field or literal + CheckRecdFieldInfoAccessible cenv.amap mItem ad rfinfo + if not rfinfo.IsStatic then error (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.DisplayName), mItem)) + CheckRecdFieldInfoAttributes g rfinfo mItem |> CommitOperationResult + let fref = rfinfo.RecdFieldRef + let fieldTy = rfinfo.FieldType + match delayed with + | DelayedSet(e2, mStmt) :: otherDelayed -> + if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) - | Item.RecdField rfinfo -> - // Get static F# field or literal - CheckRecdFieldInfoAccessible cenv.amap mItem ad rfinfo - if not rfinfo.IsStatic then error (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.DisplayName), mItem)) - CheckRecdFieldInfoAttributes g rfinfo mItem |> CommitOperationResult - let fref = rfinfo.RecdFieldRef + // Set static F# field + CheckRecdFieldMutation mItem env.DisplayEnv rfinfo + UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty let fieldTy = rfinfo.FieldType - match delayed with - | DelayedSet(e2, mStmt) :: otherDelayed -> - if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) - - // Set static F# field - CheckRecdFieldMutation mItem env.DisplayEnv rfinfo - UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty - let fieldTy = rfinfo.FieldType - // Always allow subsumption on assignment to fields - let e2', tpenv = TcExprFlex cenv true false fieldTy env tpenv e2 - let expr = mkStaticRecdFieldSet (rfinfo.RecdFieldRef, rfinfo.TypeInst, e2', mStmt) - expr, tpenv - | _ -> - let exprty = fieldTy - let expr = - match rfinfo.LiteralValue with - // Get literal F# field - | Some lit -> Expr.Const (lit, mItem, exprty) - // Get static F# field - | None -> mkStaticRecdFieldGet (fref, rfinfo.TypeInst, mItem) - PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed - - | Item.Event einfo -> - // Instance IL event (fake up event-as-value) - TcEventValueThen cenv overallTy env tpenv mItem mItem None einfo delayed - - | Item.CustomOperation (nm, usageTextOpt, _) -> - // 'delayed' is about to be dropped on the floor, first do rudimentary checking to get name resolutions in its body - RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects_Delayed cenv env tpenv delayed - match usageTextOpt() with - | None -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly nm, mItem)) - | Some usageText -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly2(nm, usageText), mItem)) - | _ -> error(Error(FSComp.SR.tcLookupMayNotBeUsedHere(), mItem)) - + // Always allow subsumption on assignment to fields + let e2', tpenv = TcExprFlex cenv true false fieldTy env tpenv e2 + let expr = mkStaticRecdFieldSet (rfinfo.RecdFieldRef, rfinfo.TypeInst, e2', mStmt) + expr, tpenv + | _ -> + let exprty = fieldTy + let expr = + match rfinfo.LiteralValue with + // Get literal F# field + | Some lit -> Expr.Const (lit, mItem, exprty) + // Get static F# field + | None -> mkStaticRecdFieldGet (fref, rfinfo.TypeInst, mItem) + PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed //------------------------------------------------------------------------- // Typecheck "expr.A.B.C ... " constructs @@ -8834,12 +8876,12 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela | Item.Event einfo -> // Instance IL event (fake up event-as-value) - TcEventValueThen cenv overallTy env tpenv mItem mExprAndItem (Some(objExpr, objExprTy)) einfo delayed + TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem (Some(objExpr, objExprTy)) einfo delayed | Item.FakeInterfaceCtor _ | Item.DelegateCtor _ -> error (Error (FSComp.SR.tcConstructorsCannotBeFirstClassValues(), mItem)) | _ -> error (Error (FSComp.SR.tcSyntaxFormUsedOnlyWithRecordLabelsPropertiesAndFields(), mItem)) -and TcEventValueThen cenv overallTy env tpenv mItem mExprAndItem objDetails (einfo: EventInfo) delayed = +and TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem objDetails (einfo: EventInfo) delayed = // Instance IL event (fake up event-as-value) let nm = einfo.EventName let ad = env.eAccessRights diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 479964041ee..dd3bcb7fc65 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -1129,103 +1129,26 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi CheckValUse cenv env (vref, vFlags, m) context | Expr.Quote (ast, savedConv, _isFromQueryExpression, m, ty) -> - CheckExprNoByrefs cenv {env with quote=true} ast - if cenv.reportErrors then - cenv.usesQuotations <- true - - // Translate the quotation to quotation data - try - let doData suppressWitnesses = - let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) - let qdata = QuotationTranslator.ConvExprPublic qscope suppressWitnesses ast - let typeDefs, spliceTypes, spliceExprs = qscope.Close() - typeDefs, List.map fst spliceTypes, List.map fst spliceExprs, qdata - - let data1 = doData true - let data2 = doData false - match savedConv.Value with - | None -> - savedConv.Value <- Some (data1, data2) - | Some _ -> - () - with QuotationTranslator.InvalidQuotedTerm e -> - errorRecovery e m - - CheckTypeNoByrefs cenv env m ty - NoLimit + CheckQuoteExpr cenv env (ast, savedConv, m, ty) - | StructStateMachineExpr g (_dataTy, - (moveNextThisVar, moveNextExpr), - (setStateMachineThisVar, setStateMachineStateVar, setStateMachineBody), - (afterCodeThisVar, afterCodeBody)) -> - if not (g.langVersion.SupportsFeature LanguageFeature.ResumableStateMachines) then - error(Error(FSComp.SR.tcResumableCodeNotSupported(), expr.Range)) - - BindVals cenv env [moveNextThisVar; setStateMachineThisVar; setStateMachineStateVar; afterCodeThisVar] - CheckExprNoByrefs cenv { env with resumableCode = Resumable.ResumableExpr true } moveNextExpr - CheckExprNoByrefs cenv env setStateMachineBody - CheckExprNoByrefs cenv env afterCodeBody - NoLimit + | StructStateMachineExpr g info -> + CheckStructStateMachineExpr cenv env expr info | Expr.Obj (_, ty, basev, superInitCall, overrides, iimpls, m) -> - CheckExprNoByrefs cenv env superInitCall - CheckMethods cenv env basev (ty, overrides) - CheckInterfaceImpls cenv env basev iimpls - CheckTypeNoByrefs cenv env m ty - - let interfaces = - [ if isInterfaceTy g ty then - yield! AllSuperTypesOfType g cenv.amap m AllowMultiIntfInstantiations.Yes ty - for ty, _ in iimpls do - yield! AllSuperTypesOfType g cenv.amap m AllowMultiIntfInstantiations.Yes ty ] - |> List.filter (isInterfaceTy g) - - CheckMultipleInterfaceInstantiations cenv ty interfaces true m - NoLimit + CheckObjectExpr cenv env (ty, basev, superInitCall, overrides, iimpls, m) // Allow base calls to F# methods | Expr.App (InnerExprPat(ExprValWithPossibleTypeInst(v, vFlags, _, _) as f), _fty, tyargs, Expr.Val (baseVal, _, _) :: rest, m) when ((match vFlags with VSlotDirectCall -> true | _ -> false) && baseVal.IsBaseVal) -> - let memberInfo = Option.get v.MemberInfo - if memberInfo.MemberFlags.IsDispatchSlot then - errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName), m)) - NoLimit - else - let env = { env with isInAppExpr = true } - let returnTy = tyOfExpr g expr - - CheckValRef cenv env v m PermitByRefExpr.No - CheckValRef cenv env baseVal m PermitByRefExpr.No - CheckTypeInstNoByrefs cenv env m tyargs - CheckTypeNoInnerByrefs cenv env m returnTy - CheckExprs cenv env rest (mkArgsForAppliedExpr true rest f) + CheckFSharpBaseCall cenv env expr (v, f, _fty, tyargs, baseVal, rest, m) // Allow base calls to IL methods | Expr.Op (TOp.ILCall (isVirtual, _, _, _, _, _, _, ilMethRef, enclTypeInst, methInst, retTypes), tyargs, Expr.Val (baseVal, _, _) :: rest, m) when not isVirtual && baseVal.IsBaseVal -> - // Disallow calls to abstract base methods on IL types. - match tryTcrefOfAppTy g baseVal.Type with - | ValueSome tcref when tcref.IsILTycon -> - try - // This is awkward - we have to explicitly re-resolve back to the IL metadata to determine if the method is abstract. - // We believe this may be fragile in some situations, since we are using the Abstract IL code to compare - // type equality, and it would be much better to remove any F# dependency on that implementation of IL type - // equality. It would be better to make this check in tc.fs when we have the Abstract IL metadata for the method to hand. - let mdef = resolveILMethodRef tcref.ILTyconRawMetadata ilMethRef - if mdef.IsAbstract then - errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(mdef.Name), m)) - with _ -> () // defensive coding - | _ -> () - - CheckTypeInstNoByrefs cenv env m tyargs - CheckTypeInstNoByrefs cenv env m enclTypeInst - CheckTypeInstNoByrefs cenv env m methInst - CheckTypeInstNoByrefs cenv env m retTypes - CheckValRef cenv env baseVal m PermitByRefExpr.No - CheckExprsPermitByRefLike cenv env rest + CheckILBaseCall cenv env (ilMethRef, enclTypeInst, methInst, retTypes, tyargs, baseVal, rest, m) | Expr.Op (op, tyargs, args, m) -> CheckExprOp cenv env (op, tyargs, args, m) context expr @@ -1240,48 +1163,17 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi // Allow '%expr' in quotations | Expr.App (Expr.Val (vref, _, _), _, tinst, [arg], m) when isSpliceOperator g vref && env.quote -> - CheckTypeInstNoInnerByrefs cenv env m tinst // it's the splice operator, a byref instantiation is allowed - CheckExprNoByrefs cenv env arg - NoLimit + CheckSpliceApplication cenv env (tinst, arg, m) // Check an application | Expr.App (f, _fty, tyargs, argsl, m) -> - match expr with - | ResumableCodeInvoke g _ -> - warning(Error(FSComp.SR.tcResumableCodeInvocation(), m)) - | _ -> () - - let returnTy = tyOfExpr g expr - - // This is to handle recursive cases. Don't check 'returnTy' again if we are still inside a app expression. - if not env.isInAppExpr then - CheckTypeNoInnerByrefs cenv env m returnTy + CheckApplication cenv env expr (f, tyargs, argsl, m) context - let env = { env with isInAppExpr = true } - - CheckTypeInstNoByrefs cenv env m tyargs - CheckExprNoByrefs cenv env f - - let hasReceiver = - match f with - | Expr.Val (vref, _, _) when vref.IsInstanceMember && not argsl.IsEmpty -> true - | _ -> false - - let contexts = mkArgsForAppliedExpr false argsl f - if hasReceiver then - CheckCallWithReceiver cenv env m returnTy argsl contexts context - else - CheckCall cenv env m returnTy argsl contexts context - - | Expr.Lambda (_, _ctorThisValOpt, _baseValOpt, argvs, _, m, rty) -> - let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) - let ty = mkMultiLambdaTy m argvs rty in - CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes + | Expr.Lambda (_, _, _, argvs, _, m, rty) -> + CheckLambda cenv env expr (argvs, m, rty) | Expr.TyLambda (_, tps, _, m, rty) -> - let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) - let ty = mkForallTyIfNeeded tps rty in - CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes + CheckTyLambda cenv env expr (tps, m, rty) | Expr.TyChoose (tps, e1, _) -> let env = BindTypars g env tps @@ -1289,26 +1181,13 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi NoLimit | Expr.Match (_, _, dtree, targets, m, ty) -> - CheckTypeNoInnerByrefs cenv env m ty // computed byrefs allowed at each branch - CheckDecisionTree cenv env dtree - CheckDecisionTreeTargets cenv env targets context + CheckMatch cenv env context (dtree, targets, m, ty) - | Expr.LetRec (binds, e, _, _) -> - BindVals cenv env (valsOfBinds binds) - CheckBindings cenv env binds - CheckExprNoByrefs cenv env e - NoLimit + | Expr.LetRec (binds, bodyExpr, _, _) -> + CheckLetRec cenv env (binds, bodyExpr) | Expr.StaticOptimization (constraints, e2, e3, m) -> - CheckExprNoByrefs cenv env e2 - CheckExprNoByrefs cenv env e3 - constraints |> List.iter (function - | TTyconEqualsTycon(ty1, ty2) -> - CheckTypeNoByrefs cenv env m ty1 - CheckTypeNoByrefs cenv env m ty2 - | TTyconIsStruct ty1 -> - CheckTypeNoByrefs cenv env m ty1) - NoLimit + CheckStaticOptimization cenv env (constraints, e2, e3, m) | Expr.WitnessArg _ -> NoLimit @@ -1316,6 +1195,172 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi | Expr.Link _ -> failwith "Unexpected reclink" +and CheckQuoteExpr cenv env (ast, savedConv, m, ty) = + let g = cenv.g + CheckExprNoByrefs cenv {env with quote=true} ast + if cenv.reportErrors then + cenv.usesQuotations <- true + + // Translate the quotation to quotation data + try + let doData suppressWitnesses = + let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) + let qdata = QuotationTranslator.ConvExprPublic qscope suppressWitnesses ast + let typeDefs, spliceTypes, spliceExprs = qscope.Close() + typeDefs, List.map fst spliceTypes, List.map fst spliceExprs, qdata + + let data1 = doData true + let data2 = doData false + match savedConv.Value with + | None -> + savedConv.Value <- Some (data1, data2) + | Some _ -> + () + with QuotationTranslator.InvalidQuotedTerm e -> + errorRecovery e m + + CheckTypeNoByrefs cenv env m ty + NoLimit + +and CheckStructStateMachineExpr cenv env expr info = + + let g = cenv.g + let (_dataTy, + (moveNextThisVar, moveNextExpr), + (setStateMachineThisVar, setStateMachineStateVar, setStateMachineBody), + (afterCodeThisVar, afterCodeBody)) = info + + if not (g.langVersion.SupportsFeature LanguageFeature.ResumableStateMachines) then + error(Error(FSComp.SR.tcResumableCodeNotSupported(), expr.Range)) + + BindVals cenv env [moveNextThisVar; setStateMachineThisVar; setStateMachineStateVar; afterCodeThisVar] + CheckExprNoByrefs cenv { env with resumableCode = Resumable.ResumableExpr true } moveNextExpr + CheckExprNoByrefs cenv env setStateMachineBody + CheckExprNoByrefs cenv env afterCodeBody + NoLimit + +and CheckObjectExpr cenv env (ty, basev, superInitCall, overrides, iimpls, m) = + let g = cenv.g + CheckExprNoByrefs cenv env superInitCall + CheckMethods cenv env basev (ty, overrides) + CheckInterfaceImpls cenv env basev iimpls + CheckTypeNoByrefs cenv env m ty + + let interfaces = + [ if isInterfaceTy g ty then + yield! AllSuperTypesOfType g cenv.amap m AllowMultiIntfInstantiations.Yes ty + for ty, _ in iimpls do + yield! AllSuperTypesOfType g cenv.amap m AllowMultiIntfInstantiations.Yes ty ] + |> List.filter (isInterfaceTy g) + + CheckMultipleInterfaceInstantiations cenv ty interfaces true m + NoLimit + +and CheckFSharpBaseCall cenv env expr (v, f, _fty, tyargs, baseVal, rest, m) = + let g = cenv.g + let memberInfo = Option.get v.MemberInfo + if memberInfo.MemberFlags.IsDispatchSlot then + errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName), m)) + NoLimit + else + let env = { env with isInAppExpr = true } + let returnTy = tyOfExpr g expr + + CheckValRef cenv env v m PermitByRefExpr.No + CheckValRef cenv env baseVal m PermitByRefExpr.No + CheckTypeInstNoByrefs cenv env m tyargs + CheckTypeNoInnerByrefs cenv env m returnTy + CheckExprs cenv env rest (mkArgsForAppliedExpr true rest f) + +and CheckILBaseCall cenv env (ilMethRef, enclTypeInst, methInst, retTypes, tyargs, baseVal, rest, m) = + let g = cenv.g + // Disallow calls to abstract base methods on IL types. + match tryTcrefOfAppTy g baseVal.Type with + | ValueSome tcref when tcref.IsILTycon -> + try + // This is awkward - we have to explicitly re-resolve back to the IL metadata to determine if the method is abstract. + // We believe this may be fragile in some situations, since we are using the Abstract IL code to compare + // type equality, and it would be much better to remove any F# dependency on that implementation of IL type + // equality. It would be better to make this check in tc.fs when we have the Abstract IL metadata for the method to hand. + let mdef = resolveILMethodRef tcref.ILTyconRawMetadata ilMethRef + if mdef.IsAbstract then + errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(mdef.Name), m)) + with _ -> () // defensive coding + | _ -> () + + CheckTypeInstNoByrefs cenv env m tyargs + CheckTypeInstNoByrefs cenv env m enclTypeInst + CheckTypeInstNoByrefs cenv env m methInst + CheckTypeInstNoByrefs cenv env m retTypes + CheckValRef cenv env baseVal m PermitByRefExpr.No + CheckExprsPermitByRefLike cenv env rest + +and CheckSpliceApplication cenv env (tinst, arg, m) = + CheckTypeInstNoInnerByrefs cenv env m tinst // it's the splice operator, a byref instantiation is allowed + CheckExprNoByrefs cenv env arg + NoLimit + +and CheckApplication cenv env expr (f, tyargs, argsl, m) context = + let g = cenv.g + match expr with + | ResumableCodeInvoke g _ -> + warning(Error(FSComp.SR.tcResumableCodeInvocation(), m)) + | _ -> () + + let returnTy = tyOfExpr g expr + + // This is to handle recursive cases. Don't check 'returnTy' again if we are still inside a app expression. + if not env.isInAppExpr then + CheckTypeNoInnerByrefs cenv env m returnTy + + let env = { env with isInAppExpr = true } + + CheckTypeInstNoByrefs cenv env m tyargs + CheckExprNoByrefs cenv env f + + let hasReceiver = + match f with + | Expr.Val (vref, _, _) when vref.IsInstanceMember && not argsl.IsEmpty -> true + | _ -> false + + let contexts = mkArgsForAppliedExpr false argsl f + if hasReceiver then + CheckCallWithReceiver cenv env m returnTy argsl contexts context + else + CheckCall cenv env m returnTy argsl contexts context + +and CheckLambda cenv env expr (argvs, m, rty) = + let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) + let ty = mkMultiLambdaTy m argvs rty in + CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes + +and CheckTyLambda cenv env expr (tps, m, rty) = + let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) + let ty = mkForallTyIfNeeded tps rty in + CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes + +and CheckMatch cenv env context (dtree, targets, m, ty) = + CheckTypeNoInnerByrefs cenv env m ty // computed byrefs allowed at each branch + CheckDecisionTree cenv env dtree + CheckDecisionTreeTargets cenv env targets context + +and CheckLetRec cenv env (binds, bodyExpr) = + BindVals cenv env (valsOfBinds binds) + CheckBindings cenv env binds + CheckExprNoByrefs cenv env bodyExpr + NoLimit + +and CheckStaticOptimization cenv env (constraints, e2, e3, m) = + CheckExprNoByrefs cenv env e2 + CheckExprNoByrefs cenv env e3 + constraints |> List.iter (function + | TTyconEqualsTycon(ty1, ty2) -> + CheckTypeNoByrefs cenv env m ty1 + CheckTypeNoByrefs cenv env m ty2 + | TTyconIsStruct ty1 -> + CheckTypeNoByrefs cenv env m ty1) + NoLimit + and CheckMethods cenv env baseValOpt (ty, methods) = methods |> List.iter (CheckMethod cenv env baseValOpt ty) From 0458724cfeac601f656a424de9d0b7aafcda8c36 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 17 Nov 2021 00:21:29 +0000 Subject: [PATCH 03/26] Add debug emit docs (#12411) * add debug emit docs * add debug emit docs * add debug emit docs * add debug emit docs * add debug emit docs * add debug emit docs * add debug emit docs --- docs/debug-emit.md | 486 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 486 insertions(+) create mode 100644 docs/debug-emit.md diff --git a/docs/debug-emit.md b/docs/debug-emit.md new file mode 100644 index 00000000000..70477ded0b0 --- /dev/null +++ b/docs/debug-emit.md @@ -0,0 +1,486 @@ +--- +title: Debug emit +category: Compiler Internals +categoryindex: 200 +index: 350 +--- +# Debug emit + +The F# compiler code base emits debug information and attributes. This article documents what we do, how it is implemented and the problem areas in our implementation. + +There are mistakes and missing pieces to our debug information. Small improvements can make a major difference. Please help us fix mistakes and get things right. + +The file `tests\walkthroughs\DebugStepping\TheBigFileOfDebugStepping.fsx` is crucial for testing the stepping experience for a range of constructs. + +## User experiences + +Debugging information affects numerous user experiences: + +* **Call stacks** during debugging +* **Breakpoint placement** before and during debugging +* **Locals** during debugging +* **Just my code** debugging (which limits the view of debug code to exclude libraries) +* **Exception** debugging (e.g. "first chance" debugging when exceptions occur) +* **Stepping** debugging +* **Watch** window +* **Profiling** results +* **Code coverage** results + +Some experiences are un-implemented by F# including: + +* **Autos** during debugging +* **Edit and Continue** +* **Hot reload** + +## Emitted information + +Emitted debug information includes: + +* The names of methods in .NET IL +* The PDB file/information (embedded or in PDB file) which contains + * Debug "sequence" points for IL code + * Names of locals and the IL code scopes over which those names are active +* The attributes on IL methods such as `CompilerGeneratedAttribute` and `DebuggerNonUserCodeAttribute`, wee below +* We add some codegen to give better debug experiences, see below. + +## Design-time services + +IDE tooling performs queries into the F# language service, notably: + +* `ValidateBreakpointLocation` [(permalink)](https://github.com/dotnet/fsharp/blob/24979b692fc88dc75e2467e30b75667058fd9504/src/fsharp/service/FSharpParseFileResults.fs#L795) is called to validate every breakpoint before debugging is launched. This operates on syntax trees. See notes below. + +## Debugging and optimization + +Nearly all optimizations are **off** when debug code is being generated. + +* The optimizer is run for forced inlining only +* List and array expressions do generate collector code +* State machines are generated for tasks and sequences +* "let mutable" --> "ref" promotion happens for captured local mutables +* Tailcalls are off by default and not emitted in IlxGen. + +Otherwise, what comes out of the type checker is pretty much what goes into IlxGen.fs. + +## Debug points + +### Terminology + +We use the terms "sequence point" and "debug point" interchangeably. The word "sequence" has too many meanings in the F# compiler so in the actual code you'll see "DebugPoint" more often, though for abbreviations you may see `spFoo` or `mFoo`. + +### How breakpoints work (high level) + +Breakpoints have two existences which must give matching behavior: + +* At design-time, before debugging is launched, `ValidateBreakpointLocation` is called to validate every breakpoint. This operators on the SyntaxTree and forms a kind of "gold-standard" about the exact places where break points are valid. + +* At run-time, breakpoints are "mapped" by the .NET runtime to actual sequence points found in the PDB data for .NET methods. The runtime searches all methods with debug points for the relevant document and determines where to "bind" the actual breakpoint to. A typical debugger can bind a breakpoint to multiple locations. + +This means there is an invariant that `ValidateBreakpointLocation` and the emitted IL debug points correspond. + +> NOTE: The IL code can and does contain extra debug points that don't pass ValidateBreakpointLocation. It won't be possible to set a breakpoint for these, but they will appear in stepping. + +### Intended debug points for control-flow constructs + +The intended debug points for control-flow constructs are as follows: + +| Construct | Debug points | +|:-----------|:----------------| +| `let ..` | See below | +| `let rec ..` | Implicit on body | +| `if .. then ..` | `if .. then` and implicit on body | +| `if .. then .. else ..` | `if .. then` and implicit on branches | +| `match .. with ..` | `match .. with` and `when` patterns and implicit on case targets | +| `while .. do ..` | `while .. do` and implicit on body | +| `for .. do` | `for .. do` and implicit on body | +| `try .. with ..` | `try` and `with` and implicit on body and handler | +| `try .. finally ..` | `try` and `finally` and implicit on body and handler | +| `use ..` | See below for `let` | +| `expr1; expr` sequential | On `expr1` and implicit on `expr2` | +| `expr1 |> expr2` | On `expr1` and `expr2` | +| `(expr1a, expr1b) ||> expr2` | On `expr1a`, `expr1b` and `expr2` | +| `(expr1a, expr1b, expr1c) |||> expr2` | On `expr1a`, `expr1b` and `expr2` | +| `yield expr` | On `yield expr` | +| `return expr` | On `return expr` | + +Some debug points are implicit. In particular, whenever a non-control-flow expression (e.g. a constant or a call) is used in statement position (e.g. as the implementation of a method, or the body of a `while`) then there is an implicit debug point over the whole statement/expression. + +### Intended debug points for let-bindings + +`let` bindings get immediate debug points if the thing is not a function and the implementation is not control flow. For example + +```fsharp +let f () = + let x = 1 // debug point for whole of `let x = 1` + let f x = 1 // no debug point on `let f x =`, debug point on `1` + let x = if today then 1 else tomorrow // no debug point on `let x =`, debug point on `if today then` and `1` and `tomorrow` + let x = let y = 1 in y + y // no debug point on `let x =`, debug point on `let y = 1` and `y + y` + ... +``` + +### Intended debug points for nested control-flow + +Debug points are not generally emitted for non-statement constructs, e.g. consider: + +```fsharp +let h1 x = g (f x) +let h2 x = x |> f |> g +``` + +Here `g (f x)` gets one debug point. Note that the corresponding pipelining gets three debug points. + +If however a nested expression is control-flow, then debug points start being emitted again e.g. + +```fsharp +let h3 x = f (if today then 1 else 2) +``` + +Here debug points are at `if today then` and `1` and `2` and all of `f (if today then 1 else 2)` + +> NOTE: these debug points are overlapping + +### Intended debug points for `[...]`, `[| ... |]` code + +The intended debug points for these constructs are the same as for the expressions inside the constructs. For example + +```fsharp +let x = [ for i in 1 .. 10 do yield 1 ] +``` + +This will have debug points on `for i in 1 .. 10 do` and `yield 1`. + +### Intended debug points for `seq { .. }` and `task { .. }` code + +The intended debug points for tasks is the same as for the expressions inside the constructs. For example + +```fsharp +let f() = task { for i in 1 .. 10 do printfn "hello" } +``` + +This will have debug points on `for i in 1 .. 10 do` and `printfn "hello"`. + +> NOTE: there are glitches, see further below + +### Intended debug points for other computation expressions + +Other computation expressions such as `async { .. }` have significant problems with their debug points, for multiple reasons: + +* The debug points are largely lost during de-sugaring +* The computations are often "cold-start" anyway, leading to a two-phase debug problem + +See further below. In practice debug points can often be placed for user code, e.g. sequential imperative statements or `let` bindings. However debug points for control constructs are often lossy or buggy. + +## Implementation of debug points in the compiler + +Most (but not all) debug points are noted by the parser by adding `DebugPointAtTarget`, `DebugPointAtSwitch`, `DebugPointAtSequential`, `DebugPointAtTry`, `DebugPointAtWith`, `DebugPointAtFinally`, `DebugPointAtFor`, `DebugPointAtWhile` or `DebugPointAtBinding`. + +These are then used by `ValidateBreakpointLocation`. These same values are also propagated unchanged all the way through to `IlxGen.fs` for actual code generation, and used for IL emit, e.g. a simple case like this: + +```fsharp + match spTry with + | DebugPointAtTry.Yes m -> CG.EmitDebugPoint cgbuf m ... + | DebugPointAtTry.No -> ... + ... +``` + +For many constructs this is adequate. However, in practice the situation is far more complicated. + +### Internals: Implicit debug points + +Internally in the compiler, some debug points are implicit. In particular, whenever a non-control-flow expression (e.g. a constant or a call) is used in statement position (e.g. as the implementation of a method, or the body of a `while`) then there is an implicit debug point. + +* "Statement position" is tracked by the `spAlways` argument within ValidateBreakpointLocation ([permalink](https://github.com/dotnet/fsharp/blob/24979b692fc88dc75e2467e30b75667058fd9504/src/fsharp/service/FSharpParseFileResults.fs#L481)) +* "Statement position" is similarly tracked by `SPAlways` within IlxGen.fs [permalink](https://github.com/dotnet/fsharp/blob/24979b692fc88dc75e2467e30b75667058fd9504/src/fsharp/IlxGen.fs#L2290) + +Implicit debug points but they also arise in some code-generated constructs or in backup paths in the compiler implementation. In general we want to remove or reduce the occurrence of these and make things more explicit. However they still exist, especially for "lowered" constructs. + +> For example, `DebugPointAtTry.Body` represents a debug point implicitly located on the body of the try (rather than a `try` keyword). Searching the source code, this is generated in the "try/finally" implied by a "use x = ..." construct ([permalink](https://github.com/dotnet/fsharp/blob/24979b692fc88dc75e2467e30b75667058fd9504/src/fsharp/CheckExpressions.fs#L10337)). Is a debug point even needed here? Yes, because otherwise the body of the "using" wouldn't get a debug point. + +### Internals: Debug points for `[...]`, `[| ... |]` + +The internal implementation of debug points for list and array expressions is conceptually simple but a little complex. + +Conceptually the task is easy, e.g. `[ while check() do yield x + x ]` is lowered to code like this: + +```fsharp +let $collector = ListCollector() +while check() do + $collector.Add(x+x) +$collector.Close() +``` + +Note the `while` loop is still a `while` loop - no magic here - and the debug points for the `while` loop can also apply to the actual generated `for` loop. + +However, the actual implementation is more complicated because there is a TypedTree representation of the code in-between that at first seems to bear little resemblance to what comes in. + +```text +SyntaxTree --[CheckComputationExpressions.fs]--> TypedTree --> IlxGen -->[LowerComputedListOrArrayExpr.fs]--> IlxGen +``` + +The TypedTree is a functional encoding into `Seq.toList`, `Seq.singleton` and so on. How do the debug points get propagated? + +* In [`CheckComputationExpressions.fs`](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/CheckComputationExpressions.fs#L1783-L1787) we "note" the debug point for the For loop and attach it to one of the lambdas generated in the TypedTreeForm +* In [`LowerCallsAndSeq.fs`](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/LowerCallsAndSeqs.fs#L138-L139) we "recover" the debug point from precisely that lambda. +* This becomes [an actual debug point in the actual generated "while" loop](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/LowerCallsAndSeqs.fs#L887) + +This then gives accurate debug points for these constructs. + +### Internals: debug points for `seq { .. .}` code + +Debug points for `seq { .. }` compiling to state machines poses similar problems. + +* The de-sugaring is as for list and array expressions +* The debug points are recovered in the state machine generation, for example [here (permalink)](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/LowerCallsAndSeqs.fs#L367) + +### Internals: debug points for `task { .. .}` code + +Debug points for `task { .. }` poses much harder problems. We use "while" loops as an example: + +* The de-sugaring is for computation expressions, and in CheckComputationExpressions.fs "notes" the debug point ranges for the relevant constructs attaching them to the `task.While(...)` call ([example permalink](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/CheckComputationExpressions.fs#L960)) +* The code is then checked and optimized, and all the resumable code is inlined, e.g. [`task.While`](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/FSharp.Core/tasks.fs#L64) becomes [`Resumable.While`](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/FSharp.Core/resumable.fs#L176-L191) which contains a resumable code while loop. +* When inlining the code for `task.While(...)` and all associated transitive inlining, the `remarkExpr` routine is invoked as usual to rewrite all ranges throughout all inlined code to be the range of the outer expression, that is, precisely the earlier noted range. Now [`remarkExpr` is "hacked" to note that the actual resumable "while" loop is being inlined at a noted range](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/TypedTreeOps.fs#L5827-L5832), and places a debug point for that resumable while loop. +* The debug ranges are now attached to the resumable code which is then checked for resumable-code validity and emitted, e.g. see [this](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/LowerStateMachines.fs#L298) + +This however only works fully for those constructs with a single debug point that can be recovered. In particular `TryWith` and `TryFinally` have separate problems + +* `task.TryWith(...)` becomes a resumable code try/with, see [here](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/FSharp.Core/resumable.fs#L216-L230) +* `task.TryFinally(...)` becomes a resumable code try/with, see [here](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/FSharp.Core/resumable.fs#L272-L305) +* Some debug points associated with these `try/with` are suppressed in [`remarkExpr`](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/TypedTreeOps.fs#L5862-L5880) +* The debug points for the `with` and `finally` are not currently recovered. + +### Internals: debug points for other computation expressions + +As mentioned above, other computation expressions such as `async { .. }` have significant problems with their debug points. + +> NOTE: A systematic solution for quality debugging of computation expressions and resumable code is still elusive. It really needs the de-sugaring to explicitly or implicitly pass down the debug points through the process of inlining code. For example consider the de-sugaring: + +```fsharp + builder { for x in xs do ... } --> builder.For(xs, fun x -> ...) +``` + +Here the debug points could be made explicit and passed as "compile-time parameters" (assuming inlining) + +```fsharp + builder { for[dp] x in xs do ... } --> builder.For(dp, xs, fun x -> ...) +``` + +These could then be used in the implementation: + +```fsharp +type MuBuilder() = + // Some builder implementation of "For" - let's say it prints at each iteration of the loop + member inline _.For(dp, xs, f) = + for[dp] x in xs do + printfn "loop..." + f x +``` + +Adding such compile-time parameters would be over-kill, but it may be possible to augment the compiler to keep a well-specified environment through the process of inlining, e.g. + +```fsharp + builder { for[dp] x in xs do ... } --> builder.For["for-debug-point"-->dp](xs, fun x -> ...) +``` + +And then there is some way to access this and attach to various control constructs: + +```fsharp +type MuBuilder() = + // Some builder implementation of "For" - let's say it prints at each iteration of the loop + member inline _.For(dp, xs, f) = + for["for-debug-point"] x in xs do + printfn "loop..." + f x +``` + +If carefully used this would allow reasonable debugging across multiple-phase boundaries. + +> NOTE: The use of library code to implement "async" and similar computation expressions also interacts badly with "Just My Code" debugging, see https://github.com/dotnet/fsharp/issues/5539 for example. + +> NOTE: The use of many functions to implement "async" and friends implements badly with "Step Into" and "Step Over" and related attributes, see for example https://github.com/dotnet/fsharp/issues/3359 + +### FeeFee and F00F00 debug points (Hidden and JustMyCodeWithNoSource) + +Some fragments of code use constructs generate calls and other IL code that should not have debug points and not participate in "Step Into", for example. These are generated in IlxGen as "FeeFee" debug points. See the [old blog post on this](https://docs.microsoft.com/en-us/dotnet/api/system.reflection.metadata.sequencepoint.hiddenline?view=net-5.0). + +> TODO: There is also the future prospect of generating `JustMyCodeWithNoSource` (0xF00F00) debug points but these are not yet emitted by F#. We should check what this is and when the C# compiler emits these. + +> NOTE: We always make space for a debug point at the head of each method by [emitting a FeeFee debug sequence point](https://github.com/dotnet/fsharp/blob/main/src/fsharp/IlxGen.fs#L1953). This may be immediately replaced by a "real" debug point [here](https://github.com/dotnet/fsharp/blob/main/src/fsharp/IlxGen.fs#L2019). + +## Generated code + +The F# compiler generates entire IL classes and methods for constructs such as records, closures, state machines and so on. Each time code is generated we must carefully consider what attributes and debug points are generated. + +### Generated "augment" methods for records, unions and structs + +We currently always emit a debug sequence point for all generated code coming from AugmentWithHashCompare.fs (also anything coming out of optimization etc.) The `SPAlways` at https://github.com/dotnet/fsharp/blob/main/src/fsharp/IlxGen.fs#L4801 has the effect that a debug point based on the range of the method will always appear. + +### Generated "New*", "Is*", "Tag" etc. for unions + +Discriminated unions generate `NewXYZ`, `IsXYZ`, `Tag` etc. members and the implementations of these lay down debug points. See [here](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/ilx/EraseUnions.fs#L644) for the data that drives this and track back and forth to the production and consumption points of that data. + +These all get `CompilerGeneratedAttribute`, and `DebuggerNonUserCodeAttribute`, e.g. [here (permalink)](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/ilx/EraseUnions.fs#L635) + +> TODO: generating debug points for these appears wrong, being assessed at time of writing + +> TODO: we should also consider emitting `ExcludeFromCodeCoverageAttribute`, being assessed at time of writing + +### Generated closures for lambdas + +The debug codegen involved in closures is as follows: + +| Source | Construct | Debug Points | Attributes | +|:----------------|:------------------|:-------------|:-------------| +| (fun x -> ...) | Closure class | | | +| | `.ctor` method | [none](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/ilx/EraseClosures.fs#L584) | CompilerGenerated, DebuggerNonUserCode | +| | `Invoke` method | from body of closure | | +| generic local defn | Closure class | | | +| | `.ctor` method | [none](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/ilx/EraseClosures.fs#L486) | CompilerGenerated, DebuggerNonUserCode | +| | `Specialize` method | from body of closure | | +| Intermediate closure classes | For long curried closures `fun a b c d e f -> ...`. | See [here](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/ilx/EraseClosures.fs#L459) and [here](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/ilx/EraseClosures.fs#L543). | CompilerGenerated, DebuggerNonUserCode | + +> TODO: generating debug points for the intermediate closures appears wrong, this is being assessed at time of writing + +> TODO: we should also consider emitting `ExcludeFromCodeCoverageAttribute`, being assessed at time of writing + +### Generated state machines for `seq { .. }` + +Sequence expressions generate class implementations which resemble closures. + +The debug points recovered for the generated state machine code for `seq { ... }` is covered up above. The other codegen is as follows: + +| Source | Construct | Debug Points | Attributes | +|:----------------|:------------------|:-------------|:-------------| +| seq { ... } | State machine class | | "Closure" | +| | `.ctor` method | none | [none](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/IlxGen.fs#L5150) | +| | `GetFreshEnumerator` | [none](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/IlxGen.fs#L5108) | CompilerGenerated, DebuggerNonUserCode | +| | `LastGenerated` | [none](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/IlxGen.fs#L5146-L5148) | CompilerGenerated, DebuggerNonUserCode | +| | `Close` | [none](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/IlxGen.fs#L5124-L5127) | none | +| | `get_CheckClose` | [none](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/IlxGen.fs#L5130-L5133) | none | +| | `GenerateNext` | from desugaring, and [here](https://github.com/dotnet/fsharp/blob/db2c9da8d1e76d11217d6da53a64253fd0df0246/src/fsharp/IlxGen.fs#L5136-L5143) | none | + +> NOTE: it appears from the code that extraneous debug points are not being generated, which is good, though should be checked + +> TODO: we should likely be generating attributes for the `Close` and `get_CheckClose` and `.ctor` methods + +> TODO: we should also consider emitting `ExcludeFromCodeCoverageAttribute`, being assessed at time of writing + +### Generated state machines for `task { .. }` + +[Resumable state machines](https://github.com/fsharp/fslang-design/blob/main/FSharp-6.0/FS-1087-resumable-code.md) used for `task { .. }` also generate struct implementations which resemble closures. + +The debug points recovered for the generated state machine code for `seq { ... }` is covered up above. The other codegen is as follows: + +| Source | Construct | Debug Points | Attributes | Notes | +|:----------------|:------------------|:-------------|:-------------|:------| +| task { ... } | State machine struct | | "Closure" | | +| | `.ctor` method | none | none | | +| | TBD | | | | + +> TODO: we should be generating attributes for some of these + +> TODO: we should assess that only the "MoveNext" method gets any debug points at all + +### Generated code for delegate constructions `Func(fun x y -> x + y)` + +A closure class is generated. + +### Generated code for constant-sized array and list expressions + +These are not generally problematic for debug. + +### Generated code for large constant arrays + +These are not generally problematic for debug. + +### Generated code for pattern matching + +The implementation is a little gnarly and complicated and has historically had glitches. + +### Generated code for conditionals and boolean logic + +Generally straight-forward. See for example [this proposed feature improvement](https://github.com/dotnet/fsharp/issues/11980) + +### Capture and closures + +Captured locals are available via the `this` pointer of the immediate closure. Un-captured locals are **not** available as things stand. See for example [this proposed feature improvement](https://github.com/dotnet/fsharp/issues/11262). + +Consider this code: + +```fsharp +let F() = + let x = 1 + let y = 2 + (fun () -> x + y) +``` + +Here `x` and `y` become closure fields of the closure class generated for the final lambda. When inspecting locals in the inner closure, the C# expression evaluator we rely on for Visual Studio takes local names like `x` and `y` and is happy to look them up via `this`. This means hovering over `x` correctly produces the value stored in `this.x`. + +For nested closures, values are implicitly re-captured, and again the captured locals will be available. + +However this doesn't work with "capture" from a class-defined "let" context. Consider the following variation: + +```fsharp +type C() = + let x = 1 + member _.M() = + let y = 2 + (fun () -> x + y) +``` + +Here the implicitly captured local is `y`, but `x` is **not** captured, instead it is implicitly rewritten by the F# compiler to `c.x` where `c` is the captured outer "this" pointer of the invocation of `M()`. This means that hovering over `x` does not produce a value. See [issue 3759](https://github.com/dotnet/fsharp/issues/3759). + +### Provided code + +Code provided by erasing type providers has all debugging points removed. It isn't possible to step into such code or if there are implicit debug points they will be the same range as the construct that was macro-expanded by the code erasure. + +> For example, a [provided if/then/else expression has no debug point](https://github.com/dotnet/fsharp/blob/main/src/fsharp/MethodCalls.fs#L1805) + +## Added code generation for better debugging + +We do some "extra" code gen to improve debugging. It is likely much of this could be removed if we had an expression evaluator for F#. + +### 'this' value + +For `member x.Foo() = ...` the implementation of the member adds a local variable `x` containing the `this` pointer from `ldarg.0`. THis means hovering over `x` in the method produces the right value, as does `x.Property` etc. + +### Pipeline debugging + +For pipeline debugging we emit extra locals for each stage of a pipe and debug points at each stage. + +See [pipeline debugging mini-spec](https://github.com/dotnet/fsharp/pull/11957). + +### Shadowed locals + +For shadowed locals we change the name of a local for the scope for which it is shadowed. + +See [shadowed locals mini-spec](https://github.com/dotnet/fsharp/pull/12018). + +### Discriminated union debug display text + +For discriminated union types and all implied subtypes we emit a `DebuggerDisplayAttrubte` and a private `__DebugDisplay()` method that uses `sprintf "%+0.8A" obj` to format the object. + +## Missing debug emit + +### Missing debug emit for PDBs + +Our PDB emit is missing considerable information: + +* Not emitted: [LocalConstants table](https://github.com/dotnet/fsharp/issues/12003) +* Not emitted: [Compilation options table](https://github.com/dotnet/fsharp/issues/12002) +* Not emitted: [Dynamic local variables table](https://github.com/dotnet/fsharp/issues/12001) +* Not emitted: [StateMachineMethod table and StateMachineHoistedLocalScopes table](https://github.com/dotnet/fsharp/issues/12000) +* Not emitted: [ImportScopes table](https://github.com/dotnet/fsharp/issues/1003) + +These are major holes in the F# experience. Some are required for things like hot-reload. + +### Missing design-time services + +Some design-time services are un-implemented by F#: + +* Unimplemented: [F# expression evaluator](https://github.com/dotnet/fsharp/issues/2544) +* Unimplemented: [Proximity expressions](https://github.com/dotnet/fsharp/issues/4271) (for Autos window) + +These are major holes in the F# experience and should be implemented. + +### Missing debug emit for F# Interactive + +For F# Interactive [we do not currently emit debug information for script code](https://github.com/dotnet/fsharp/issues/5457). This is because of a missing piece of functionality in the Reflection.Emit APIs, and means we have to change our approach to emitting code fragments in F# Interactive to no longer use dynamic assemblies. From 641ace3de536fe71c56f564ae5550ebe705cfbe6 Mon Sep 17 00:00:00 2001 From: Jamil Maqdis Anton Date: Wed, 17 Nov 2021 13:34:48 +0100 Subject: [PATCH 04/26] Small typo (#12412) --- src/fsharp/FSharp.Core/tasks.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/FSharp.Core/tasks.fs b/src/fsharp/FSharp.Core/tasks.fs index 3658a88afab..95c0391bfc2 100644 --- a/src/fsharp/FSharp.Core/tasks.fs +++ b/src/fsharp/FSharp.Core/tasks.fs @@ -2,7 +2,7 @@ // // Originally written in 2016 by Robert Peele (humbobst@gmail.com) // New operator-based overload resolution for F# 4.0 compatibility by Gustavo Leon in 2018. -// Revised for insertion into FSHarp.Core by Microsoft, 2019. +// Revised for insertion into FSharp.Core by Microsoft, 2019. // // Original notice: // To the extent possible under law, the author(s) have dedicated all copyright and related and neighboring rights From f0f9c17aa45ca963bd8bf69ce7c72883e4dafc3f Mon Sep 17 00:00:00 2001 From: "dotnet-maestro[bot]" <42748379+dotnet-maestro[bot]@users.noreply.github.com> Date: Wed, 17 Nov 2021 14:24:01 +0000 Subject: [PATCH 05/26] [main] Update dependencies from dotnet/arcade (#12310) Co-authored-by: dotnet-maestro[bot] Co-authored-by: Vlad Zarytovskii --- eng/Version.Details.xml | 4 +- eng/common/msbuild.ps1 | 1 + eng/common/post-build/symbols-validation.ps1 | 16 ++--- eng/common/sdl/execute-all-sdl-tools.ps1 | 2 +- eng/common/templates/job/execute-sdl.yml | 6 +- eng/common/templates/job/onelocbuild.yml | 5 +- eng/common/templates/job/source-build.yml | 15 +++-- .../templates/job/source-index-stage1.yml | 10 ++- eng/common/templates/jobs/jobs.yml | 4 +- eng/common/tools.ps1 | 57 ++++++++++------- eng/common/tools.sh | 62 ++++++++++--------- global.json | 2 +- 12 files changed, 105 insertions(+), 79 deletions(-) diff --git a/eng/Version.Details.xml b/eng/Version.Details.xml index ac39b142a08..83a27b3edd6 100644 --- a/eng/Version.Details.xml +++ b/eng/Version.Details.xml @@ -8,9 +8,9 @@ - + https://github.com/dotnet/arcade - 32ff2e3f45ae8fefed72a93ca17f4b01e106c7c9 + 53cc1bc2e555aa7aea95884575d22e21d63708cf diff --git a/eng/common/msbuild.ps1 b/eng/common/msbuild.ps1 index eea19cd8452..f041e5ddd95 100644 --- a/eng/common/msbuild.ps1 +++ b/eng/common/msbuild.ps1 @@ -6,6 +6,7 @@ Param( [switch] $ci, [switch] $prepareMachine, [switch] $excludePrereleaseVS, + [string] $msbuildEngine = $null, [Parameter(ValueFromRemainingArguments=$true)][String[]]$extraArgs ) diff --git a/eng/common/post-build/symbols-validation.ps1 b/eng/common/post-build/symbols-validation.ps1 index a4a92efbedf..cd2181bafa0 100644 --- a/eng/common/post-build/symbols-validation.ps1 +++ b/eng/common/post-build/symbols-validation.ps1 @@ -134,17 +134,17 @@ $CountMissingSymbols = { # Save the output and get diagnostic output $output = & $dotnetSymbolExe --symbols --modules $WindowsPdbVerificationParam $TargetServerParam $FullPath -o $SymbolsPath --diagnostics | Out-String - if (Test-Path $PdbPath) { - return 'PDB' + if ((Test-Path $PdbPath) -and (Test-path $SymbolPath)) { + return 'Module and PDB for Module' } - elseif (Test-Path $NGenPdb) { - return 'NGen PDB' + elseif ((Test-Path $NGenPdb) -and (Test-Path $PdbPath) -and (Test-Path $SymbolPath)) { + return 'Dll, PDB and NGen PDB' } - elseif (Test-Path $SODbg) { - return 'DBG for SO' + elseif ((Test-Path $SODbg) -and (Test-Path $SymbolPath)) { + return 'So and DBG for SO' } - elseif (Test-Path $DylibDwarf) { - return 'Dwarf for Dylib' + elseif ((Test-Path $DylibDwarf) -and (Test-Path $SymbolPath)) { + return 'Dylib and Dwarf for Dylib' } elseif (Test-Path $SymbolPath) { return 'Module' diff --git a/eng/common/sdl/execute-all-sdl-tools.ps1 b/eng/common/sdl/execute-all-sdl-tools.ps1 index 1157151f486..e5bef8ebd3a 100644 --- a/eng/common/sdl/execute-all-sdl-tools.ps1 +++ b/eng/common/sdl/execute-all-sdl-tools.ps1 @@ -124,7 +124,7 @@ try { Exec-BlockVerbosely { & $(Join-Path $PSScriptRoot 'run-sdl.ps1') ` -GuardianCliLocation $guardianCliLocation ` - -WorkingDirectory $workingDirectory ` + -WorkingDirectory $SourceDirectory ` -UpdateBaseline $UpdateBaseline ` -GdnFolder $gdnFolder } diff --git a/eng/common/templates/job/execute-sdl.yml b/eng/common/templates/job/execute-sdl.yml index 69eb67849d7..3aafc82e417 100644 --- a/eng/common/templates/job/execute-sdl.yml +++ b/eng/common/templates/job/execute-sdl.yml @@ -60,11 +60,7 @@ jobs: - name: GuardianPackagesConfigFile value: $(Build.SourcesDirectory)\eng\common\sdl\packages.config pool: - # To extract archives (.tar.gz, .zip), we need access to "tar", added in Windows 10/2019. - ${{ if eq(parameters.extractArchiveArtifacts, 'false') }}: - name: Hosted VS2017 - ${{ if ne(parameters.extractArchiveArtifacts, 'false') }}: - vmImage: windows-2019 + vmImage: windows-2019 steps: - checkout: self clean: true diff --git a/eng/common/templates/job/onelocbuild.yml b/eng/common/templates/job/onelocbuild.yml index e8bc77d2ebb..c4fc18b3ee7 100644 --- a/eng/common/templates/job/onelocbuild.yml +++ b/eng/common/templates/job/onelocbuild.yml @@ -4,7 +4,7 @@ parameters: # Optional: A defined YAML pool - https://docs.microsoft.com/en-us/azure/devops/pipelines/yaml-schema?view=vsts&tabs=schema#pool pool: - vmImage: vs2017-win2016 + vmImage: 'windows-2019' CeapexPat: $(dn-bot-ceapex-package-r) # PAT for the loc AzDO instance https://dev.azure.com/ceapex GithubPat: $(BotAccount-dotnet-bot-repo-PAT) @@ -12,6 +12,7 @@ parameters: SourcesDirectory: $(Build.SourcesDirectory) CreatePr: true AutoCompletePr: false + ReusePr: true UseLfLineEndings: true UseCheckedInLocProjectJson: false LanguageSet: VS_Main_Languages @@ -64,6 +65,8 @@ jobs: ${{ if eq(parameters.CreatePr, true) }}: isAutoCompletePrSelected: ${{ parameters.AutoCompletePr }} isUseLfLineEndingsSelected: ${{ parameters.UseLfLineEndings }} + ${{ if eq(parameters.RepoType, 'gitHub') }}: + isShouldReusePrSelected: ${{ parameters.ReusePr }} packageSourceAuth: patAuth patVariable: ${{ parameters.CeapexPat }} ${{ if eq(parameters.RepoType, 'gitHub') }}: diff --git a/eng/common/templates/job/source-build.yml b/eng/common/templates/job/source-build.yml index 5023d36dcb3..5cd5325d7b4 100644 --- a/eng/common/templates/job/source-build.yml +++ b/eng/common/templates/job/source-build.yml @@ -31,11 +31,6 @@ parameters: # container and pool. platform: {} - # The default VM host AzDO pool. This should be capable of running Docker containers: almost all - # source-build builds run in Docker, including the default managed platform. - defaultContainerHostPool: - vmImage: ubuntu-20.04 - jobs: - job: ${{ parameters.jobNamePrefix }}_${{ parameters.platform.name }} displayName: Source-Build (${{ parameters.platform.name }}) @@ -47,7 +42,15 @@ jobs: container: ${{ parameters.platform.container }} ${{ if eq(parameters.platform.pool, '') }}: - pool: ${{ parameters.defaultContainerHostPool }} + # The default VM host AzDO pool. This should be capable of running Docker containers: almost all + # source-build builds run in Docker, including the default managed platform. + pool: + ${{ if eq(variables['System.TeamProject'], 'public') }}: + name: NetCore1ESPool-Public + demands: ImageOverride -equals Build.Ubuntu.1804.Amd64.Open + ${{ if eq(variables['System.TeamProject'], 'internal') }}: + name: NetCore1ESPool-Internal + demands: ImageOverride -equals Build.Ubuntu.1804.Amd64 ${{ if ne(parameters.platform.pool, '') }}: pool: ${{ parameters.platform.pool }} diff --git a/eng/common/templates/job/source-index-stage1.yml b/eng/common/templates/job/source-index-stage1.yml index 1cc0c29e4fd..4af724eb1a9 100644 --- a/eng/common/templates/job/source-index-stage1.yml +++ b/eng/common/templates/job/source-index-stage1.yml @@ -5,8 +5,6 @@ parameters: sourceIndexBuildCommand: powershell -NoLogo -NoProfile -ExecutionPolicy Bypass -Command "eng/common/build.ps1 -restore -build -binarylog -ci" preSteps: [] binlogPath: artifacts/log/Debug/Build.binlog - pool: - vmImage: vs2017-win2016 condition: '' dependsOn: '' @@ -24,7 +22,13 @@ jobs: - ${{ if and(eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: - group: source-dot-net stage1 variables - pool: ${{ parameters.pool }} + pool: + ${{ if eq(variables['System.TeamProject'], 'public') }}: + name: NetCore1ESPool-Public + demands: ImageOverride -equals Build.Server.Amd64.VS2019.Open + ${{ if eq(variables['System.TeamProject'], 'internal') }}: + name: NetCore1ESPool-Internal + demands: ImageOverride -equals Build.Server.Amd64.VS2019 steps: - ${{ each preStep in parameters.preSteps }}: - ${{ preStep }} diff --git a/eng/common/templates/jobs/jobs.yml b/eng/common/templates/jobs/jobs.yml index a1f8fce96ca..8dd1fdbd144 100644 --- a/eng/common/templates/jobs/jobs.yml +++ b/eng/common/templates/jobs/jobs.yml @@ -83,7 +83,7 @@ jobs: - ${{ if eq(parameters.enableSourceBuild, true) }}: - Source_Build_Complete pool: - vmImage: vs2017-win2016 + vmImage: 'windows-2019' runAsPublic: ${{ parameters.runAsPublic }} publishUsingPipelines: ${{ parameters.enablePublishUsingPipelines }} enablePublishBuildArtifacts: ${{ parameters.enablePublishBuildArtifacts }} @@ -96,4 +96,4 @@ jobs: dependsOn: - Asset_Registry_Publish pool: - vmImage: vs2017-win2016 + vmImage: 'windows-2019' diff --git a/eng/common/tools.ps1 b/eng/common/tools.ps1 index 44484289943..90b1f9fdcdb 100644 --- a/eng/common/tools.ps1 +++ b/eng/common/tools.ps1 @@ -301,31 +301,44 @@ function InstallDotNet([string] $dotnetRoot, if ($skipNonVersionedFiles) { $installParameters.SkipNonVersionedFiles = $skipNonVersionedFiles } if ($noPath) { $installParameters.NoPath = $True } - try { - & $installScript @installParameters - } - catch { - if ($runtimeSourceFeed -or $runtimeSourceFeedKey) { - Write-Host "Failed to install dotnet from public location. Trying from '$runtimeSourceFeed'" - if ($runtimeSourceFeed) { $installParameters.AzureFeed = $runtimeSourceFeed } + $variations = @() + $variations += @($installParameters) - if ($runtimeSourceFeedKey) { - $decodedBytes = [System.Convert]::FromBase64String($runtimeSourceFeedKey) - $decodedString = [System.Text.Encoding]::UTF8.GetString($decodedBytes) - $installParameters.FeedCredential = $decodedString - } + $dotnetBuilds = $installParameters.Clone() + $dotnetbuilds.AzureFeed = "https://dotnetbuilds.azureedge.net/public" + $variations += @($dotnetBuilds) - try { - & $installScript @installParameters - } - catch { - Write-PipelineTelemetryError -Category 'InitializeToolset' -Message "Failed to install dotnet from custom location '$runtimeSourceFeed'." - ExitWithExitCode 1 - } + if ($runtimeSourceFeed) { + $runtimeSource = $installParameters.Clone() + $runtimeSource.AzureFeed = $runtimeSourceFeed + if ($runtimeSourceFeedKey) { + $decodedBytes = [System.Convert]::FromBase64String($runtimeSourceFeedKey) + $decodedString = [System.Text.Encoding]::UTF8.GetString($decodedBytes) + $runtimeSource.FeedCredential = $decodedString + } + $variations += @($runtimeSource) + } + + $installSuccess = $false + foreach ($variation in $variations) { + if ($variation | Get-Member AzureFeed) { + $location = $variation.AzureFeed } else { - Write-PipelineTelemetryError -Category 'InitializeToolset' -Message "Failed to install dotnet from public location." - ExitWithExitCode 1 + $location = "public location"; + } + Write-Host "Attempting to install dotnet from $location." + try { + & $installScript @variation + $installSuccess = $true + break } + catch { + Write-Host "Failed to install dotnet from $location." + } + } + if (-not $installSuccess) { + Write-PipelineTelemetryError -Category 'InitializeToolset' -Message "Failed to install dotnet from any of the specified locations." + ExitWithExitCode 1 } } @@ -887,7 +900,7 @@ function Try-LogClientIpAddress() Write-Host "Attempting to log this client's IP for Azure Package feed telemetry purposes" try { - $result = Invoke-WebRequest -Uri "http://co1.msedge.net/fdv2/diagnostics.aspx" -UseBasicParsing + $result = Invoke-WebRequest -Uri "http://co1r5a.msedge.net/fdv2/diagnostics.aspx" -UseBasicParsing $lines = $result.Content.Split([Environment]::NewLine) $socketIp = $lines | Select-String -Pattern "^Socket IP:.*" Write-Host $socketIp diff --git a/eng/common/tools.sh b/eng/common/tools.sh index 6a4871ef72b..dd7030ff538 100755 --- a/eng/common/tools.sh +++ b/eng/common/tools.sh @@ -188,28 +188,29 @@ function InstallDotNet { GetDotNetInstallScript "$root" local install_script=$_GetDotNetInstallScript - local archArg='' + local installParameters=(--version $version --install-dir "$root") + if [[ -n "${3:-}" ]] && [ "$3" != 'unset' ]; then - archArg="--architecture $3" + installParameters+=(--architecture $3) fi - local runtimeArg='' if [[ -n "${4:-}" ]] && [ "$4" != 'sdk' ]; then - runtimeArg="--runtime $4" + installParameters+=(--runtime $4) fi - local skipNonVersionedFilesArg="" if [[ "$#" -ge "5" ]] && [[ "$5" != 'false' ]]; then - skipNonVersionedFilesArg="--skip-non-versioned-files" + installParameters+=(--skip-non-versioned-files) fi - bash "$install_script" --version $version --install-dir "$root" $archArg $runtimeArg $skipNonVersionedFilesArg || { - local exit_code=$? - echo "Failed to install dotnet SDK from public location (exit code '$exit_code')." - local runtimeSourceFeed='' - if [[ -n "${6:-}" ]]; then - runtimeSourceFeed="--azure-feed $6" - fi + local variations=() # list of variable names with parameter arrays in them + + local public_location=("${installParameters[@]}") + variations+=(public_location) + + local dotnetbuilds=("${installParameters[@]}" --azure-feed "https://dotnetbuilds.azureedge.net/public") + variations+=(dotnetbuilds) - local runtimeSourceFeedKey='' + if [[ -n "${6:-}" ]]; then + variations+=(private_feed) + local private_feed=("${installParameters[@]}" --azure-feed $6) if [[ -n "${7:-}" ]]; then # The 'base64' binary on alpine uses '-d' and doesn't support '--decode' # '-d'. To work around this, do a simple detection and switch the parameter @@ -219,22 +220,27 @@ function InstallDotNet { decodeArg="-d" fi decodedFeedKey=`echo $7 | base64 $decodeArg` - runtimeSourceFeedKey="--feed-credential $decodedFeedKey" + private_feed+=(--feed-credential $decodedFeedKey) fi + fi - if [[ -n "$runtimeSourceFeed" || -n "$runtimeSourceFeedKey" ]]; then - bash "$install_script" --version $version --install-dir "$root" $archArg $runtimeArg $skipNonVersionedFilesArg $runtimeSourceFeed $runtimeSourceFeedKey || { - local exit_code=$? - Write-PipelineTelemetryError -category 'InitializeToolset' "Failed to install dotnet SDK from custom location '$runtimeSourceFeed' (exit code '$exit_code')." - ExitWithExitCode $exit_code - } - else - if [[ $exit_code != 0 ]]; then - Write-PipelineTelemetryError -category 'InitializeToolset' "Failed to install dotnet SDK from public location (exit code '$exit_code')." - fi - ExitWithExitCode $exit_code + local installSuccess=0 + for variationName in "${variations[@]}"; do + local name="$variationName[@]" + local variation=("${!name}") + echo "Attempting to install dotnet from $variationName." + bash "$install_script" "${variation[@]}" && installSuccess=1 + if [[ "$installSuccess" -eq 1 ]]; then + break fi - } + + echo "Failed to install dotnet from $variationName." + done + + if [[ "$installSuccess" -eq 0 ]]; then + Write-PipelineTelemetryError -category 'InitializeToolset' "Failed to install dotnet SDK from any of the specified locations." + ExitWithExitCode 1 + fi } function with_retries { @@ -402,7 +408,7 @@ function StopProcesses { function TryLogClientIpAddress () { echo 'Attempting to log this client''s IP for Azure Package feed telemetry purposes' if command -v curl > /dev/null; then - curl -s 'http://co1.msedge.net/fdv2/diagnostics.aspx' | grep ' IP: ' || true + curl -s 'http://co1r5a.msedge.net/fdv2/diagnostics.aspx' | grep ' IP: ' || true fi } diff --git a/global.json b/global.json index 33ea41a7b02..274f29b114c 100644 --- a/global.json +++ b/global.json @@ -14,7 +14,7 @@ } }, "msbuild-sdks": { - "Microsoft.DotNet.Arcade.Sdk": "7.0.0-beta.21527.1", + "Microsoft.DotNet.Arcade.Sdk": "7.0.0-beta.21566.10", "Microsoft.DotNet.Helix.Sdk": "2.0.0-beta.19069.2" } } \ No newline at end of file From 9cba74db3a0f4fd6d631231506e191f113a20b8b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 19 Nov 2021 11:51:32 +0000 Subject: [PATCH 06/26] Fix 12384: non-nested direct mutrec bindings (#12395) * fix non-nested mutrec bindings * fix non-nested mutrec bindings * fix non-nested mutrec bindings * fix non-nested mutrec bindings --- src/fsharp/IlxGen.fs | 22 +++- tests/fsharp/core/letrec/test.fsx | 164 ++++++++++++++++++++++++++++++ 2 files changed, 184 insertions(+), 2 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 98e51366088..03f891e6870 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -7552,8 +7552,26 @@ and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x = GenExnDef cenv cgbuf.mgbuf eenvinner m tc else GenTypeDef cenv cgbuf.mgbuf lazyInitInfo eenvinner m tc - for mbind in mbinds do - GenModuleBinding cenv cgbuf qname lazyInitInfo eenvinner m mbind + + // Generate chunks of non-nested bindings together to allow recursive fixups. + let mutable bindsRemaining = mbinds + while not bindsRemaining.IsEmpty do + match bindsRemaining with + | ModuleOrNamespaceBinding.Binding _ :: _ -> + let recBinds = + bindsRemaining + |> List.takeWhile (function ModuleOrNamespaceBinding.Binding _ -> true | _ -> false) + |> List.map (function ModuleOrNamespaceBinding.Binding recBind -> recBind | _ -> failwith "unexpected") + let otherBinds = + bindsRemaining + |> List.skipWhile (function ModuleOrNamespaceBinding.Binding _ -> true | _ -> false) + GenLetRecBindings cenv cgbuf eenv (recBinds, m) + bindsRemaining <- otherBinds + | (ModuleOrNamespaceBinding.Module _ as mbind) :: rest -> + GenModuleBinding cenv cgbuf qname lazyInitInfo eenvinner m mbind + bindsRemaining <- rest + | [] -> failwith "unreachable" + eenvinner | TMDefLet(bind, _) -> diff --git a/tests/fsharp/core/letrec/test.fsx b/tests/fsharp/core/letrec/test.fsx index 4c746116db1..cb9a6840981 100644 --- a/tests/fsharp/core/letrec/test.fsx +++ b/tests/fsharp/core/letrec/test.fsx @@ -643,6 +643,170 @@ module Test3 = test "vwekjwve95" (tag()) 2 test "vwekjwve96" (tag()) 3 +module Test12384 = + type Node = + { + Next: Node + Value: int + } + + let rec one = + { + Next = two + Value = 1 + } + + and two = + { + Next = one + Value = 2 + } + printfn "%A" one + printfn "%A" two + test "cweewlwne1" one.Value 1 + test "cweewlwne2" one.Next.Value 2 + test "cweewlwne3" one.Next.Next.Value 1 + test "cweewlwne4" two.Value 2 + test "cweewlwne5" two.Next.Value 1 + test "cweewlwne6" two.Next.Next.Value 2 + +module Test12384b = + type Node = + { + Next: Node + Value: int + } + + let rec one = + { + Next = two + Value = 1 + } + + and two = + { + Next = one + Value = 2 + } + // Also test the case where the two recursive bindings occur with a nested module after + module M = + let f x = x + 1 + + printfn "%A" one + printfn "%A" two + test "cweewlwne1a" one.Value 1 + test "cweewlwne2a" one.Next.Value 2 + test "cweewlwne3a" one.Next.Next.Value 1 + test "cweewlwne4a" two.Value 2 + test "cweewlwne5a" two.Next.Value 1 + test "cweewlwne6a" two.Next.Next.Value 2 + +module rec Test12384c = + type Node = + { + Next: Node + Value: int + } + + let one = + { + Next = two + Value = 1 + } + + let two = + { + Next = one + Value = 2 + } + // Also test the case where the two recursive bindings occur with a nested module after + module M = + let f x = x + 1 + + printfn "%A" one + printfn "%A" two + test "cweewlwne1b" one.Value 1 + test "cweewlwne2b" one.Next.Value 2 + test "cweewlwne3b" one.Next.Next.Value 1 + test "cweewlwne4b" two.Value 2 + test "cweewlwne5b" two.Next.Value 1 + test "cweewlwne6b" two.Next.Next.Value 2 + + +//Note, this case doesn't initialize successfully because of the intervening module. Tracked by #12384 + +(* +module rec Test12384d = + type Node = + { + Next: Node + Value: int + } + + let one = + { + Next = two + Value = 1 + } + + // An intervening module declaration + module M = + let x() = one + + let two = + { + Next = one + Value = 2 + } + + printfn "%A" one + printfn "%A" two + test "cweewlwne1b" one.Value 1 + test "cweewlwne2b" one.Next.Value 2 + test "cweewlwne3b" one.Next.Next.Value 1 + test "cweewlwne1b" (M.x()).Value 1 + test "cweewlwne2b" (M.x()).Next.Value 2 + test "cweewlwne3b" (M.x()).Next.Next.Value 1 + test "cweewlwne4b" two.Value 2 + test "cweewlwne5b" two.Next.Value 1 + test "cweewlwne6b" two.Next.Next.Value 2 +*) + +module rec Test12384e = + type Node = + { + Next: Node + Value: int + } + + let one = + { + Next = two + Value = 1 + } + + // An intervening type declaration + type M() = + static member X() = one + + let two = + { + Next = one + Value = 2 + } + + printfn "%A" one + printfn "%A" two + test "cweewlwne1b" one.Value 1 + test "cweewlwne2b" one.Next.Value 2 + test "cweewlwne3b" one.Next.Next.Value 1 + test "cweewlwne1b" (M.X()).Value 1 + test "cweewlwne2b" (M.X()).Next.Value 2 + test "cweewlwne3b" (M.X()).Next.Next.Value 1 + test "cweewlwne4b" two.Value 2 + test "cweewlwne5b" two.Next.Value 1 + test "cweewlwne6b" two.Next.Next.Value 2 + #if TESTS_AS_APP let RUN() = !failures #else From 57ef580b66fa8b1ffa8c68034bfbb301e6792889 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 19 Nov 2021 13:00:30 +0000 Subject: [PATCH 07/26] add fantomas tool to repo (#12403) --- .config/dotnet-tools.json | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 .config/dotnet-tools.json diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json new file mode 100644 index 00000000000..981fafc4d56 --- /dev/null +++ b/.config/dotnet-tools.json @@ -0,0 +1,12 @@ +{ + "version": 1, + "isRoot": true, + "tools": { + "fantomas-tool": { + "version": "4.6.0-alpha-007", + "commands": [ + "fantomas" + ] + } + } +} \ No newline at end of file From 76e65ac5b724fe23bcb47ae90c868c724df20714 Mon Sep 17 00:00:00 2001 From: Florian Verdonck Date: Fri, 19 Nov 2021 18:24:16 +0100 Subject: [PATCH 08/26] Add with keyword to Syntax tree (#12400) * Add try and with keywords to SynExpr.TryWith. * Add match and with keywords to SynExpr.Match. * Add match and with keywords to SynExpr.MatchBang. * Add with keyword to SynExpr.ObjExpr and SynInterfaceImpl. * Add with keyword to SynTypeDefnKind.Augmentation. * Add with keyword to SynMemberDefn.Interface. * Add with keyword to SynTypeDefnSig and SynExceptionSig. * Add with keyword to SynMemberDefn.AutoProperty. * Add with keyword to SynValSig. * Add with keyword to SynPat.LongId for SynMemberDefn.Member. * Corrected FSharpCodeAnalysisExtensions.fs * Fix failing unit tests. * Revert some named pattern matches. Renamed Range to range. Add comment above PropertyKeyword. * Correct failing type check tests. * Renamed unused values in pattern match. --- src/fsharp/CheckComputationExpressions.fs | 20 +- src/fsharp/CheckDeclarations.fs | 34 +- src/fsharp/CheckExpressions.fs | 22 +- src/fsharp/SyntaxTree.fs | 63 ++- src/fsharp/SyntaxTree.fsi | 62 +- src/fsharp/SyntaxTreeOps.fs | 22 +- src/fsharp/pars.fsy | 528 +++++++++--------- src/fsharp/service/FSharpParseFileResults.fs | 16 +- .../service/ServiceInterfaceStubGenerator.fs | 12 +- src/fsharp/service/ServiceNavigation.fs | 26 +- src/fsharp/service/ServiceParseTreeWalk.fs | 16 +- src/fsharp/service/ServiceParsedInputOps.fs | 38 +- src/fsharp/service/ServiceStructure.fs | 18 +- src/fsharp/service/ServiceXmlDocParser.fs | 6 +- ...erService.SurfaceArea.netstandard.expected | 77 ++- tests/fsharp/typecheck/sigs/neg103.bsl | 2 +- tests/fsharp/typecheck/sigs/neg103.vsbsl | 2 +- tests/fsharp/typecheck/sigs/neg104.vsbsl | 4 +- tests/fsharp/typecheck/sigs/neg59.bsl | 4 +- .../E_MismatchedConditionalBranches01.fs | 2 +- .../E_MismatchedConditionalBranches02.fs | 2 +- tests/service/ParserTests.fs | 20 +- tests/service/Symbols.fs | 292 ++++++++++ .../Common/FSharpCodeAnalysisExtensions.fs | 2 +- 24 files changed, 847 insertions(+), 443 deletions(-) diff --git a/src/fsharp/CheckComputationExpressions.fs b/src/fsharp/CheckComputationExpressions.fs index ade713ea80f..03816ca3aa0 100644 --- a/src/fsharp/CheckComputationExpressions.fs +++ b/src/fsharp/CheckComputationExpressions.fs @@ -1283,16 +1283,14 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter // Build the 'Bind' call Some (transBind q varSpace bindRange "Bind" [mergedSources] consumePat letSpBind innerComp translatedCtxt) - | SynExpr.Match (spMatch, expr, clauses, m) -> - let mMatch = match spMatch with DebugPointAtBinding.Yes mMatch -> mMatch | _ -> m + | SynExpr.Match (mMatch, spMatch, expr, mWith, clauses, m) -> if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch)) let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, arrow, innerComp, patm, sp)) -> SynMatchClause(pat, cond, arrow, transNoQueryOps innerComp, patm, sp)) - Some(translatedCtxt (SynExpr.Match (spMatch, expr, clauses, m))) + Some(translatedCtxt (SynExpr.Match (mMatch, spMatch, expr, mWith, clauses, m))) // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...)) - | SynExpr.MatchBang (spMatch, expr, clauses, m) -> + | SynExpr.MatchBang (mMatch, spMatch, expr, _mWith, clauses, _m) -> let matchExpr = mkSourceExpr expr - let mMatch = match spMatch with DebugPointAtBinding.Yes mMatch -> mMatch | _ -> m if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch)) if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mMatch ad "Bind" builderTy) then @@ -1304,7 +1302,7 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter // TODO: consider allowing translation to BindReturn Some(translatedCtxt (mkSynCall "Bind" mMatch [matchExpr; consumeExpr])) - | SynExpr.TryWith (innerComp, _mTryToWith, clauses, _mWithToLast, mTryToLast, spTry, _spWith) -> + | SynExpr.TryWith (_mTry, innerComp, _mTryToWith, _mWith, clauses, _mWithToLast, mTryToLast, spTry, _spWith) -> let mTry = match spTry with DebugPointAtTry.Yes m -> m.NoteDebugPoint(RangeDebugPointKind.Try) | _ -> mTryToLast if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(), mTry)) @@ -1536,7 +1534,7 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter and convertSimpleReturnToExpr varSpace innerComp = match innerComp with | SynExpr.YieldOrReturn ((false, _), returnExpr, _) -> Some (returnExpr, None) - | SynExpr.Match (spMatch, expr, clauses, m) -> + | SynExpr.Match (mMatch, spMatch, mWith, expr, clauses, m) -> let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, arrow, innerComp2, patm, sp)) -> match convertSimpleReturnToExpr varSpace innerComp2 with @@ -1544,7 +1542,7 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter | Some (_, Some _) -> None // custom op on branch = failure | Some (innerExpr2, None) -> Some (SynMatchClause(pat, cond, arrow, innerExpr2, patm, sp))) if clauses |> List.forall Option.isSome then - Some (SynExpr.Match (spMatch, expr, (clauses |> List.map Option.get), m), None) + Some (SynExpr.Match (mMatch, spMatch, mWith, expr, (clauses |> List.map Option.get), m), None) else None @@ -1608,10 +1606,10 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter isSimpleExpr thenComp && (match elseCompOpt with None -> true | Some c -> isSimpleExpr c) | SynExpr.LetOrUse (_, _, _, innerComp, _) -> isSimpleExpr innerComp | SynExpr.LetOrUseBang _ -> false - | SynExpr.Match (_, _, clauses, _) -> + | SynExpr.Match (clauses=clauses) -> clauses |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> isSimpleExpr innerComp) | SynExpr.MatchBang _ -> false - | SynExpr.TryWith (innerComp, _, clauses, _, _, _, _) -> + | SynExpr.TryWith (tryExpr=innerComp; withCases=clauses) -> isSimpleExpr innerComp && clauses |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> isSimpleExpr clauseComp) | SynExpr.YieldOrReturnFrom _ -> false @@ -1870,7 +1868,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = | SynExpr.LetOrUseBang (range=m) -> error(Error(FSComp.SR.tcUseForInSequenceExpression(), m)) - | SynExpr.Match (spMatch, expr, clauses, _) -> + | SynExpr.Match (_mMatch, spMatch, expr, _mWith, clauses, _m) -> let inputExpr, matchty, tpenv = TcExprOfUnknownType cenv env tpenv expr let tclauses, tpenv = (tpenv, clauses) ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, _, innerComp, _, sp)) -> diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 1b9a15b2c6f..623ae199e7b 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -2383,7 +2383,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial bindsm scopem mutRecNSInfo (env let (MutRecDefnsPhase2DataForTycon(_, _, declKind, tcref, _, _, declaredTyconTypars, members, _, _, _)) = tyconMembersData let overridesOK = DeclKind.CanOverrideOrImplement declKind members |> List.collect (function - | SynMemberDefn.Interface(ity, defnOpt, _) -> + | SynMemberDefn.Interface(interfaceType=ity; members=defnOpt) -> let _, ty = if tcref.Deref.IsExceptionDecl then [], g.exn_ty else generalizeTyconRef tcref let m = ity.Range if tcref.IsTypeAbbrev then error(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveInterfaceDeclaration(), m)) @@ -3013,7 +3013,7 @@ module TcExceptionDeclarations = let binds3 = AddAugmentationDeclarations.AddGenericEqualityBindings cenv envFinal exnc binds1 @ binds2flat @ binds3, exnc, envFinal - let TcExnSignature cenv envInitial parent tpenv (SynExceptionSig(core, aug, _), scopem) = + let TcExnSignature cenv envInitial parent tpenv (SynExceptionSig(exnRepr=core; members=aug), scopem) = let binds, exnc = TcExnDefnCore cenv envInitial parent core let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons cenv.g cenv.amap scopem [exnc] envInitial) exnc let ecref = mkLocalEntityRef exnc @@ -3191,7 +3191,7 @@ module EstablishTypeDefinitionCores = for SynTypeDefn(typeInfo=SynComponentInfo(typeParams=TyparDecls typars; longId=ids); typeRepr=trepr) in typeSpecs do if isNil typars then match trepr with - | SynTypeDefnRepr.ObjectModel(SynTypeDefnKind.Augmentation, _, _) -> () + | SynTypeDefnRepr.ObjectModel(kind=SynTypeDefnKind.Augmentation _) -> () | _ -> yield (List.last ids).idText | _ -> () ] |> set @@ -3201,7 +3201,7 @@ module EstablishTypeDefinitionCores = [ for def in defs do match def with | SynModuleSigDecl.Types (typeSpecs, _) -> - for SynTypeDefnSig(SynComponentInfo(typeParams=TyparDecls typars; longId=ids), _, trepr, extraMembers, _) in typeSpecs do + for SynTypeDefnSig(typeInfo=SynComponentInfo(typeParams=TyparDecls typars; longId=ids); typeRepr=trepr; members=extraMembers) in typeSpecs do if isNil typars then match trepr with | SynTypeDefnSigRepr.Simple(SynTypeDefnSimpleRepr.None _, _) when not (isNil extraMembers) -> () @@ -4081,7 +4081,7 @@ module EstablishTypeDefinitionCores = let abstractSlots = [ for valSpfn, memberFlags in slotsigs do - let (SynValSig(_, _, _, _, _valSynData, _, _, _, _, _, m)) = valSpfn + let (SynValSig(range=m)) = valSpfn CheckMemberFlags None NewSlotsOK OverridesOK memberFlags m @@ -4593,7 +4593,7 @@ module TcDeclarations = declKind, tcref, typars - let private isAugmentationTyconDefnRepr = function SynTypeDefnSimpleRepr.General(SynTypeDefnKind.Augmentation, _, _, _, _, _, _, _) -> true | _ -> false + let private isAugmentationTyconDefnRepr = function SynTypeDefnSimpleRepr.General(kind=SynTypeDefnKind.Augmentation _) -> true | _ -> false let private isAutoProperty = function SynMemberDefn.AutoProperty _ -> true | _ -> false let private isMember = function SynMemberDefn.Member _ -> true | _ -> false let private isImplicitCtor = function SynMemberDefn.ImplicitCtor _ -> true | _ -> false @@ -4669,12 +4669,12 @@ module TcDeclarations = /// body = members /// where members contain methods/overrides, also implicit ctor, inheritCall and local definitions. let rec private SplitTyconDefn (SynTypeDefn(typeInfo=synTyconInfo;typeRepr=trepr; members=extraMembers)) = - let implements1 = List.choose (function SynMemberDefn.Interface (ty, _, _) -> Some(ty, ty.Range) | _ -> None) extraMembers + let implements1 = List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) extraMembers match trepr with | SynTypeDefnRepr.ObjectModel(kind, cspec, m) -> CheckMembersForm cspec let fields = cspec |> List.choose (function SynMemberDefn.ValField (f, _) -> Some f | _ -> None) - let implements2 = cspec |> List.choose (function SynMemberDefn.Interface (ty, _, _) -> Some(ty, ty.Range) | _ -> None) + let implements2 = cspec |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) let inherits = cspec |> List.choose (function | SynMemberDefn.Inherit (ty, idOpt, m) -> Some(ty, m, idOpt) @@ -4708,7 +4708,7 @@ module TcDeclarations = let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> true | _ -> false) let mLetPortion = synExpr.Range let fldId = ident (CompilerGeneratedName id.idText, mLetPortion) - let headPat = SynPat.LongIdent (LongIdentWithDots([fldId], []), None, Some noInferredTypars, SynArgPats.Pats [], None, mLetPortion) + let headPat = SynPat.LongIdent (LongIdentWithDots([fldId], []), None, None, Some noInferredTypars, SynArgPats.Pats [], None, mLetPortion) let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) let isMutable = match propKind with @@ -4720,7 +4720,7 @@ module TcDeclarations = [(SynMemberDefn.LetBindings ([binding], isStatic, false, mWholeAutoProp))] - | SynMemberDefn.Interface (_, Some membs, _) -> membs |> List.collect preAutoProps + | SynMemberDefn.Interface (members=Some membs) -> membs |> List.collect preAutoProps | SynMemberDefn.LetBindings _ | SynMemberDefn.ImplicitCtor _ | SynMemberDefn.Open _ @@ -4736,7 +4736,7 @@ module TcDeclarations = let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true) let fldId = ident (CompilerGeneratedName id.idText, mMemberPortion) let headPatIds = if isStatic then [id] else [ident ("__", mMemberPortion);id] - let headPat = SynPat.LongIdent (LongIdentWithDots(headPatIds, []), None, Some noInferredTypars, SynArgPats.Pats [], None, mMemberPortion) + let headPat = SynPat.LongIdent (LongIdentWithDots(headPatIds, []), None, None, Some noInferredTypars, SynArgPats.Pats [], None, mMemberPortion) match propKind, mGetSetOpt with | SynMemberKind.PropertySet, Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), m)) @@ -4761,16 +4761,16 @@ module TcDeclarations = | SynMemberKind.PropertyGetSet -> let setter = let vId = ident("v", mMemberPortion) - let headPat = SynPat.LongIdent (LongIdentWithDots(headPatIds, []), None, Some noInferredTypars, SynArgPats.Pats [mkSynPatVar None vId], None, mMemberPortion) + let headPat = SynPat.LongIdent (LongIdentWithDots(headPatIds, []), None, None, Some noInferredTypars, SynArgPats.Pats [mkSynPatVar None vId], None, mMemberPortion) let rhsExpr = mkSynAssign (SynExpr.Ident fldId) (SynExpr.Ident vId) //let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, None, rhsExpr, rhsExpr.Range, [], [], Some (memberFlags SynMemberKind.PropertySet)) SynMemberDefn.Member (binding, mMemberPortion) yield setter | _ -> ()] - | SynMemberDefn.Interface (ty, Some membs, m) -> + | SynMemberDefn.Interface (ty, mWith, Some membs, m) -> let membs' = membs |> List.collect postAutoProps - [SynMemberDefn.Interface (ty, Some membs', m)] + [SynMemberDefn.Interface (ty, mWith, Some membs', m)] | SynMemberDefn.LetBindings _ | SynMemberDefn.ImplicitCtor _ | SynMemberDefn.Open _ @@ -4785,7 +4785,7 @@ module TcDeclarations = let isConcrete = members |> List.exists (function | SynMemberDefn.Member(SynBinding(valData = SynValData(Some memberFlags, _, _)), _) -> not memberFlags.IsDispatchSlot - | SynMemberDefn.Interface (_, defOpt, _) -> Option.isSome defOpt + | SynMemberDefn.Interface (members=defOpt) -> Option.isSome defOpt | SynMemberDefn.LetBindings _ -> true | SynMemberDefn.ImplicitCtor _ -> true | SynMemberDefn.ImplicitInherit _ -> true @@ -5222,10 +5222,10 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d let decls = [ MutRecShape.Open (MutRecDataForOpen(target, m, moduleRange, ref [])) ] decls, (openOk, moduleAbbrevOk) - | SynModuleSigDecl.Exception (SynExceptionSig(exnRepr, members, _), _) -> + | SynModuleSigDecl.Exception (exnSig=SynExceptionSig(exnRepr=exnRepr; withKeyword=withKeyword; members=members)) -> let ( SynExceptionDefnRepr(synAttrs, SynUnionCase(_, id, _args, _, _, _), _, doc, vis, m)) = exnRepr let compInfo = SynComponentInfo(synAttrs, None, [], [id], doc, false, vis, id.idRange) - let decls = [ MutRecShape.Tycon(SynTypeDefnSig.SynTypeDefnSig(compInfo, None, SynTypeDefnSigRepr.Exception exnRepr, members, m)) ] + let decls = [ MutRecShape.Tycon(SynTypeDefnSig.SynTypeDefnSig(compInfo, None, SynTypeDefnSigRepr.Exception exnRepr, withKeyword, members, m)) ] decls, (false, false) | SynModuleSigDecl.Val (vspec, _) -> diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 3bf0cb89921..01497098333 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -2428,7 +2428,7 @@ module BindingNormalization = // of available items, to the point that you can't even define a function with the same name as an existing union case. match pat with | SynPat.FromParseError(p, _) -> normPattern p - | SynPat.LongIdent (LongIdentWithDots(longId, _), toolId, tyargs, SynArgPats.Pats args, vis, m) -> + | SynPat.LongIdent (LongIdentWithDots(longId, _), _, toolId, tyargs, SynArgPats.Pats args, vis, m) -> let typars = match tyargs with None -> inferredTyparDecls | Some typars -> typars match memberFlagsOpt with | None -> @@ -4009,7 +4009,7 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv memSpfn m = /// Check a value specification, e.g. in a signature, interface declaration or a constraint and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv valSpfn attrs = - let (SynValSig(_, id, ValTyparDecls (synTypars, synTyparConstraints, _), ty, valSynInfo, _, _, _, _, _, m)) = valSpfn + let (SynValSig(ident=id; explicitValDecls=ValTyparDecls (synTypars, synTyparConstraints, _); synType=ty; arity=valSynInfo; range=m)) = valSpfn let declaredTypars = TcTyparDecls cenv env synTypars let (ContainerInfo(altActualParent, tcrefContainerInfo)) = containerInfo let enclosingDeclaredTypars, memberContainerInfo, thisTyOpt, declKind = @@ -4962,7 +4962,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p let pats', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) (List.map (fun _ -> ty) pats) pats (fun values -> TPat_conjs(List.map (fun f -> f values) pats', m)), acc - | SynPat.LongIdent (LongIdentWithDots(longId, _), _, tyargs, args, vis, m) -> + | SynPat.LongIdent (longDotId=LongIdentWithDots(longId, _); typarDecls=tyargs; argPats=args; accessibility=vis; range=m) -> if Option.isSome tyargs then errorR(Error(FSComp.SR.tcInvalidTypeArgumentUsage(), m)) let warnOnUpperForId = match args with @@ -4994,7 +4994,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p | SynPat.Const (c, m) -> SynExpr.Const (c, m) | SynPat.Named (id, _, None, _) -> SynExpr.Ident id | SynPat.Typed (p, cty, m) -> SynExpr.Typed (convSynPatToSynExpr p, cty, m) - | SynPat.LongIdent (LongIdentWithDots(longId, dotms) as lidwd, _, _tyargs, args, None, m) -> + | SynPat.LongIdent (longDotId=LongIdentWithDots(longId, dotms) as lidwd; argPats=args; accessibility=None; range=m) -> let args = match args with SynArgPats.Pats args -> args | _ -> failwith "impossible: active patterns can be used only with SynConstructorArgs.Pats" let e = if dotms.Length = longId.Length then @@ -5657,7 +5657,7 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = | SynExpr.Lambda _ -> TcIteratedLambdas cenv true env overallTy Set.empty tpenv synExpr - | SynExpr.Match (spMatch, synInputExpr, synClauses, _m) -> + | SynExpr.Match (_mMatch, spMatch, synInputExpr, _mWith, synClauses, _m) -> let inputExpr, inputTy, tpenv = TcExprOfUnknownType cenv env tpenv synInputExpr let mInputExpr = inputExpr.Range @@ -5719,7 +5719,7 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = TcNewExpr cenv env tpenv objTy (Some synObjTy.Range) superInit arg mNewExpr ) - | SynExpr.ObjExpr (synObjTy, argopt, binds, extraImpls, mNewExpr, m) -> + | SynExpr.ObjExpr (synObjTy, argopt, _mWith, binds, extraImpls, mNewExpr, m) -> TcExprObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, mNewExpr, m) | SynExpr.Record (inherits, optOrigExpr, flds, mWholeExpr) -> @@ -5752,7 +5752,7 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = | SynExpr.LetOrUse _ -> TcLinearExprs (TcExprThatCanBeCtorBody cenv) cenv env overallTy tpenv false synExpr (fun x -> x) - | SynExpr.TryWith (synBodyExpr, _mTryToWith, synWithClauses, mWithToLast, mTryToLast, spTry, spWith) -> + | SynExpr.TryWith (_mTry, synBodyExpr, _mTryToWith, _mWith, synWithClauses, mWithToLast, mTryToLast, spTry, spWith) -> TcExprTryWith cenv overallTy env tpenv (synBodyExpr, _mTryToWith, synWithClauses, mWithToLast, mTryToLast, spTry, spWith) | SynExpr.TryFinally (synBodyExpr, synFinallyExpr, mTryToLast, spTry, spFinally) -> @@ -5844,7 +5844,7 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = | SynExpr.LetOrUseBang (range=m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) - | SynExpr.MatchBang (_, _, _, m) -> + | SynExpr.MatchBang (range=m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) | SynExpr.IndexFromEnd (range=m) @@ -5980,7 +5980,7 @@ and TcExprObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImp // Work out the type of any interfaces to implement let extraImpls, tpenv = - (tpenv, extraImpls) ||> List.mapFold (fun tpenv (SynInterfaceImpl(synIntfTy, overrides, m)) -> + (tpenv, extraImpls) ||> List.mapFold (fun tpenv (SynInterfaceImpl(synIntfTy, _mWith, overrides, m)) -> let intfTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synIntfTy if not (isInterfaceTy cenv.g intfTy) then error(Error(FSComp.SR.tcExpectedInterfaceType(), m)) @@ -9662,7 +9662,7 @@ and CheckRecursiveBindingIds binds = match b with | SynPat.Named(id, _, _, _) | SynPat.As(_, SynPat.Named(id, _, _, _), _) - | SynPat.LongIdent(LongIdentWithDots([id], _), _, _, _, _, _) -> id.idText + | SynPat.LongIdent(longDotId=LongIdentWithDots([id], _)) -> id.idText | _ -> "" if nm <> "" && not (hashOfBinds.Add nm) then error(Duplicate("value", nm, m)) @@ -11539,7 +11539,7 @@ and TcLetrec overridesOK cenv env tpenv (binds, bindsm, scopem) = let TcAndPublishValSpec (cenv, env, containerInfo: ContainerInfo, declKind, memFlagsOpt, tpenv, valSpfn) = - let (SynValSig (Attributes synAttrs, _, ValTyparDecls (synTypars, _, synCanInferTypars), _, _, isInline, mutableFlag, doc, vis, literalExprOpt, m)) = valSpfn + let (SynValSig (attributes=Attributes synAttrs; explicitValDecls=ValTyparDecls (synTypars, _, synCanInferTypars); isInline=isInline; isMutable=mutableFlag; xmlDoc=doc; accessibility=vis; synExpr=literalExprOpt; range=m)) = valSpfn GeneralizationHelpers.CheckDeclaredTyparsPermitted(memFlagsOpt, synTypars, m) let canInferTypars = GeneralizationHelpers.ComputeCanInferExtraGeneralizableTypars (containerInfo.ParentRef, synCanInferTypars, memFlagsOpt) diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs index 6077a1b35d4..62b405dce90 100644 --- a/src/fsharp/SyntaxTree.fs +++ b/src/fsharp/SyntaxTree.fs @@ -115,9 +115,9 @@ type SynConst = | UInt16s of uint16[] - | Measure of constant: SynConst * constantRange: Range * SynMeasure + | Measure of constant: SynConst * constantRange: range * SynMeasure - | SourceIdentifier of constant: string * value: string * range: Range + | SourceIdentifier of constant: string * value: string * range: range member c.Range dflt = match c with @@ -483,7 +483,7 @@ type SynExpr = | AnonRecd of isStruct: bool * copyInfo:(SynExpr * BlockSeparator) option * - recordFields:(Ident * Range option * SynExpr) list * + recordFields:(Ident * range option * SynExpr) list * range: range | ArrayOrList of @@ -506,6 +506,7 @@ type SynExpr = | ObjExpr of objType: SynType * argOptions:(SynExpr * Ident option) option * + withKeyword: range option * bindings: SynBinding list * extraImpls: SynInterfaceImpl list * newExprRange: range * @@ -520,7 +521,7 @@ type SynExpr = | For of forDebugPoint: DebugPointAtFor * ident: Ident * - equalsRange: Range option * + equalsRange: range option * identBody: SynExpr * direction: bool * toBody: SynExpr * @@ -562,7 +563,7 @@ type SynExpr = fromMethod: bool * inLambdaSeq: bool * args: SynSimplePats * - arrow: Range option * + arrow: range option * body: SynExpr * parsedData: (SynPat list * SynExpr) option * range: range @@ -575,8 +576,10 @@ type SynExpr = range: range | Match of + matchKeyword: range * matchDebugPoint: DebugPointAtBinding * expr: SynExpr * + withKeyword: range * clauses: SynMatchClause list * range: range @@ -612,8 +615,10 @@ type SynExpr = range: range | TryWith of + tryKeywordRange: range * tryExpr: SynExpr * tryRange: range * + withKeywordRange: range * withCases: SynMatchClause list * withRange: range * range: range * @@ -778,15 +783,17 @@ type SynExpr = isUse: bool * isFromSource: bool * pat: SynPat * - equalsRange: Range option * + equalsRange: range option * rhs: SynExpr * andBangs: SynExprAndBang list * body:SynExpr * range: range | MatchBang of + matchKeyword: range * matchDebugPoint: DebugPointAtBinding * expr: SynExpr * + withKeyword: range * clauses: SynMatchClause list * range: range @@ -949,15 +956,15 @@ type SynExprAndBang = isUse: bool * isFromSource: bool * pat: SynPat * - equalsRange: Range * + equalsRange: range * body: SynExpr * - range: Range + range: range [] type SynExprRecordField = | SynExprRecordField of fieldName: RecordFieldName * - equalsRange: Range option * + equalsRange: range option * expr: SynExpr option * blockSeparator: BlockSeparator option @@ -1033,7 +1040,7 @@ type SynArgPats = pats: SynPat list | NamePatPairs of - pats: (Ident * Range * SynPat) list * + pats: (Ident * range * SynPat) list * range: range member x.Patterns = @@ -1083,6 +1090,7 @@ type SynPat = | LongIdent of longDotId: LongIdentWithDots * + propertyKeyword: PropertyKeyword option * extraId: Ident option * // holds additional ident for tooling typarDecls: SynValTyparDecls option * // usually None: temporary used to parse "f<'a> x = x" argPats: SynArgPats * @@ -1104,7 +1112,7 @@ type SynPat = range: range | Record of - fieldPats: ((LongIdent * Ident) * Range * SynPat) list * + fieldPats: ((LongIdent * Ident) * range * SynPat) list * range: range | Null of @@ -1161,10 +1169,16 @@ type SynPat = | SynPat.Paren (range=m) | SynPat.FromParseError (range=m) -> m +[] +type PropertyKeyword = + | With of range + | And of range + [] type SynInterfaceImpl = | SynInterfaceImpl of interfaceTy: SynType * + withKeyword: range option * bindings: SynBinding list * range: range @@ -1173,7 +1187,7 @@ type SynMatchClause = | SynMatchClause of pat: SynPat * whenExpr: SynExpr option * - arrow: Range option * + arrow: range option * resultExpr: SynExpr * range: range * debugPoint: DebugPointAtTarget @@ -1233,7 +1247,7 @@ type SynBinding = valData: SynValData * headPat: SynPat * returnInfo: SynBindingReturnInfo option * - equalsRange: Range option * + equalsRange: range option * expr: SynExpr * range: range * debugPoint: DebugPointAtBinding @@ -1326,7 +1340,7 @@ type SynTypeDefnKind = | Union | Abbrev | Opaque - | Augmentation + | Augmentation of withKeyword: range | IL | Delegate of signature: SynType * signatureInfo: SynValInfo @@ -1389,7 +1403,7 @@ type SynEnumCase = | SynEnumCase of attributes: SynAttributes * ident: Ident * - equalsRange: Range * + equalsRange: range * value: SynConst * valueRange: range * xmlDoc: PreXmlDoc * @@ -1450,8 +1464,9 @@ type SynTypeDefnSig = | SynTypeDefnSig of typeInfo: SynComponentInfo * - equalsRange: Range option * + equalsRange: range option * typeRepr: SynTypeDefnSigRepr * + withKeyword: range option * members: SynMemberSig list * range: range @@ -1500,6 +1515,7 @@ type SynValSig = xmlDoc: PreXmlDoc * accessibility: SynAccess option * synExpr: SynExpr option * + withKeyword: range option * range: range member x.RangeOfId = let (SynValSig(ident=id)) = x in id.idRange @@ -1594,7 +1610,7 @@ type SynTypeDefnRepr = type SynTypeDefn = | SynTypeDefn of typeInfo: SynComponentInfo * - equalsRange: Range option * + equalsRange: range option * typeRepr: SynTypeDefnRepr * members: SynMemberDefns * implicitConstructor: SynMemberDefn option * @@ -1642,6 +1658,7 @@ type SynMemberDefn = | Interface of interfaceType: SynType * + withKeyword: range option * members: SynMemberDefns option * range: range @@ -1668,8 +1685,9 @@ type SynMemberDefn = memberFlags:(SynMemberKind -> SynMemberFlags) * xmlDoc: PreXmlDoc * accessibility: SynAccess option * - equalsRange: Range * + equalsRange: range * synExpr: SynExpr * + withKeyword: range option * getSetRange: range option * range: range @@ -1700,7 +1718,7 @@ type SynModuleDecl = | NestedModule of moduleInfo: SynComponentInfo * isRecursive: bool * - equalsRange: Range option * + equalsRange: range option * decls: SynModuleDecl list * isContinuing: bool * range: range @@ -1767,6 +1785,7 @@ type SynOpenDeclTarget = type SynExceptionSig = | SynExceptionSig of exnRepr: SynExceptionDefnRepr * + withKeyword: range option * members: SynMemberSig list * range: range @@ -1781,7 +1800,7 @@ type SynModuleSigDecl = | NestedModule of moduleInfo: SynComponentInfo * isRecursive: bool * - equalsRange: Range option * + equalsRange: range option * moduleDecls: SynModuleSigDecl list * range: range @@ -1867,8 +1886,8 @@ type SynModuleOrNamespaceSig = [] type ParsedHashDirectiveArgument = - | String of value: string * stringKind: SynStringKind * range: Range - | SourceIdentifier of constant: string * value: string * range: Range + | String of value: string * stringKind: SynStringKind * range: range + | SourceIdentifier of constant: string * value: string * range: range member this.Range = match this with diff --git a/src/fsharp/SyntaxTree.fsi b/src/fsharp/SyntaxTree.fsi index 26d430f456c..36b78e38b29 100644 --- a/src/fsharp/SyntaxTree.fsi +++ b/src/fsharp/SyntaxTree.fsi @@ -155,7 +155,7 @@ type SynConst = /// Source Line, File, and Path Identifiers /// Containing both the original value as the evaluated value. - | SourceIdentifier of constant: string * value: string * range: Range + | SourceIdentifier of constant: string * value: string * range: range /// Gets the syntax range of this construct member Range: dflt: range -> range @@ -587,7 +587,7 @@ type SynExpr = | AnonRecd of isStruct: bool * copyInfo:(SynExpr * BlockSeparator) option * - recordFields:(Ident * Range option * SynExpr) list * + recordFields:(Ident * range option * SynExpr) list * range: range /// F# syntax: [ e1; ...; en ], [| e1; ...; en |] @@ -618,6 +618,7 @@ type SynExpr = | ObjExpr of objType: SynType * argOptions:(SynExpr * Ident option) option * + withKeyword: range option * bindings: SynBinding list * extraImpls: SynInterfaceImpl list * newExprRange: range * @@ -634,7 +635,7 @@ type SynExpr = | For of forDebugPoint: DebugPointAtFor * ident: Ident * - equalsRange: Range option * + equalsRange: range option * identBody: SynExpr * direction: bool * toBody: SynExpr * @@ -692,7 +693,7 @@ type SynExpr = fromMethod: bool * inLambdaSeq: bool * args: SynSimplePats * - arrow: Range option * + arrow: range option * body: SynExpr * parsedData: (SynPat list * SynExpr) option * range: range @@ -707,8 +708,10 @@ type SynExpr = /// F# syntax: match expr with pat1 -> expr | ... | patN -> exprN | Match of + matchKeyword: range * matchDebugPoint: DebugPointAtBinding * expr: SynExpr * + withKeyword: range * clauses: SynMatchClause list * range: range @@ -757,8 +760,10 @@ type SynExpr = /// F# syntax: try expr with pat -> expr | TryWith of + tryKeywordRange: range * tryExpr: SynExpr * tryRange: range * + withKeywordRange: range * withCases: SynMatchClause list * withRange: range * range: range * @@ -967,7 +972,7 @@ type SynExpr = isUse: bool * isFromSource: bool * pat: SynPat * - equalsRange: Range option * + equalsRange: range option * rhs: SynExpr * andBangs: SynExprAndBang list * body:SynExpr * @@ -975,8 +980,10 @@ type SynExpr = /// F# syntax: match! expr with pat1 -> expr | ... | patN -> exprN | MatchBang of + matchKeyword: range * matchDebugPoint: DebugPointAtBinding * expr: SynExpr * + withKeyword: range * clauses: SynMatchClause list * range: range @@ -1062,15 +1069,15 @@ type SynExprAndBang = isUse: bool * isFromSource: bool * pat: SynPat * - equalsRange: Range * + equalsRange: range * body: SynExpr * - range: Range + range: range [] type SynExprRecordField = | SynExprRecordField of fieldName: RecordFieldName * - equalsRange: Range option * + equalsRange: range option * expr: SynExpr option * blockSeparator: BlockSeparator option @@ -1166,7 +1173,7 @@ type SynArgPats = pats: SynPat list | NamePatPairs of - pats: (Ident * Range * SynPat) list * + pats: (Ident * range * SynPat) list * range: range member Patterns: SynPat list @@ -1223,6 +1230,7 @@ type SynPat = /// A long identifier pattern possibly with argument patterns | LongIdent of longDotId: LongIdentWithDots * + propertyKeyword: PropertyKeyword option * extraId: Ident option * // holds additional ident for tooling typarDecls: SynValTyparDecls option * // usually None: temporary used to parse "f<'a> x = x" argPats: SynArgPats * @@ -1248,7 +1256,7 @@ type SynPat = /// A record pattern | Record of - fieldPats: ((LongIdent * Ident) * Range * SynPat) list * + fieldPats: ((LongIdent * Ident) * range * SynPat) list * range: range /// The 'null' pattern @@ -1292,11 +1300,18 @@ type SynPat = /// Gets the syntax range of this construct member Range: range +/// Represents a used keyword for a property member +[] +type PropertyKeyword = + | With of range + | And of range + /// Represents a set of bindings that implement an interface [] type SynInterfaceImpl = | SynInterfaceImpl of interfaceTy: SynType * + withKeyword: range option * bindings: SynBinding list * range: range @@ -1306,7 +1321,7 @@ type SynMatchClause = | SynMatchClause of pat: SynPat * whenExpr: SynExpr option * - arrow: Range option * + arrow: range option * resultExpr: SynExpr * range: range * debugPoint: DebugPointAtTarget @@ -1372,7 +1387,7 @@ type SynBinding = valData: SynValData * headPat: SynPat * returnInfo: SynBindingReturnInfo option * - equalsRange: Range option * + equalsRange: range option * expr: SynExpr * range: range * debugPoint: DebugPointAtBinding @@ -1483,7 +1498,7 @@ type SynTypeDefnKind = | Union | Abbrev | Opaque - | Augmentation + | Augmentation of withKeyword: range | IL | Delegate of signature: SynType * signatureInfo: SynValInfo @@ -1552,7 +1567,7 @@ type SynEnumCase = | SynEnumCase of attributes: SynAttributes * ident: Ident * - equalsRange: Range * + equalsRange: range * value: SynConst * valueRange: range * xmlDoc: PreXmlDoc * @@ -1620,8 +1635,9 @@ type SynTypeDefnSig = /// The information for a type definition in a signature | SynTypeDefnSig of typeInfo: SynComponentInfo * - equalsRange: Range option * + equalsRange: range option * typeRepr: SynTypeDefnSigRepr * + withKeyword: range option * members: SynMemberSig list * range: range @@ -1676,6 +1692,7 @@ type SynValSig = xmlDoc: PreXmlDoc * accessibility: SynAccess option * synExpr: SynExpr option * + withKeyword: range option * range: range member RangeOfId: range @@ -1777,7 +1794,7 @@ type SynTypeDefnRepr = type SynTypeDefn = | SynTypeDefn of typeInfo: SynComponentInfo * - equalsRange: Range option * + equalsRange: range option * typeRepr: SynTypeDefnRepr * members: SynMemberDefns * implicitConstructor: SynMemberDefn option * @@ -1832,6 +1849,7 @@ type SynMemberDefn = /// An interface implementation definition within a class | Interface of interfaceType: SynType * + withKeyword: range option * members: SynMemberDefns option * range: range @@ -1862,8 +1880,9 @@ type SynMemberDefn = memberFlags:(SynMemberKind -> SynMemberFlags) * xmlDoc: PreXmlDoc * accessibility: SynAccess option * - equalsRange: Range * + equalsRange: range * synExpr: SynExpr * + withKeyword: range option * getSetRange: range option * range: range @@ -1886,7 +1905,7 @@ type SynModuleDecl = | NestedModule of moduleInfo: SynComponentInfo * isRecursive: bool * - equalsRange: Range option * + equalsRange: range option * decls: SynModuleDecl list * isContinuing: bool * range: range @@ -1953,6 +1972,7 @@ type SynOpenDeclTarget = type SynExceptionSig = | SynExceptionSig of exnRepr: SynExceptionDefnRepr * + withKeyword: range option * members: SynMemberSig list * range: range @@ -1970,7 +1990,7 @@ type SynModuleSigDecl = | NestedModule of moduleInfo: SynComponentInfo * isRecursive: bool * - equalsRange: Range option * + equalsRange: range option * moduleDecls: SynModuleSigDecl list * range: range @@ -2059,8 +2079,8 @@ type SynModuleOrNamespaceSig = /// Represents a parsed hash directive argument [] type ParsedHashDirectiveArgument = - | String of value: string * stringKind: SynStringKind * range: Range - | SourceIdentifier of constant: string * value: string * range: Range + | String of value: string * stringKind: SynStringKind * range: range + | SourceIdentifier of constant: string * value: string * range: range /// Gets the syntax range of this construct member Range: range diff --git a/src/fsharp/SyntaxTreeOps.fs b/src/fsharp/SyntaxTreeOps.fs index d5802d7226d..10340e8b374 100644 --- a/src/fsharp/SyntaxTreeOps.fs +++ b/src/fsharp/SyntaxTreeOps.fs @@ -97,12 +97,12 @@ let mkSynPatVar vis (id: Ident) = SynPat.Named (id, false, vis, id.idRange) let mkSynThisPatVar (id: Ident) = SynPat.Named (id, true, None, id.idRange) -let mkSynPatMaybeVar lidwd vis m = SynPat.LongIdent (lidwd, None, None, SynArgPats.Pats [], vis, m) +let mkSynPatMaybeVar lidwd vis m = SynPat.LongIdent (lidwd, None, None, None, SynArgPats.Pats [], vis, m) /// Extract the argument for patterns corresponding to the declaration of 'new ... = ...' let (|SynPatForConstructorDecl|_|) x = match x with - | SynPat.LongIdent (LongIdentWithDots([_], _), _, _, SynArgPats.Pats [arg], _, _) -> Some arg + | SynPat.LongIdent (longDotId=LongIdentWithDots([_], _); argPats=SynArgPats.Pats [arg]) -> Some arg | _ -> None /// Recognize the '()' in 'new()' @@ -156,7 +156,7 @@ let rec SimplePatOfPat (synArgNameGenerator: SynArgNameGenerator) p = let m = p.Range let isCompGen, altNameRefCell, id, item = match p with - | SynPat.LongIdent(LongIdentWithDots([id], _), _, None, SynArgPats.Pats [], None, _) -> + | SynPat.LongIdent(longDotId=LongIdentWithDots([id], _); typarDecls=None; argPats=SynArgPats.Pats []; accessibility=None) -> // The pattern is 'V' or some other capitalized identifier. // It may be a real variable, in which case we want to maintain its name. // But it may also be a nullary union case or some other identifier. @@ -181,7 +181,7 @@ let rec SimplePatOfPat (synArgNameGenerator: SynArgNameGenerator) p = Some (fun e -> let clause = SynMatchClause(p, None, None, e, m, DebugPointAtTarget.No) let artificialMatchRange = (unionRanges m e.Range).MakeSynthetic() - SynExpr.Match (DebugPointAtBinding.NoneAtInvisible, item, [clause], artificialMatchRange)) + SynExpr.Match (artificialMatchRange, DebugPointAtBinding.NoneAtInvisible, item, artificialMatchRange, [clause], artificialMatchRange)) SynSimplePat.Id (id, altNameRefCell, isCompGen, false, false, id.idRange), fn @@ -530,12 +530,12 @@ module SynInfo = let infosForExplicitArgs = match pat with - | Some(SynPat.LongIdent(_, _, _, SynArgPats.Pats curriedArgs, _, _)) -> List.map InferSynArgInfoFromPat curriedArgs + | Some(SynPat.LongIdent(argPats=SynArgPats.Pats curriedArgs)) -> List.map InferSynArgInfoFromPat curriedArgs | _ -> [] let explicitArgsAreSimple = match pat with - | Some(SynPat.LongIdent(_, _, _, SynArgPats.Pats curriedArgs, _, _)) -> List.forall isSimplePattern curriedArgs + | Some(SynPat.LongIdent(argPats=SynArgPats.Pats curriedArgs)) -> List.forall isSimplePattern curriedArgs | _ -> true let retInfo = InferSynReturnData retInfo @@ -691,8 +691,8 @@ let rec synExprContainsError inpExpr = let flds = fs |> List.choose (fun (SynExprRecordField(expr=v)) -> v) walkExprs flds - | SynExpr.ObjExpr (_, _, bs, is, _, _) -> - walkBinds bs || walkBinds [ for SynInterfaceImpl(_, bs, _) in is do yield! bs ] + | SynExpr.ObjExpr (bindings=bs; extraImpls=is) -> + walkBinds bs || walkBinds [ for SynInterfaceImpl(bindings=bs) in is do yield! bs ] | SynExpr.ForEach (_, _, _, _, e1, e2, _) | SynExpr.While (_, e1, e2, _) -> @@ -707,13 +707,13 @@ let rec synExprContainsError inpExpr = | SynExpr.Lambda (body = e) -> walkExpr e - | SynExpr.Match (_, e, cl, _) -> + | SynExpr.Match (expr=e; clauses=cl) -> walkExpr e || walkMatchClauses cl | SynExpr.LetOrUse (_, _, bs, e, _) -> walkBinds bs || walkExpr e - | SynExpr.TryWith (e, _, cl, _, _, _, _) -> + | SynExpr.TryWith (tryExpr=e; withCases=cl) -> walkExpr e || walkMatchClauses cl | SynExpr.TryFinally (e1, e2, _, _, _) -> @@ -744,7 +744,7 @@ let rec synExprContainsError inpExpr = | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> walkExpr e1 || walkExpr e2 || walkExpr e3 - | SynExpr.MatchBang (_, e, cl, _) -> + | SynExpr.MatchBang (expr=e; clauses=cl) -> walkExpr e || walkMatchClauses cl | SynExpr.LetOrUseBang (rhs=e1;body=e2;andBangs=es) -> diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 19d0e6b82a6..f9b5444a58d 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -175,7 +175,7 @@ let idOfPat (parseState:IParseState) m p = | SynPat.Wild r when parseState.LexBuffer.SupportsFeature LanguageFeature.WildCardInForLoop -> mkSynId r "_" | SynPat.Named (id, false, _, _) -> id - | SynPat.LongIdent(LongIdentWithDots([id], _), _, None, SynArgPats.Pats [], None, _) -> id + | SynPat.LongIdent(longDotId=LongIdentWithDots([id], _); typarDecls=None; argPats=SynArgPats.Pats []; accessibility=None) -> id | _ -> raiseParseErrorAt m (FSComp.SR.parsIntegerForLoopRequiresSimpleIdentifier()) let checkForMultipleAugmentations m a1 a2 = @@ -327,7 +327,7 @@ let rangeOfLongIdent(lid:LongIdent) = %type atomicExpr %type tyconDefnOrSpfnSimpleRepr %type list> unionTypeRepr -%type tyconDefnAugmentation +%type tyconDefnAugmentation %type exconDefn %type exconCore %type moduleDefnsOrExprPossiblyEmptyOrBlock @@ -812,22 +812,22 @@ moduleSpfn: | opt_attributes opt_declVisibility typeKeyword tyconSpfn tyconSpfnList { if Option.isSome $2 then errorR (Error (FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier (), rhs parseState 2)) - let (SynTypeDefnSig (SynComponentInfo (cas, a, cs, b, _xmlDoc, d, d2, d3), equalsRange, typeRepr, members, range)) = $4 + let (SynTypeDefnSig (SynComponentInfo (cas, a, cs, b, _xmlDoc, d, d2, d3), equalsRange, typeRepr, withKeyword, members, range)) = $4 _xmlDoc.MarkAsInvalid() let attrs = $1 @ cas let mTc = let keywordM = rhs parseState 3 (keywordM, attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) |> unionRanges range let xmlDoc = grabXmlDoc(parseState, $1, 1) - let tc = (SynTypeDefnSig(SynComponentInfo(attrs, a, cs, b, xmlDoc, d, d2, d3), equalsRange, typeRepr, members, mTc)) + let tc = (SynTypeDefnSig(SynComponentInfo(attrs, a, cs, b, xmlDoc, d, d2, d3), equalsRange, typeRepr, withKeyword, members, mTc)) let m = (mTc, $5) ||> unionRangeWithListBy (fun (a: SynTypeDefnSig) -> a.Range) SynModuleSigDecl.Types (tc :: $5, m) } | opt_attributes opt_declVisibility exconSpfn { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2)) - let (SynExceptionSig(SynExceptionDefnRepr(cas, a, b, c, d, d2), e, f)) = $3 + let (SynExceptionSig(SynExceptionDefnRepr(cas, a, b, c, d, d2), withKeyword, members, range)) = $3 let xmlDoc = grabXmlDoc(parseState, $1, 1) - let ec = SynExceptionSig(SynExceptionDefnRepr($1@cas, a, b, xmlDoc, d, d2), e, f) + let ec = SynExceptionSig(SynExceptionDefnRepr($1@cas, a, b, xmlDoc, d, d2), withKeyword, members, range) SynModuleSigDecl.Exception(ec, rhs parseState 3) } | openDecl @@ -839,7 +839,7 @@ valSpfn: let attr1, attr2, isInline, isMutable, vis2, id, doc, explicitValTyparDecls, (ty, arity), konst = ($1), ($4), ($5), ($6), ($7), ($8), grabXmlDoc(parseState, $1, 1), ($9), ($11), ($12) if not (isNil attr2) then errorR(Deprecated(FSComp.SR.parsAttributesMustComeBeforeVal(), rhs parseState 4)) let m = rhs2 parseState 1 11 - let valSpfn = SynValSig((attr1@attr2), id, explicitValTyparDecls, ty, arity, isInline, isMutable, doc, vis2, konst, m) + let valSpfn = SynValSig((attr1@attr2), id, explicitValTyparDecls, ty, arity, isInline, isMutable, doc, vis2, konst, None, m) SynModuleSigDecl.Val(valSpfn, m) } @@ -876,9 +876,9 @@ tyconSpfnList: { let xmlDoc = grabXmlDoc(parseState, [], 1) let tyconSpfn = if xmlDoc.IsEmpty then $2 else - let (SynTypeDefnSig(SynComponentInfo (a, typars, c, lid, _xmlDoc, fixity, vis, rangeOfLid), equalsRange, typeRepr, members, range)) = $2 + let (SynTypeDefnSig(SynComponentInfo (a, typars, c, lid, _xmlDoc, fixity, vis, rangeOfLid), equalsRange, typeRepr, withKeyword, members, range)) = $2 _xmlDoc.MarkAsInvalid() - SynTypeDefnSig(SynComponentInfo (a, typars, c, lid, xmlDoc, fixity, vis, rangeOfLid), equalsRange, typeRepr, members, range) + SynTypeDefnSig(SynComponentInfo (a, typars, c, lid, xmlDoc, fixity, vis, rangeOfLid), equalsRange, typeRepr, withKeyword, members, range) tyconSpfn :: $3 } | @@ -892,7 +892,8 @@ tyconSpfn: let mEquals = rhs parseState 2 $3 lhsm $1 (Some mEquals) } | typeNameInfo opt_classSpfn - { SynTypeDefnSig($1, None, SynTypeDefnSigRepr.Simple (SynTypeDefnSimpleRepr.None (lhs parseState), lhs parseState), $2, lhs parseState) } + { let mWithKwd, members = $2 + SynTypeDefnSig($1, None, SynTypeDefnSigRepr.Simple (SynTypeDefnSimpleRepr.None (lhs parseState), lhs parseState), mWithKwd, members, lhs parseState) } /* The right-hand-side of a type definition in a signature */ @@ -908,12 +909,14 @@ tyconSpfnRhsBlock: | OBLOCKBEGIN tyconSpfnRhs opt_OBLOCKSEP classSpfnMembers opt_classSpfn oblockend opt_classSpfn { let m = lhs parseState (fun lhsm nameInfo mEquals -> - $2 lhsm nameInfo mEquals (checkForMultipleAugmentations m ($4 @ $5) $7)) } + let members = $4 @ (snd $5) + $2 lhsm nameInfo mEquals (checkForMultipleAugmentations m members (snd $7))) } | tyconSpfnRhs opt_classSpfn { let m = lhs parseState - (fun lhsm nameInfo mEquals -> - $1 lhsm nameInfo mEquals $2) } + (fun lhsm nameInfo mEquals -> + let _, members = $2 + $1 lhsm nameInfo mEquals members) } /* The right-hand-side of a type definition in a signature */ @@ -922,7 +925,7 @@ tyconSpfnRhs: { (fun lhsm nameInfo mEquals augmentation -> let declRange = unionRanges lhsm $1.Range let mWhole = (declRange, augmentation) ||> unionRangeWithListBy (fun (mem: SynMemberSig) -> mem.Range) - SynTypeDefnSig(nameInfo, mEquals, SynTypeDefnSigRepr.Simple ($1, $1.Range), augmentation, mWhole)) } + SynTypeDefnSig(nameInfo, mEquals, SynTypeDefnSigRepr.Simple ($1, $1.Range), None, augmentation, mWhole)) } | tyconClassSpfn { let objectModelRange = lhs parseState @@ -933,16 +936,16 @@ tyconSpfnRhs: let declRange = unionRanges nameRange objectModelRange let mWhole = (declRange, augmentation) ||> unionRangeWithListBy (fun (mem: SynMemberSig) -> mem.Range) - SynTypeDefnSig(nameInfo, mEquals, SynTypeDefnSigRepr.ObjectModel (kind, decls, objectModelRange), augmentation, mWhole)) } + SynTypeDefnSig(nameInfo, mEquals, SynTypeDefnSigRepr.ObjectModel (kind, decls, objectModelRange), None, augmentation, mWhole)) } | DELEGATE OF topType { let m = lhs parseState let ty, arity = $3 - let invoke = SynMemberSig.Member(SynValSig([], mkSynId m "Invoke", inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m), AbstractMemberFlags SynMemberKind.Member, m) + let invoke = SynMemberSig.Member(SynValSig([], mkSynId m "Invoke", inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, None, m), AbstractMemberFlags SynMemberKind.Member, m) (fun nameRange nameInfo mEquals augmentation -> if not (isNil augmentation) then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) let mWhole = unionRanges nameRange m - SynTypeDefnSig(nameInfo, mEquals, SynTypeDefnSigRepr.ObjectModel (SynTypeDefnKind.Delegate (ty, arity), [invoke], m), [], mWhole)) } + SynTypeDefnSig(nameInfo, mEquals, SynTypeDefnSigRepr.ObjectModel (SynTypeDefnKind.Delegate (ty, arity), [invoke], m), None, [], mWhole)) } /* The right-hand-side of an object type definition in a signature */ @@ -1011,7 +1014,7 @@ classMemberSpfn: | opt_attributes opt_declVisibility memberSpecFlags opt_inline opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints classMemberSpfnGetSet optLiteralValueSpfn { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2)) let isInline, doc, vis2, id, explicitValTyparDecls, (ty, arity), optLiteralValue = $4, grabXmlDoc(parseState, $1, 1), $5, $6, $7, $9, $11 - let getSetRangeOpt, getSet = $10 + let mWith, getSetRangeOpt, getSet = $10 let getSetAdjuster arity = match arity, getSet with SynValInfo([], _), SynMemberKind.Member -> SynMemberKind.PropertyGet | _ -> getSet let wholeRange = let m = rhs parseState 3 @@ -1019,7 +1022,7 @@ classMemberSpfn: | None -> unionRanges m ty.Range | Some m2 -> unionRanges m m2 |> fun m -> (m, $1) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) - let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, optLiteralValue, wholeRange) + let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, optLiteralValue, mWith, wholeRange) let _, flags = $3 SynMemberSig.Member(valSpfn, flags (getSetAdjuster arity), wholeRange) } @@ -1050,24 +1053,27 @@ classMemberSpfn: { let vis, doc, (ty, valSynInfo) = $2, grabXmlDoc(parseState, $1, 1), $5 let m = unionRanges (rhs parseState 1) ty.Range let isInline = false - let valSpfn = SynValSig ($1, mkSynId (rhs parseState 3) "new", noInferredTypars, ty, valSynInfo, isInline, false, doc, vis, None, m) + let valSpfn = SynValSig ($1, mkSynId (rhs parseState 3) "new", noInferredTypars, ty, valSynInfo, isInline, false, doc, vis, None, None, m) SynMemberSig.Member(valSpfn, CtorMemberFlags, m) } /* The optional "with get, set" on a member in a signature */ classMemberSpfnGetSet: | /* EMPTY */ - { None, SynMemberKind.Member } + { None, None, SynMemberKind.Member } | WITH classMemberSpfnGetSetElements - { Some (rhs2 parseState 1 2), $2 } + { let mWith = rhs parseState 1 + Some mWith, Some (rhs2 parseState 1 2), $2 } | OWITH classMemberSpfnGetSetElements OEND - { Some (rhs2 parseState 1 2), $2 } + { let mWith = rhs parseState 1 + Some mWith, Some (rhs2 parseState 1 2), $2 } | OWITH classMemberSpfnGetSetElements error - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedWith()) - Some (rhs2 parseState 1 2), $2 } + { let mWith = rhs parseState 1 + reportParseErrorAt mWith (FSComp.SR.parsUnmatchedWith()) + Some mWith, Some (rhs2 parseState 1 2), $2 } /* The "get, set" on a property member in a signature */ @@ -1094,16 +1100,18 @@ memberSpecFlags: /* Part of an exception definition in a signature file */ exconSpfn: | exconCore opt_classSpfn - { SynExceptionSig($1, $2, lhs parseState) } + { let mWithKwd, members = $2 + SynExceptionSig($1, mWithKwd, members, lhs parseState) } /* The optional augmentation on a type definition in a signature */ opt_classSpfn: | WITH classSpfnBlock declEnd - { $2 } + { let mWithKwd = rhs parseState 1 + (Some mWithKwd), $2 } | /* EMPTY */ - { [] } + { None, [] } /*--------------------------------------------------------------------------*/ @@ -1431,7 +1439,8 @@ wrappedNamedModuleDefn: tyconDefnAugmentation: | WITH classDefnBlock declEnd - { $2 } + { let mWithKwd = rhs parseState 1 + mWithKwd, $2 } /* An optional list of custom attributes */ @@ -1558,8 +1567,9 @@ tyconDefn: SynTypeDefn($1, $2, tcDefRepr, members, None, mWhole) } | typeNameInfo tyconDefnAugmentation - { let m = (rhs parseState 1, $2) ||> unionRangeWithListBy (fun mem -> mem.Range) - SynTypeDefn($1, None, SynTypeDefnRepr.ObjectModel(SynTypeDefnKind.Augmentation, [], m), $2, None, m) } + { let mWithKwd, classDefns = $2 + let m = (rhs parseState 1, classDefns) ||> unionRangeWithListBy (fun mem -> mem.Range) + SynTypeDefn($1, None, SynTypeDefnRepr.ObjectModel(SynTypeDefnKind.Augmentation mWithKwd, [], m), classDefns, None, m) } | typeNameInfo opt_attributes opt_declVisibility opt_HIGH_PRECEDENCE_APP simplePatterns optAsSpec EQUALS tyconDefnRhsBlock { let vis, spats, az = $3, $5, $6 @@ -1628,7 +1638,7 @@ tyconDefnRhs: { let m = lhs parseState let ty, arity = $3 (fun nameRange augmentation -> - let valSpfn = SynValSig([], mkSynId m "Invoke", inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m) + let valSpfn = SynValSig([], mkSynId m "Invoke", inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, None, m) let invoke = SynMemberDefn.AbstractSlot(valSpfn, AbstractMemberFlags SynMemberKind.Member, m) if not (isNil augmentation) then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Delegate (ty, arity), [invoke], m), []) } @@ -1701,7 +1711,7 @@ classDefnMembers: classDefnMembersAtLeastOne: | classDefnMember opt_seps classDefnMembers { match $1, $3 with - | [ SynMemberDefn.Interface (_, Some [], m) ], nextMember :: _ -> + | [ SynMemberDefn.Interface (members=Some []; range=m) ], nextMember :: _ -> warning(IndentationProblem(FSComp.SR.lexfltTokenIsOffsideOfContextStartedEarlier(warningStringOfPos m.Start), nextMember.Range)) | _ -> () $1 @ $3 } @@ -1710,14 +1720,17 @@ classDefnMembersAtLeastOne: /* The "with get, set" part of a member definition */ classDefnMemberGetSet: | WITH classDefnMemberGetSetElements - { $2 } + { let mWithKwd = rhs parseState 1 + mWithKwd, $2 } | OWITH classDefnMemberGetSetElements OEND - { $2 } + { let mWithKwd = rhs parseState 1 + mWithKwd, $2 } | OWITH classDefnMemberGetSetElements error - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedWith()) - $2 } + { let mWithKwd = rhs parseState 1 + reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedWith()) + mWithKwd, $2 } /* The "get, set" part of a member definition */ classDefnMemberGetSetElements: @@ -1751,7 +1764,8 @@ memberCore: /* Properties with explicit get/set, also indexer properties */ | opt_inline bindingPattern opt_topReturnTypeWithTypeConstraints classDefnMemberGetSet - { let mWhole = (rhs parseState 2, $4) ||> unionRangeWithListBy (fun (_, _, _, _, _, _, m2) -> m2) + { let mWith, classDefnMemberGetSetElements = $4 + let mWhole = (rhs parseState 2, classDefnMemberGetSetElements) ||> unionRangeWithListBy (fun (_, _, _, _, _, _, m2) -> m2) let propertyNameBindingBuilder, _ = $2 let optPropertyType = $3 let isMutable = false @@ -1759,182 +1773,188 @@ memberCore: let mutable hasGet = false let mutable hasSet = false let xmlDoc = grabXmlDocAtRangeStart(parseState, attrs, rangeStart) + + let tryMkSynMemberDefnMember + (withPropertyKeyword: PropertyKeyword option) + (optInline, (optAttrs: SynAttributeList list), (bindingBuilder, mBindLhs), optReturnType, mEquals, expr, exprm) + = + let optInline = $1 || optInline + // optional attributes are only applied to getters and setters + // the "top level" attrs will be applied to both + let optAttrs = + optAttrs |> List.map (fun attrList -> + { attrList with Attributes = attrList.Attributes |> List.map (fun a -> { a with AppliesToGetterAndSetter = true } ) }) + + let attrs = attrs @ optAttrs + + let binding = (bindingBuilder xmlDoc) (visNoLongerUsed, optInline, isMutable, mBindLhs, DebugPointAtBinding.NoneAtInvisible, optReturnType, None, expr, exprm, [], attrs, Some (memFlagsBuilder SynMemberKind.Member)) + let (SynBinding (vis, _, isInline, _, attrs, doc, valSynData, pv, _, _, _, mBindLhs, spBind)) = binding + let memberKind = + let getset = + let rec go p = + match p with + | SynPat.LongIdent (longDotId=LongIdentWithDots([id], _)) -> id.idText + | SynPat.Named (nm, _, _, _) | SynPat.As (_, SynPat.Named (nm, _, _, _), _) -> nm.idText + | SynPat.Typed (p, _, _) -> go p + | SynPat.Attrib (p, _, _) -> go p + | _ -> raiseParseErrorAt mBindLhs (FSComp.SR.parsInvalidDeclarationSyntax()) + go pv + if getset = "get" then + if hasGet then + reportParseErrorAt mBindLhs (FSComp.SR.parsGetAndOrSetRequired()) + None + else + hasGet <- true + Some SynMemberKind.PropertyGet + else if getset = "set" then + if hasSet then + reportParseErrorAt mBindLhs (FSComp.SR.parsGetAndOrSetRequired()) + None + else + hasSet <- true + Some SynMemberKind.PropertySet + else + raiseParseErrorAt mBindLhs (FSComp.SR.parsGetAndOrSetRequired()) + + match memberKind with + | None -> None + | Some memberKind -> + + // REVIEW: It's hard not to ignore the optPropertyType type annotation for 'set' properties. To apply it, + // we should apply it to the last argument, but at this point we've already pushed the patterns that + // make up the arguments onto the RHS. So we just always give a warning. + + begin match optPropertyType with + | Some _ -> errorR(Error(FSComp.SR.parsTypeAnnotationsOnGetSet(), mBindLhs)) + | None -> () + end + + let optReturnType = + match (memberKind, optReturnType) with + | SynMemberKind.PropertySet, _ -> optReturnType + | _, None -> optPropertyType + | _ -> optReturnType + + // REDO with the correct member kind + let binding = (bindingBuilder PreXmlDoc.Empty) (vis, isInline, isMutable, mBindLhs, DebugPointAtBinding.NoneAtInvisible, optReturnType, mEquals, expr, exprm, [], attrs, Some(memFlagsBuilder memberKind)) + + let (SynBinding (vis, _, isInline, _, attrs, doc, valSynData, pv, rhsRetInfo, mEquals, rhsExpr, mBindLhs, spBind)) = binding + let mWholeBindLhs = (mBindLhs, attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) + + let (SynValData(_, valSynInfo, _)) = valSynData + + // Setters have all arguments tupled in their internal TAST form, though they don't appear to be + // tupled from the syntax + let memFlags : SynMemberFlags = memFlagsBuilder memberKind + + let valSynInfo = + let adjustValueArg valueArg = + match valueArg with + | [_] -> valueArg + | _ -> SynInfo.unnamedTopArg + + match memberKind, valSynInfo, memFlags.IsInstance with + | SynMemberKind.PropertyGet, SynValInfo ([], _ret), false + | SynMemberKind.PropertyGet, SynValInfo ([_], _ret), true -> + raiseParseErrorAt mWholeBindLhs (FSComp.SR.parsGetterMustHaveAtLeastOneArgument()) + + | SynMemberKind.PropertyGet, SynValInfo (thisArg :: indexOrUnitArgs :: rest, ret), true -> + if not rest.IsEmpty then + reportParseErrorAt mWholeBindLhs (FSComp.SR.parsGetterAtMostOneArgument ()) + SynValInfo ([thisArg; indexOrUnitArgs], ret) + + | SynMemberKind.PropertyGet, SynValInfo (indexOrUnitArgs :: rest, ret), false -> + if not rest.IsEmpty then + reportParseErrorAt mWholeBindLhs (FSComp.SR.parsGetterAtMostOneArgument ()) + SynValInfo ([indexOrUnitArgs], ret) + + | SynMemberKind.PropertySet, SynValInfo ([thisArg;valueArg], ret), true -> + SynValInfo ([thisArg; adjustValueArg valueArg], ret) + + | SynMemberKind.PropertySet, SynValInfo (thisArg :: indexArgs :: valueArg :: rest, ret), true -> + if not rest.IsEmpty then + reportParseErrorAt mWholeBindLhs (FSComp.SR.parsSetterAtMostTwoArguments ()) + SynValInfo ([thisArg; indexArgs @ adjustValueArg valueArg], ret) + + | SynMemberKind.PropertySet, SynValInfo ([valueArg], ret), false -> + SynValInfo ([adjustValueArg valueArg], ret) + + | SynMemberKind.PropertySet, SynValInfo (indexArgs :: valueArg :: rest, ret), _ -> + if not rest.IsEmpty then + reportParseErrorAt mWholeBindLhs (FSComp.SR.parsSetterAtMostTwoArguments ()) + SynValInfo ([indexArgs @ adjustValueArg valueArg], ret) + + | _ -> + // should be unreachable, cover just in case + raiseParseErrorAt mWholeBindLhs (FSComp.SR.parsInvalidProperty ()) + + let valSynData = SynValData(Some(memFlags), valSynInfo, None) + + // Fold together the information from the first lambda pattern and the get/set binding + // This uses the 'this' variable from the first and the patterns for the get/set binding, + // replacing the get/set identifier. A little gross. + + let bindingPatAdjusted, xmlDocAdjusted = + + let bindingOuter = (propertyNameBindingBuilder xmlDoc) (vis, optInline, isMutable, mWholeBindLhs, spBind, optReturnType, mEquals, expr, exprm, [], attrs, Some(memFlagsBuilder SynMemberKind.Member)) + + let (SynBinding (_, _, _, _, _, doc2, _, bindingPatOuter, _, _, _, _, _)) = bindingOuter + + let lidOuter, lidVisOuter = + match bindingPatOuter with + | SynPat.LongIdent (lid, _, None, None, SynArgPats.Pats [], lidVisOuter, m) -> lid, lidVisOuter + | SynPat.Named (id, _, visOuter, m) | SynPat.As(_, SynPat.Named (id, _, visOuter, m), _) -> LongIdentWithDots([id], []), visOuter + | p -> raiseParseErrorAt mWholeBindLhs (FSComp.SR.parsInvalidDeclarationSyntax()) + + // Merge the visibility from the outer point with the inner point, e.g. + // member this.Size with get () = m_size + + let mergeLidVisOuter lidVisInner = + match lidVisInner, lidVisOuter with + | None, None -> None + | Some lidVisInner, None | None, Some lidVisInner -> Some lidVisInner + | Some _, Some _ -> + errorR(Error(FSComp.SR.parsMultipleAccessibilitiesForGetSet(), mWholeBindLhs)) + lidVisInner + + // Replace the "get" or the "set" with the right name + let rec go p = + match p with + | SynPat.LongIdent (longDotId=LongIdentWithDots([id], _); typarDecls=tyargs; argPats=SynArgPats.Pats args; accessibility=lidVisInner; range=m) -> + // Setters have all arguments tupled in their internal form, though they don't + // appear to be tupled from the syntax. Somewhat unfortunate + let args = + if id.idText = "set" then + match args with + | [SynPat.Paren(SynPat.Tuple (false, indexPats, _), indexPatRange);valuePat] when id.idText = "set" -> + [SynPat.Tuple(false, indexPats@[valuePat], unionRanges indexPatRange valuePat.Range)] + | [indexPat;valuePat] -> + [SynPat.Tuple(false, args, unionRanges indexPat.Range valuePat.Range)] + | [valuePat] -> + [valuePat] + | _ -> + raiseParseErrorAt m (FSComp.SR.parsSetSyntax()) + else + args + SynPat.LongIdent (lidOuter, withPropertyKeyword, Some(id), tyargs, SynArgPats.Pats args, mergeLidVisOuter lidVisInner, m) + | SynPat.Named (nm, _, lidVisInner, m) + | SynPat.As (_, SynPat.Named (nm, _, lidVisInner, m), _) -> SynPat.LongIdent (lidOuter, None, None, None, SynArgPats.Pats [], mergeLidVisOuter lidVisInner, m) + | SynPat.Typed (p, ty, m) -> SynPat.Typed(go p, ty, m) + | SynPat.Attrib (p, attribs, m) -> SynPat.Attrib(go p, attribs, m) + | SynPat.Wild(m) -> SynPat.Wild(m) + | _ -> raiseParseErrorAt mWholeBindLhs (FSComp.SR.parsInvalidDeclarationSyntax()) + + go pv, PreXmlDoc.Merge doc2 doc + + let binding = SynBinding (vis, SynBindingKind.Normal, isInline, isMutable, attrs, xmlDocAdjusted, valSynData, bindingPatAdjusted, rhsRetInfo, mEquals, rhsExpr, mWholeBindLhs, spBind) + let memberRange = unionRanges rangeStart mWhole + Some (SynMemberDefn.Member (binding, memberRange)) // Iterate over 1 or 2 'get'/'set' entries - $4 |> List.choose (fun (optInline, optAttrs, (bindingBuilder, mBindLhs), optReturnType, mEquals, expr, exprm) -> - - let optInline = $1 || optInline - // optional attributes are only applied to getters and setters - // the "top level" attrs will be applied to both - let optAttrs = - optAttrs |> List.map (fun attrList -> - { attrList with Attributes = attrList.Attributes |> List.map (fun a -> { a with AppliesToGetterAndSetter = true } ) }) - - let attrs = attrs @ optAttrs - - let binding = (bindingBuilder xmlDoc) (visNoLongerUsed, optInline, isMutable, mBindLhs, DebugPointAtBinding.NoneAtInvisible, optReturnType, None, expr, exprm, [], attrs, Some (memFlagsBuilder SynMemberKind.Member)) - let (SynBinding (vis, _, isInline, _, attrs, doc, valSynData, pv, _, _, _, mBindLhs, spBind)) = binding - let memberKind = - let getset = - let rec go p = - match p with - | SynPat.LongIdent (LongIdentWithDots([id], _), _, _, _, _, _) -> id.idText - | SynPat.Named (nm, _, _, _) | SynPat.As (_, SynPat.Named (nm, _, _, _), _) -> nm.idText - | SynPat.Typed (p, _, _) -> go p - | SynPat.Attrib (p, _, _) -> go p - | _ -> raiseParseErrorAt mBindLhs (FSComp.SR.parsInvalidDeclarationSyntax()) - go pv - if getset = "get" then - if hasGet then - reportParseErrorAt mBindLhs (FSComp.SR.parsGetAndOrSetRequired()) - None - else - hasGet <- true - Some SynMemberKind.PropertyGet - else if getset = "set" then - if hasSet then - reportParseErrorAt mBindLhs (FSComp.SR.parsGetAndOrSetRequired()) - None - else - hasSet <- true - Some SynMemberKind.PropertySet - else - raiseParseErrorAt mBindLhs (FSComp.SR.parsGetAndOrSetRequired()) - - match memberKind with - | None -> None - | Some memberKind -> - - // REVIEW: It's hard not to ignore the optPropertyType type annotation for 'set' properties. To apply it, - // we should apply it to the last argument, but at this point we've already pushed the patterns that - // make up the arguments onto the RHS. So we just always give a warning. - - begin match optPropertyType with - | Some _ -> errorR(Error(FSComp.SR.parsTypeAnnotationsOnGetSet(), mBindLhs)) - | None -> () - end - - let optReturnType = - match (memberKind, optReturnType) with - | SynMemberKind.PropertySet, _ -> optReturnType - | _, None -> optPropertyType - | _ -> optReturnType - - // REDO with the correct member kind - let binding = (bindingBuilder PreXmlDoc.Empty) (vis, isInline, isMutable, mBindLhs, DebugPointAtBinding.NoneAtInvisible, optReturnType, mEquals, expr, exprm, [], attrs, Some(memFlagsBuilder memberKind)) - - let (SynBinding (vis, _, isInline, _, attrs, doc, valSynData, pv, rhsRetInfo, mEquals, rhsExpr, mBindLhs, spBind)) = binding - let mWholeBindLhs = (mBindLhs, attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) - - let (SynValData(_, valSynInfo, _)) = valSynData - - // Setters have all arguments tupled in their internal TAST form, though they don't appear to be - // tupled from the syntax - let memFlags : SynMemberFlags = memFlagsBuilder memberKind - - let valSynInfo = - let adjustValueArg valueArg = - match valueArg with - | [_] -> valueArg - | _ -> SynInfo.unnamedTopArg - - match memberKind, valSynInfo, memFlags.IsInstance with - | SynMemberKind.PropertyGet, SynValInfo ([], _ret), false - | SynMemberKind.PropertyGet, SynValInfo ([_], _ret), true -> - raiseParseErrorAt mWholeBindLhs (FSComp.SR.parsGetterMustHaveAtLeastOneArgument()) - - | SynMemberKind.PropertyGet, SynValInfo (thisArg :: indexOrUnitArgs :: rest, ret), true -> - if not rest.IsEmpty then - reportParseErrorAt mWholeBindLhs (FSComp.SR.parsGetterAtMostOneArgument ()) - SynValInfo ([thisArg; indexOrUnitArgs], ret) - - | SynMemberKind.PropertyGet, SynValInfo (indexOrUnitArgs :: rest, ret), false -> - if not rest.IsEmpty then - reportParseErrorAt mWholeBindLhs (FSComp.SR.parsGetterAtMostOneArgument ()) - SynValInfo ([indexOrUnitArgs], ret) - - | SynMemberKind.PropertySet, SynValInfo ([thisArg;valueArg], ret), true -> - SynValInfo ([thisArg; adjustValueArg valueArg], ret) - - | SynMemberKind.PropertySet, SynValInfo (thisArg :: indexArgs :: valueArg :: rest, ret), true -> - if not rest.IsEmpty then - reportParseErrorAt mWholeBindLhs (FSComp.SR.parsSetterAtMostTwoArguments ()) - SynValInfo ([thisArg; indexArgs @ adjustValueArg valueArg], ret) - - | SynMemberKind.PropertySet, SynValInfo ([valueArg], ret), false -> - SynValInfo ([adjustValueArg valueArg], ret) - - | SynMemberKind.PropertySet, SynValInfo (indexArgs :: valueArg :: rest, ret), _ -> - if not rest.IsEmpty then - reportParseErrorAt mWholeBindLhs (FSComp.SR.parsSetterAtMostTwoArguments ()) - SynValInfo ([indexArgs @ adjustValueArg valueArg], ret) - - | _ -> - // should be unreachable, cover just in case - raiseParseErrorAt mWholeBindLhs (FSComp.SR.parsInvalidProperty ()) - - let valSynData = SynValData(Some(memFlags), valSynInfo, None) - - // Fold together the information from the first lambda pattern and the get/set binding - // This uses the 'this' variable from the first and the patterns for the get/set binding, - // replacing the get/set identifier. A little gross. - - let bindingPatAdjusted, xmlDocAdjusted = - - let bindingOuter = (propertyNameBindingBuilder xmlDoc) (vis, optInline, isMutable, mWholeBindLhs, spBind, optReturnType, mEquals, expr, exprm, [], attrs, Some(memFlagsBuilder SynMemberKind.Member)) - - let (SynBinding (_, _, _, _, _, doc2, _, bindingPatOuter, _, _, _, _, _)) = bindingOuter - - let lidOuter, lidVisOuter = - match bindingPatOuter with - | SynPat.LongIdent (lid, None, None, SynArgPats.Pats [], lidVisOuter, m) -> lid, lidVisOuter - | SynPat.Named (id, _, visOuter, m) | SynPat.As(_, SynPat.Named (id, _, visOuter, m), _) -> LongIdentWithDots([id], []), visOuter - | p -> raiseParseErrorAt mWholeBindLhs (FSComp.SR.parsInvalidDeclarationSyntax()) - - // Merge the visibility from the outer point with the inner point, e.g. - // member this.Size with get () = m_size - - let mergeLidVisOuter lidVisInner = - match lidVisInner, lidVisOuter with - | None, None -> None - | Some lidVisInner, None | None, Some lidVisInner -> Some lidVisInner - | Some _, Some _ -> - errorR(Error(FSComp.SR.parsMultipleAccessibilitiesForGetSet(), mWholeBindLhs)) - lidVisInner - - // Replace the "get" or the "set" with the right name - let rec go p = - match p with - | SynPat.LongIdent (LongIdentWithDots([id], _), _, tyargs, SynArgPats.Pats args, lidVisInner, m) -> - // Setters have all arguments tupled in their internal form, though they don't - // appear to be tupled from the syntax. Somewhat unfortunate - let args = - if id.idText = "set" then - match args with - | [SynPat.Paren(SynPat.Tuple (false, indexPats, _), indexPatRange);valuePat] when id.idText = "set" -> - [SynPat.Tuple(false, indexPats@[valuePat], unionRanges indexPatRange valuePat.Range)] - | [indexPat;valuePat] -> - [SynPat.Tuple(false, args, unionRanges indexPat.Range valuePat.Range)] - | [valuePat] -> - [valuePat] - | _ -> - raiseParseErrorAt m (FSComp.SR.parsSetSyntax()) - else - args -// let idTool : Ident list = lidOuter |> List.map (fun (li:Ident) -> ident(li.idText, id.idRange)) |> List.rev |> List.take 1 - SynPat.LongIdent (lidOuter, Some(id), tyargs, SynArgPats.Pats args, mergeLidVisOuter lidVisInner, m) - | SynPat.Named (nm, _, lidVisInner, m) - | SynPat.As (_, SynPat.Named (nm, _, lidVisInner, m), _) -> SynPat.LongIdent (lidOuter, None, None, SynArgPats.Pats [], mergeLidVisOuter lidVisInner, m) - | SynPat.Typed (p, ty, m) -> SynPat.Typed(go p, ty, m) - | SynPat.Attrib (p, attribs, m) -> SynPat.Attrib(go p, attribs, m) - | SynPat.Wild(m) -> SynPat.Wild(m) - | _ -> raiseParseErrorAt mWholeBindLhs (FSComp.SR.parsInvalidDeclarationSyntax()) - - go pv, PreXmlDoc.Merge doc2 doc - - let binding = SynBinding (vis, SynBindingKind.Normal, isInline, isMutable, attrs, xmlDocAdjusted, valSynData, bindingPatAdjusted, rhsRetInfo, mEquals, rhsExpr, mWholeBindLhs, spBind) - let memberRange = unionRanges rangeStart mWhole - Some (SynMemberDefn.Member (binding, memberRange)))) + match classDefnMemberGetSetElements with + | [ h ] -> List.choose id [ tryMkSynMemberDefnMember (Some (PropertyKeyword.With mWith)) h ] + | [ g ; s ] -> List.choose id [ tryMkSynMemberDefnMember (Some (PropertyKeyword.With mWith)) g ; tryMkSynMemberDefnMember None s ] + | _ -> []) } @@ -1963,17 +1983,16 @@ classDefnMember: | opt_attributes opt_declVisibility interfaceMember appType opt_interfaceImplDefn { if not (isNil $1) then errorR(Error(FSComp.SR.parsAttributesAreNotPermittedOnInterfaceImplementations(), rhs parseState 1)) if Option.isSome $2 then errorR(Error(FSComp.SR.parsInterfacesHaveSameVisibilityAsEnclosingType(), rhs parseState 3)) - let members = Option.map fst $5 - let mWhole = + let mWithKwd, members, mWhole = match $5 with - | None -> rhs2 parseState 1 4 - | Some (_, m) -> unionRanges (rhs2 parseState 1 4) m - [ SynMemberDefn.Interface ($4, members, mWhole) ] } + | None -> None, None, rhs2 parseState 1 4 + | Some (mWithKwd, members, m) -> Some mWithKwd, Some members, unionRanges (rhs2 parseState 1 4) m + [ SynMemberDefn.Interface ($4, mWithKwd, members, mWhole) ] } | opt_attributes opt_declVisibility abstractMemberFlags opt_inline nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints classMemberSpfnGetSet opt_ODECLEND { let ty, arity = $8 let isInline, doc, id, explicitValTyparDecls = $4, grabXmlDoc(parseState, $1, 1), $5, $6 - let getSetRangeOpt, getSet = $9 + let mWith, getSetRangeOpt, getSet = $9 let getSetAdjuster arity = match arity, getSet with SynValInfo([], _), SynMemberKind.Member -> SynMemberKind.PropertyGet | _ -> getSet let wholeRange = let m = rhs parseState 1 @@ -1981,7 +2000,7 @@ classDefnMember: | None -> unionRanges m ty.Range | Some m2 -> unionRanges m m2 if Option.isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(), wholeRange)) - let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, None, None, wholeRange) + let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, None, None, mWith, wholeRange) [ SynMemberDefn.AbstractSlot(valSpfn, AbstractMemberFlags (getSetAdjuster arity), wholeRange) ] } | opt_attributes opt_declVisibility inheritsDefn @@ -2013,7 +2032,7 @@ classDefnMember: let expr = $7 let valSynData = SynValData (Some CtorMemberFlags, SynValInfo([SynInfo.InferSynArgInfoFromPat $4], SynInfo.unnamedRetVal), $5) let vis = $2 - let declPat = SynPat.LongIdent (LongIdentWithDots([mkSynId (rhs parseState 3) "new"], []), None, Some noInferredTypars, SynArgPats.Pats [$4], vis, rhs parseState 3) + let declPat = SynPat.LongIdent (LongIdentWithDots([mkSynId (rhs parseState 3) "new"], []), None, None, Some noInferredTypars, SynArgPats.Pats [$4], vis, rhs parseState 3) // Check that 'SynPatForConstructorDecl' matches this correctly assert (match declPat with SynPatForConstructorDecl _ -> true | _ -> false) [ SynMemberDefn.Member(SynBinding (None, SynBindingKind.Normal, false, false, $1, grabXmlDoc(parseState, $1, 1), valSynData, declPat, None, Some mEquals, expr, mWholeBindLhs, DebugPointAtBinding.NoneAtInvisible), m) ] } @@ -2038,14 +2057,14 @@ valDefnDecl: /* An auto-property definition in an object type definition */ autoPropsDefnDecl: | VAL opt_mutable opt_access ident opt_typ EQUALS typedSequentialExprBlock classMemberSpfnGetSet - { let mGetSetOpt, getSet = $8 + { let mWith, mGetSetOpt, getSet = $8 let mEquals = rhs parseState 6 if $2 then errorR (Error (FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSet (), rhs parseState 3)) (fun attribs isStatic flags rangeStart -> let xmlDoc = grabXmlDocAtRangeStart(parseState, attribs, rangeStart) let memberRange = unionRanges rangeStart $7.Range - [ SynMemberDefn.AutoProperty(attribs, isStatic, $4, $5, getSet, flags, xmlDoc, $3, mEquals, $7, mGetSetOpt, memberRange) ]) } + [ SynMemberDefn.AutoProperty(attribs, isStatic, $4, $5, getSet, flags, xmlDoc, $3, mEquals, $7, mWith, mGetSetOpt, memberRange) ]) } /* An optional type on an auto-property definition */ @@ -2107,12 +2126,14 @@ opt_declVisibility: opt_interfaceImplDefn: | WITH objectImplementationBlock declEnd - { let members = $2 + { let mWithKwd = rhs parseState 1 + let members = $2 let m = (rhs parseState 1, members) ||> unionRangeWithListBy (fun (mem:SynMemberDefn) -> mem.Range) - Some (members, m) } + Some (mWithKwd, members, m) } | WITH - { Some ([], rhs parseState 1) } + { let mWithKwd = rhs parseState 1 + Some (mWithKwd, [], mWithKwd) } | /* EMPTY */ { None } @@ -2721,7 +2742,7 @@ cPrototype: SynExpr.Const (SynConst.String("extern was not given a DllImport attribute", SynStringKind.Regular, rhs parseState 8), rhs parseState 8), mRhs) (fun attrs _ -> - let bindingId = SynPat.LongIdent (LongIdentWithDots([nm], []), None, Some noInferredTypars, SynArgPats.Pats [SynPat.Tuple(false, args, argsm)], vis, nmm) + let bindingId = SynPat.LongIdent (LongIdentWithDots([nm], []), None, None, Some noInferredTypars, SynArgPats.Pats [SynPat.Tuple(false, args, argsm)], vis, nmm) let mWholeBindLhs = (mBindLhs, attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) let xmlDoc = grabXmlDoc(parseState, attrs, 1) let binding = mkSynBinding @@ -3087,7 +3108,7 @@ headBindingPattern: { SynPat.Or($1, $3, rhs2 parseState 1 3) } | headBindingPattern COLON_COLON headBindingPattern - { SynPat.LongIdent (LongIdentWithDots(mkSynCaseName (rhs parseState 2) opNameCons, []), None, None, SynArgPats.Pats [SynPat.Tuple (false, [$1;$3], rhs2 parseState 1 3)], None, lhs parseState) } + { SynPat.LongIdent (LongIdentWithDots(mkSynCaseName (rhs parseState 2) opNameCons, []), None, None, None, SynArgPats.Pats [SynPat.Tuple (false, [$1;$3], rhs2 parseState 1 3)], None, lhs parseState) } | tuplePatternElements %prec pat_tuple { SynPat.Tuple(false, List.rev $1, lhs parseState) } @@ -3127,43 +3148,43 @@ namePatPair: constrPattern: | atomicPatternLongIdent explicitValTyparDecls { let vis, lid = $1 - SynPat.LongIdent (lid, None, Some $2, SynArgPats.Pats [], vis, lhs parseState) } + SynPat.LongIdent (lid, None, None, Some $2, SynArgPats.Pats [], vis, lhs parseState) } | atomicPatternLongIdent explicitValTyparDecls atomicPatsOrNamePatPairs %prec pat_app { let vis, lid = $1 let args, argsM = $3 let m = unionRanges (rhs2 parseState 1 2) argsM - SynPat.LongIdent (lid, None, Some $2, args, vis, m) } + SynPat.LongIdent (lid, None, None, Some $2, args, vis, m) } | atomicPatternLongIdent explicitValTyparDecls HIGH_PRECEDENCE_PAREN_APP atomicPatsOrNamePatPairs { let vis, lid = $1 let args, argsM = $4 let m = unionRanges (rhs2 parseState 1 2) argsM - SynPat.LongIdent (lid, None, Some $2, args, vis, m) } + SynPat.LongIdent (lid, None, None, Some $2, args, vis, m) } | atomicPatternLongIdent explicitValTyparDecls HIGH_PRECEDENCE_BRACK_APP atomicPatsOrNamePatPairs { let vis, lid = $1 let args, argsM = $4 let m = unionRanges (rhs2 parseState 1 2) argsM - SynPat.LongIdent (lid, None, Some $2, args, vis, m) } + SynPat.LongIdent (lid, None, None, Some $2, args, vis, m) } | atomicPatternLongIdent atomicPatsOrNamePatPairs %prec pat_app { let vis, lid = $1 let args, argsM = $2 let m = unionRanges (rhs parseState 1) argsM - SynPat.LongIdent (lid, None, None, args, vis, m) } + SynPat.LongIdent (lid, None, None, None, args, vis, m) } | atomicPatternLongIdent HIGH_PRECEDENCE_PAREN_APP atomicPatsOrNamePatPairs { let vis, lid = $1 let args, argsM = $3 let m = unionRanges (rhs parseState 1) argsM - SynPat.LongIdent (lid, None, None, args, vis, m) } + SynPat.LongIdent (lid, None, None, None, args, vis, m) } | atomicPatternLongIdent HIGH_PRECEDENCE_BRACK_APP atomicPatsOrNamePatPairs { let vis, lid = $1 let args, argsM = $3 let m = unionRanges (rhs parseState 1) argsM - SynPat.LongIdent (lid, None, None, args, vis, m) } + SynPat.LongIdent (lid, None, None, None, args, vis, m) } | COLON_QMARK atomTypeOrAnonRecdType %prec pat_isinst { SynPat.IsInst($2, lhs parseState) } @@ -3325,7 +3346,7 @@ parenPattern: SynPat.Attrib($2, $1, lhsm) } | parenPattern COLON_COLON parenPattern - { SynPat.LongIdent (LongIdentWithDots(mkSynCaseName (rhs parseState 2) opNameCons, []), None, None, SynArgPats.Pats [ SynPat.Tuple (false, [$1;$3], rhs2 parseState 1 3) ], None, lhs parseState) } + { SynPat.LongIdent (LongIdentWithDots(mkSynCaseName (rhs parseState 2) opNameCons, []), None, None, None, SynArgPats.Pats [ SynPat.Tuple (false, [$1;$3], rhs2 parseState 1 3) ], None, lhs parseState) } | constrPattern { $1 } @@ -3499,7 +3520,7 @@ declExpr: { let mMatch = rhs parseState 1 let mWith, (clauses, mLast) = $3 let spBind = DebugPointAtBinding.Yes(unionRanges mMatch mWith) - SynExpr.Match (spBind, $2, clauses, unionRanges mMatch mLast) } + SynExpr.Match (mMatch, spBind, $2, mWith, clauses, unionRanges mMatch mLast) } | MATCH typedSequentialExpr recover %prec expr_match { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileMatch()) @@ -3510,7 +3531,7 @@ declExpr: { let mMatch = (rhs parseState 1) let mWith, (clauses, mLast) = $3 let spBind = DebugPointAtBinding.Yes(unionRanges mMatch mWith) - SynExpr.MatchBang (spBind, $2, clauses, unionRanges mMatch mLast) } + SynExpr.MatchBang (mMatch, spBind, $2, mWith, clauses, unionRanges mMatch mLast) } | MATCH_BANG typedSequentialExpr recover %prec expr_match { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileMatch()) @@ -3525,7 +3546,7 @@ declExpr: let mTryToWith = unionRanges mTry mWith let mWithToLast = unionRanges mWith mLast let mTryToLast = unionRanges mTry mLast - SynExpr.TryWith ($2, mTryToWith, clauses, mWithToLast, mTryToLast, spTry, spWith) } + SynExpr.TryWith (mTry, $2, mTryToWith, mWith, clauses, mWithToLast, mTryToLast, spTry, spWith) } | TRY typedSequentialExprBlockR recover %prec expr_try { // Produce approximate expression during error recovery @@ -4746,16 +4767,17 @@ objExpr: | objExprBaseCall objExprBindings opt_OBLOCKSEP opt_objExprInterfaces { let mNewExpr = rhs parseState 1 let fullRange = match $4 with [] -> (rhs parseState 1) | _ -> (rhs2 parseState 1 4) - fullRange, (fun m -> let (a, b) = $1 in SynExpr.ObjExpr (a, b, $2, $4, mNewExpr, m)) } + let mWithKwd, bindings = $2 + fullRange, (fun m -> let (a, b) = $1 in SynExpr.ObjExpr (a, b, Some mWithKwd, bindings, $4, mNewExpr, m)) } | objExprBaseCall opt_OBLOCKSEP objExprInterfaces { let mNewExpr = rhs parseState 1 let fullRange = match $3 with [] -> (rhs parseState 1) | _ -> (rhs2 parseState 1 3) - fullRange, (fun m -> let (a, b) = $1 in SynExpr.ObjExpr (a, b, [], $3, mNewExpr, m)) } + fullRange, (fun m -> let (a, b) = $1 in SynExpr.ObjExpr (a, b, None, [], $3, mNewExpr, m)) } | NEW atomTypeNonAtomicDeprecated { let mNewExpr = rhs parseState 1 - (rhs2 parseState 1 2), (fun m -> let (a, b) = $2, None in SynExpr.ObjExpr (a, b, [], [], mNewExpr, m)) } + (rhs2 parseState 1 2), (fun m -> let (a, b) = $2, None in SynExpr.ObjExpr (a, b, None, [], [], mNewExpr, m)) } objExprBaseCall: | NEW atomTypeNonAtomicDeprecated opt_HIGH_PRECEDENCE_APP atomicExprAfterType baseSpec @@ -4771,28 +4793,31 @@ objExprBaseCall: opt_objExprBindings: | objExprBindings - { $1 } + { let mWithKwd, b = $1 in Some mWithKwd, b } | /* EMPTY */ - { [] } + { None, [] } objExprBindings: | WITH localBindings { let mWithKwd = (rhs parseState 1) let _localBindingsLastRange, localBindingsBuilder = $2 - localBindingsBuilder PreXmlDoc.Empty [] None mWithKwd } + mWithKwd, localBindingsBuilder PreXmlDoc.Empty [] None mWithKwd } | OWITH localBindings OEND { let mWithKwd = (rhs parseState 1) let _localBindingsLastRange, localBindingsBuilder = $2 - localBindingsBuilder PreXmlDoc.Empty [] None mWithKwd } + mWithKwd, localBindingsBuilder PreXmlDoc.Empty [] None mWithKwd } | WITH objectImplementationBlock opt_declEnd - { $2 |> - (List.choose (function - | SynMemberDefn.Member(b, m) -> Some b - | SynMemberDefn.AutoProperty(range = m) -> errorR(Error(FSComp.SR.parsIllegalMemberVarInObjectImplementation(), m)); None - | x -> errorR(Error(FSComp.SR.parsMemberIllegalInObjectImplementation(), x.Range)); None)) } + { let mWithKwd = rhs parseState 1 + let bindings = + $2 |> + (List.choose (function + | SynMemberDefn.Member(b, m) -> Some b + | SynMemberDefn.AutoProperty(range = m) -> errorR(Error(FSComp.SR.parsIllegalMemberVarInObjectImplementation(), m)); None + | x -> errorR(Error(FSComp.SR.parsMemberIllegalInObjectImplementation(), x.Range)); None)) + mWithKwd, bindings } objExprInterfaces: | objExprInterface opt_objExprInterfaces { $1 :: $2 } @@ -4809,7 +4834,8 @@ opt_objExprInterfaces: objExprInterface: | interfaceMember appType opt_objExprBindings opt_declEnd opt_OBLOCKSEP - { SynInterfaceImpl($2, $3, lhs parseState) } + { let mWithKwd, bindings = $3 + SynInterfaceImpl($2, mWithKwd, bindings, lhs parseState) } braceBarExpr: | STRUCT braceBarExprCore diff --git a/src/fsharp/service/FSharpParseFileResults.fs b/src/fsharp/service/FSharpParseFileResults.fs index 0103aeb19bc..96676603bca 100644 --- a/src/fsharp/service/FSharpParseFileResults.fs +++ b/src/fsharp/service/FSharpParseFileResults.fs @@ -226,7 +226,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | Some expr -> getIdentRangeForFuncExprInApp traverseSynExpr expr pos - | SynExpr.Match (_, expr, clauses, range) when rangeContainsPos range pos -> + | SynExpr.Match (expr=expr; clauses=clauses; range=range) when rangeContainsPos range pos -> if rangeContainsPos expr.Range pos then getIdentRangeForFuncExprInApp traverseSynExpr expr pos else @@ -446,7 +446,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, let isFunction = Option.isSome memFlagsOpt || match synPat with - | SynPat.LongIdent (_, _, _, SynArgPats.Pats args, _, _) when not (List.isEmpty args) -> true + | SynPat.LongIdent (argPats=SynArgPats.Pats args) when not (List.isEmpty args) -> true | _ -> false if not isFunction then yield! walkBindSeqPt spInfo @@ -588,12 +588,12 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | None -> () yield! walkExprs (fs |> List.map (fun (_, _, e) -> e)) - | SynExpr.ObjExpr (_, args, bs, is, _, _) -> + | SynExpr.ObjExpr (argOptions=args; bindings=bs; extraImpls=is) -> match args with | None -> () | Some (arg, _) -> yield! walkExpr false arg yield! walkBinds bs - for SynInterfaceImpl(_, bs, _) in is do yield! walkBinds bs + for SynInterfaceImpl(bindings=bs) in is do yield! walkBinds bs | SynExpr.While (spWhile, e1, e2, _) -> yield! walkWhileSeqPt spWhile @@ -624,7 +624,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | SynExpr.Lambda (body = bodyExpr) -> yield! walkExpr true bodyExpr - | SynExpr.Match (spBind, inpExpr, cl, _) -> + | SynExpr.Match (matchDebugPoint=spBind; expr=inpExpr; clauses=cl) -> yield! walkBindSeqPt spBind yield! walkExpr false inpExpr for SynMatchClause(_, whenExpr, _, tgtExpr, _, _) in cl do @@ -635,7 +635,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, yield! walkBinds binds yield! walkExpr true bodyExpr - | SynExpr.TryWith (tryExpr, _, cl, _, _, spTry, spWith) -> + | SynExpr.TryWith (tryExpr=tryExpr; withCases=cl; tryDebugPoint=spTry; withDebugPoint=spWith) -> yield! walkTrySeqPt spTry yield! walkWithSeqPt spWith yield! walkExpr true tryExpr @@ -687,7 +687,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, yield! walkExpr true eAndBang yield! walkExpr true e2 - | SynExpr.MatchBang (spBind, e, cl, _) -> + | SynExpr.MatchBang (matchDebugPoint=spBind; expr=e; clauses=cl) -> yield! walkBindSeqPt spBind yield! walkExpr false e for SynMatchClause(_, whenExpr, _, e, _, _) in cl do @@ -713,7 +713,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | SynMemberDefn.AutoProperty(synExpr=synExpr) -> yield! walkExpr true synExpr | SynMemberDefn.ImplicitCtor(_, _, _, _, _, m) -> yield! checkRange m | SynMemberDefn.Member(bind, _) -> yield! walkBind bind - | SynMemberDefn.Interface(_, Some membs, _) -> for m in membs do yield! walkMember m + | SynMemberDefn.Interface(members=Some membs) -> for m in membs do yield! walkMember m | SynMemberDefn.Inherit(_, _, m) -> // can break on the "inherit" clause yield! checkRange m diff --git a/src/fsharp/service/ServiceInterfaceStubGenerator.fs b/src/fsharp/service/ServiceInterfaceStubGenerator.fs index ac821a230e9..bbd1d284f9a 100644 --- a/src/fsharp/service/ServiceInterfaceStubGenerator.fs +++ b/src/fsharp/service/ServiceInterfaceStubGenerator.fs @@ -503,7 +503,7 @@ module InterfaceStubGenerator = GetInterfaceMembers entity |> Seq.isEmpty let internal (|LongIdentPattern|_|) = function - | SynPat.LongIdent(LongIdentWithDots(xs, _), _, _, _, _, _) -> + | SynPat.LongIdent(longDotId=LongIdentWithDots(xs, _)) -> // let (name, range) = xs |> List.map (fun x -> x.idText, x.idRange) |> List.last let last = List.last xs Some(last.idText, last.idRange) @@ -729,7 +729,7 @@ module InterfaceStubGenerator = None | SynMemberDefn.AutoProperty(synExpr=expr) -> walkExpr expr - | SynMemberDefn.Interface(interfaceType, members, _range) -> + | SynMemberDefn.Interface(interfaceType=interfaceType; members=members) -> if rangeContainsPos interfaceType.Range pos then Some(InterfaceData.Interface(interfaceType, members)) else @@ -776,13 +776,13 @@ module InterfaceStubGenerator = | SynExpr.New (_, _synType, synExpr, _range) -> walkExpr synExpr - | SynExpr.ObjExpr (ty, baseCallOpt, binds, ifaces, _range1, _range2) -> + | SynExpr.ObjExpr (objType=ty; argOptions=baseCallOpt; bindings=binds; extraImpls=ifaces) -> match baseCallOpt with | None -> if rangeContainsPos ty.Range pos then Some (InterfaceData.ObjExpr(ty, binds)) else - ifaces |> List.tryPick (fun (SynInterfaceImpl(ty, binds, range)) -> + ifaces |> List.tryPick (fun (SynInterfaceImpl(interfaceTy=ty; bindings=binds; range=range)) -> if rangeContainsPos range pos then Some (InterfaceData.ObjExpr(ty, binds)) else None) @@ -807,7 +807,7 @@ module InterfaceStubGenerator = | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) -> synMatchClauseList |> List.tryPick (fun (SynMatchClause(resultExpr = e)) -> walkExpr e) - | SynExpr.Match (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> + | SynExpr.Match (expr=synExpr; clauses=synMatchClauseList) -> walkExpr synExpr |> Option.orElse (synMatchClauseList |> List.tryPick (fun (SynMatchClause(resultExpr = e)) -> walkExpr e)) @@ -827,7 +827,7 @@ module InterfaceStubGenerator = | SynExpr.LetOrUse (_, _, synBindingList, synExpr, _range) -> Option.orElse (List.tryPick walkBinding synBindingList) (walkExpr synExpr) - | SynExpr.TryWith (synExpr, _range, _synMatchClauseList, _range2, _range3, _sequencePointInfoForTry, _sequencePointInfoForWith) -> + | SynExpr.TryWith (tryExpr=synExpr) -> walkExpr synExpr | SynExpr.TryFinally (synExpr1, synExpr2, _range, _sequencePointInfoForTry, _sequencePointInfoForFinally) -> diff --git a/src/fsharp/service/ServiceNavigation.fs b/src/fsharp/service/ServiceNavigation.fs index 650f2786294..21e2e515a7a 100755 --- a/src/fsharp/service/ServiceNavigation.fs +++ b/src/fsharp/service/ServiceNavigation.fs @@ -158,7 +158,7 @@ module NavigationImpl = | hd :: _ -> (lid, hd.idRange) | _ -> (lid, m) [ createMemberLid(lidShow, kind, icon, unionRanges rangeMerge m, enclosingEntityKind, isAbstract, access) ] - | SynPat.LongIdent(LongIdentWithDots(lid,_), _, _, _, access, _), _ -> + | SynPat.LongIdent(longDotId=LongIdentWithDots(lid,_); accessibility=access), _ -> [ createMemberLid(lid, NavigationItemKind.Field, FSharpGlyph.Field, unionRanges (List.head lid).idRange m, enclosingEntityKind, isAbstract, access) ] | SynPat.Named (id, _, access, _), _ | SynPat.As(_, SynPat.Named (id, _, access, _), _), _ -> let glyph = if isMember then FSharpGlyph.Method else FSharpGlyph.Field @@ -233,15 +233,15 @@ module NavigationImpl = [ createMember(rcid, NavigationItemKind.Field, FSharpGlyph.Field, range, enclosingEntityKind, false, access) ] | SynMemberDefn.AutoProperty(ident=id; accessibility=access) -> [ createMember(id, NavigationItemKind.Field, FSharpGlyph.Field, id.idRange, enclosingEntityKind, false, access) ] - | SynMemberDefn.AbstractSlot(SynValSig(_, id, _, ty, _, _, _, _, access, _, _), _, _) -> + | SynMemberDefn.AbstractSlot(SynValSig(ident=id; synType=ty; accessibility=access), _, _) -> [ createMember(id, NavigationItemKind.Method, FSharpGlyph.OverridenMethod, ty.Range, enclosingEntityKind, true, access) ] | SynMemberDefn.NestedType _ -> failwith "tycon as member????" //processTycon tycon - | SynMemberDefn.Interface(_, Some(membs), _) -> + | SynMemberDefn.Interface(members=Some(membs)) -> processMembers membs enclosingEntityKind |> snd | _ -> [] // can happen if one is a getter and one is a setter - | [SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(lid1, Some(info1),_,_,_,_)) as binding1) - SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(lid2, Some(info2),_,_,_,_)) as binding2)] -> + | [SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid1; extraId=Some(info1))) as binding1) + SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid2; extraId=Some(info2))) as binding2)] -> // ensure same long id assert((lid1.Lid,lid2.Lid) ||> List.forall2 (fun x y -> x.idText = y.idText)) // ensure one is getter, other is setter @@ -343,7 +343,7 @@ module NavigationImpl = // Exception declaration [ createDecl(baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, fldspecRange fldspec, nested, NavigationEntityKind.Exception, false, access) ] - and processExnSig baseName (SynExceptionSig(repr, memberSigs, _)) = + and processExnSig baseName (SynExceptionSig(exnRepr=repr; members=memberSigs)) = let nested = processSigMembers memberSigs processExnRepr baseName nested repr @@ -392,7 +392,7 @@ module NavigationImpl = and processSigMembers (members: SynMemberSig list): list = [ for memb in members do match memb with - | SynMemberSig.Member(SynValSig.SynValSig(_, id, _, _, _, _, _, _, access, _, m), _, _) -> + | SynMemberSig.Member(SynValSig.SynValSig(ident=id; accessibility=access; range=m), _, _) -> yield createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Class, false, access) | SynMemberSig.ValField(SynField(_, _, Some(rcid), ty, _, _, access, _), _) -> yield createMember(rcid, NavigationItemKind.Field, FSharpGlyph.Field, ty.Range, NavigationEntityKind.Class, false, access) @@ -400,7 +400,7 @@ module NavigationImpl = // Process declarations in a module that belong to the right drop-down (let bindings) let processNestedSigDeclarations decls = decls |> List.collect (function - | SynModuleSigDecl.Val(SynValSig.SynValSig(_, id, _, _, _, _, _, _, access, _, m), _) -> + | SynModuleSigDecl.Val(SynValSig.SynValSig(ident=id; accessibility=access; range=m), _) -> [ createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) ] | _ -> [] ) @@ -540,7 +540,7 @@ module NavigateTo = | _ -> () { Type = containerType; Name = formatLongIdent lid } - let addValSig kind (SynValSig(_, id, _, _, _, _, _, _, _, _, _)) isSig container = + let addValSig kind (SynValSig(ident=id)) isSig container = addIdent kind id isSig container let addField(SynField(_, _, id, _, _, _, _, _)) isSig container = @@ -574,10 +574,10 @@ module NavigateTo = | _ -> NavigableItemKind.ModuleValue match headPat with - | SynPat.LongIdent(LongIdentWithDots([_; id], _), _, _, _, _access, _) -> + | SynPat.LongIdent(longDotId=LongIdentWithDots([_; id], _)) -> // instance members addIdent kind id false container - | SynPat.LongIdent(LongIdentWithDots([id], _), _, _, _, _, _) -> + | SynPat.LongIdent(longDotId=LongIdentWithDots([id], _)) -> // functions addIdent kind id false container | SynPat.Named (id, _, _, _) | SynPat.As(_, SynPat.Named (id, _, _, _), _) -> @@ -607,7 +607,7 @@ module NavigateTo = match decl with | SynModuleSigDecl.ModuleAbbrev(lhs, _, _range) -> addModuleAbbreviation lhs true container - | SynModuleSigDecl.Exception(SynExceptionSig(representation, _, _), _) -> + | SynModuleSigDecl.Exception(exnSig=SynExceptionSig(exnRepr=representation)) -> addExceptionRepr representation true container |> ignore | SynModuleSigDecl.NamespaceFragment fragment -> walkSynModuleOrNamespaceSig fragment container @@ -725,7 +725,7 @@ module NavigateTo = addMember synValSig memberFlags false container | SynMemberDefn.AutoProperty(ident=id) -> addIdent NavigableItemKind.Property id false container - | SynMemberDefn.Interface(_, members, _) -> + | SynMemberDefn.Interface(members=members) -> match members with | Some members -> for m in members do diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index dd6be78f4d7..78b4df62902 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -383,10 +383,10 @@ module SyntaxTraversal = ] |> pick expr | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.ObjExpr (ty,baseCallOpt,binds,ifaces,_range1,_range2) -> + | SynExpr.ObjExpr (objType=ty; argOptions=baseCallOpt; bindings=binds; extraImpls=ifaces) -> let result = ifaces - |> Seq.map (fun (SynInterfaceImpl(ty, _, _)) -> ty) + |> Seq.map (fun (SynInterfaceImpl(interfaceTy=ty)) -> ty) |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty)) if result.IsSome then @@ -401,7 +401,7 @@ module SyntaxTraversal = | _ -> () for b in binds do yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path) - for SynInterfaceImpl(_ty, binds, _range) in ifaces do + for SynInterfaceImpl(bindings=binds) in ifaces do for b in binds do yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path) ] |> pick expr @@ -456,7 +456,7 @@ module SyntaxTraversal = |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) |> pick expr - | SynExpr.Match (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> + | SynExpr.Match (expr=synExpr; clauses=synMatchClauseList) -> [yield dive synExpr synExpr.Range traverseSynExpr yield! synMatchClauseList |> List.map (fun x -> dive x x.RangeOfGuardAndRhs (traverseSynMatchClause path))] |> pick expr @@ -487,7 +487,7 @@ module SyntaxTraversal = yield dive synExpr synExpr.Range traverseSynExpr] |> pick expr - | SynExpr.TryWith (synExpr, _range, synMatchClauseList, _range2, _range3, _sequencePointInfoForTry, _sequencePointInfoForWith) -> + | SynExpr.TryWith (tryExpr=synExpr; withCases=synMatchClauseList) -> [yield dive synExpr synExpr.Range traverseSynExpr yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))] |> pick expr @@ -601,7 +601,7 @@ module SyntaxTraversal = ] |> pick expr - | SynExpr.MatchBang (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> + | SynExpr.MatchBang (expr=synExpr; clauses=synMatchClauseList) -> [yield dive synExpr synExpr.Range traverseSynExpr yield! synMatchClauseList |> List.map (fun x -> dive x x.RangeOfGuardAndRhs (traverseSynMatchClause path))] |> pick expr @@ -634,7 +634,7 @@ module SyntaxTraversal = | SynPat.Tuple (_, ps, _) | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path) | SynPat.Attrib (p, _, _) -> traversePat path p - | SynPat.LongIdent(_, _, _, args, _, _) -> + | SynPat.LongIdent(argPats=args) -> match args with | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path) | SynArgPats.NamePatPairs (ps, _) -> @@ -766,7 +766,7 @@ module SyntaxTraversal = | Some x -> Some x | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) |> pick m | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> None - | SynMemberDefn.Interface(synType, synMemberDefnsOption, _range) -> + | SynMemberDefn.Interface(interfaceType=synType; members=synMemberDefnsOption) -> match visitor.VisitInterfaceSynMemberDefnType(path, synType) with | None -> match synMemberDefnsOption with diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index 93c6fa25c88..7e5177af5af 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -487,7 +487,7 @@ module ParsedInput = | SynPat.Typed(pat, t, _) -> walkPat pat |> Option.orElseWith (fun () -> walkType t) | SynPat.Attrib(pat, Attributes attrs, _) -> walkPat pat |> Option.orElseWith (fun () -> List.tryPick walkAttribute attrs) | SynPat.Or(pat1, pat2, _) -> List.tryPick walkPat [pat1; pat2] - | SynPat.LongIdent(_, _, typars, ConstructorPats pats, _, r) -> + | SynPat.LongIdent(typarDecls=typars; argPats=ConstructorPats pats; range=r) -> ifPosInRange r (fun _ -> kind) |> Option.orElseWith (fun () -> typars @@ -513,7 +513,7 @@ module ParsedInput = | Some (SynBindingReturnInfo (t, _, _)) -> walkType t | None -> None) - and walkInterfaceImpl (SynInterfaceImpl(_, bindings, _)) = + and walkInterfaceImpl (SynInterfaceImpl(bindings=bindings)) = List.tryPick walkBinding bindings and walkType = function @@ -559,7 +559,7 @@ module ParsedInput = ifPosInRange r (fun _ -> fields |> List.tryPick (fun (SynExprRecordField(expr=e)) -> e |> Option.bind (walkExprWithKind parentKind))) | SynExpr.New (_, t, e, _) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> walkType t) - | SynExpr.ObjExpr (ty, _, bindings, ifaces, _, _) -> + | SynExpr.ObjExpr (objType=ty; bindings=bindings; extraImpls=ifaces) -> walkType ty |> Option.orElseWith (fun () -> List.tryPick walkBinding bindings) |> Option.orElseWith (fun () -> List.tryPick walkInterfaceImpl ifaces) @@ -571,7 +571,7 @@ module ParsedInput = | SynExpr.Lambda (body = e) -> walkExprWithKind parentKind e | SynExpr.MatchLambda (_, _, synMatchClauseList, _, _) -> List.tryPick walkClause synMatchClauseList - | SynExpr.Match (_, e, synMatchClauseList, _) -> + | SynExpr.Match (expr=e; clauses=synMatchClauseList) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> List.tryPick walkClause synMatchClauseList) | SynExpr.Do (e, _) -> walkExprWithKind parentKind e | SynExpr.Assert (e, _) -> walkExprWithKind parentKind e @@ -579,7 +579,7 @@ module ParsedInput = | SynExpr.TypeApp (e, _, tys, _, _, _, _) -> walkExprWithKind (Some EntityKind.Type) e |> Option.orElseWith (fun () -> List.tryPick walkType tys) | SynExpr.LetOrUse (_, _, bindings, e, _) -> List.tryPick walkBinding bindings |> Option.orElseWith (fun () -> walkExprWithKind parentKind e) - | SynExpr.TryWith (e, _, clauses, _, _, _, _) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> List.tryPick walkClause clauses) + | SynExpr.TryWith (tryExpr=e; withCases=clauses) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> List.tryPick walkClause clauses) | SynExpr.TryFinally (e1, e2, _, _, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] | SynExpr.Lazy (e, _) -> walkExprWithKind parentKind e | Sequentials es -> List.tryPick (walkExprWithKind parentKind) es @@ -603,8 +603,8 @@ module ParsedInput = | SynExpr.JoinIn (e1, _, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] | SynExpr.YieldOrReturn (_, e, _) -> walkExprWithKind parentKind e | SynExpr.YieldOrReturnFrom (_, e, _) -> walkExprWithKind parentKind e - | SynExpr.Match (_, e, synMatchClauseList, _) - | SynExpr.MatchBang (_, e, synMatchClauseList, _) -> + | SynExpr.Match (expr=e; clauses=synMatchClauseList) + | SynExpr.MatchBang (expr=e; clauses=synMatchClauseList) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> List.tryPick walkClause synMatchClauseList) | SynExpr.LetOrUseBang(rhs=e1; andBangs=es; body=e2) -> [ @@ -632,7 +632,7 @@ module ParsedInput = and walkField (SynField(Attributes attrs, _, _, t, _, _, _, _)) = List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> walkType t) - and walkValSig (SynValSig(Attributes attrs, _, _, t, _, _, _, _, _, _, _)) = + and walkValSig (SynValSig(attributes=Attributes attrs; synType=t)) = List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> walkType t) and walkMemberSig = function @@ -652,7 +652,7 @@ module ParsedInput = List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> List.tryPick walkSimplePat simplePats) | SynMemberDefn.ImplicitInherit(t, e, _, _) -> walkType t |> Option.orElseWith (fun () -> walkExpr e) | SynMemberDefn.LetBindings(bindings, _, _, _) -> List.tryPick walkBinding bindings - | SynMemberDefn.Interface(t, members, _) -> + | SynMemberDefn.Interface(interfaceType=t; members=members) -> walkType t |> Option.orElseWith (fun () -> members |> Option.bind (List.tryPick walkMember)) | SynMemberDefn.Inherit(t, _, _) -> walkType t | SynMemberDefn.ValField(field, _) -> walkField field @@ -1000,7 +1000,7 @@ module ParsedInput = | SynPat.LongIdent(longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> // let fo|o x = () Some CompletionContext.Invalid - | SynPat.LongIdent(_, _, _, ctorArgs, _, _) -> + | SynPat.LongIdent(argPats=ctorArgs) -> match ctorArgs with | SynArgPats.Pats pats -> pats |> List.tryPick (fun (SkipFromParseErrorPat pat) -> @@ -1211,7 +1211,7 @@ module ParsedInput = List.iter walkAttribute attrs | SynPat.As (pat1, pat2, _) | SynPat.Or (pat1, pat2, _) -> List.iter walkPat [pat1; pat2] - | SynPat.LongIdent (ident, _, typars, ConstructorPats pats, _, _) -> + | SynPat.LongIdent (longDotId=ident; typarDecls=typars; argPats=ConstructorPats pats) -> addLongIdentWithDots ident typars |> Option.iter (fun (ValTyparDecls (typars, constraints, _)) -> @@ -1231,7 +1231,7 @@ module ParsedInput = walkExpr e returnInfo |> Option.iter (fun (SynBindingReturnInfo (t, _, _)) -> walkType t) - and walkInterfaceImpl (SynInterfaceImpl(_, bindings, _)) = List.iter walkBinding bindings + and walkInterfaceImpl (SynInterfaceImpl(bindings=bindings)) = List.iter walkBinding bindings and walkType = function | SynType.Array (_, t, _) @@ -1292,7 +1292,7 @@ module ParsedInput = addLongIdentWithDots ident e |> Option.iter walkExpr) | SynExpr.Ident ident -> addIdent ident - | SynExpr.ObjExpr (ty, argOpt, bindings, ifaces, _, _) -> + | SynExpr.ObjExpr (objType=ty; argOptions=argOpt; bindings=bindings; extraImpls=ifaces) -> argOpt |> Option.iter (fun (e, ident) -> walkExpr e ident |> Option.iter addIdent) @@ -1308,14 +1308,14 @@ module ParsedInput = List.iter walkExpr [e1; e2] | SynExpr.MatchLambda (_, _, synMatchClauseList, _, _) -> List.iter walkClause synMatchClauseList - | SynExpr.Match (_, e, synMatchClauseList, _) -> + | SynExpr.Match (expr=e; clauses=synMatchClauseList) -> walkExpr e List.iter walkClause synMatchClauseList | SynExpr.TypeApp (e, _, tys, _, _, _, _) -> List.iter walkType tys; walkExpr e | SynExpr.LetOrUse (_, _, bindings, e, _) -> List.iter walkBinding bindings; walkExpr e - | SynExpr.TryWith (e, _, clauses, _, _, _, _) -> + | SynExpr.TryWith (tryExpr=e; withCases=clauses) -> List.iter walkClause clauses; walkExpr e | SynExpr.IfThenElse (_, _, e1, _, e2, _, e3, _, _, _, _) -> List.iter walkExpr [e1; e2] @@ -1387,7 +1387,7 @@ module ParsedInput = List.iter walkAttribute attrs walkType t - and walkValSig (SynValSig(Attributes attrs, _, _, t, SynValInfo(argInfos, argInfo), _, _, _, _, _, _)) = + and walkValSig (SynValSig(attributes=Attributes attrs; synType=t; arity=SynValInfo(argInfos, argInfo))) = List.iter walkAttribute attrs walkType t argInfo :: (argInfos |> List.concat) @@ -1404,7 +1404,7 @@ module ParsedInput = match repr with | SynTypeDefnSigRepr.Simple(SynTypeDefnSimpleRepr.TypeAbbrev _, _) | SynTypeDefnSigRepr.ObjectModel(SynTypeDefnKind.Abbrev, _, _) - | SynTypeDefnSigRepr.ObjectModel(SynTypeDefnKind.Augmentation, _, _) -> true + | SynTypeDefnSigRepr.ObjectModel(kind=SynTypeDefnKind.Augmentation _) -> true | _ -> false walkComponentInfo isTypeExtensionOrAlias info walkTypeDefnSigRepr repr @@ -1419,7 +1419,7 @@ module ParsedInput = List.iter walkSimplePat simplePats | SynMemberDefn.ImplicitInherit (t, e, _, _) -> walkType t; walkExpr e | SynMemberDefn.LetBindings (bindings, _, _, _) -> List.iter walkBinding bindings - | SynMemberDefn.Interface (t, members, _) -> + | SynMemberDefn.Interface (interfaceType=t; members=members) -> walkType t members |> Option.iter (List.iter walkMember) | SynMemberDefn.Inherit (t, _, _) -> walkType t @@ -1469,7 +1469,7 @@ module ParsedInput = and walkTypeDefn (SynTypeDefn (typeInfo=info; typeRepr=repr; members=members; implicitConstructor=implicitCtor)) = let isTypeExtensionOrAlias = match repr with - | SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation, _, _) + | SynTypeDefnRepr.ObjectModel (kind=SynTypeDefnKind.Augmentation _) | SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Abbrev, _, _) | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.TypeAbbrev _, _) -> true | _ -> false diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index 1977b9482ba..01e423d2a9c 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -270,8 +270,8 @@ module Structure = | SynExpr.LetOrUse (_, _, bindings, body, _) -> parseBindings bindings parseExpr body - | SynExpr.Match (seqPointAtBinding, _expr, clauses, r) - | SynExpr.MatchBang (seqPointAtBinding, _expr, clauses, r) -> + | SynExpr.Match (matchDebugPoint=seqPointAtBinding; clauses=clauses; range=r) + | SynExpr.MatchBang (matchDebugPoint=seqPointAtBinding; clauses=clauses; range=r) -> match seqPointAtBinding with | DebugPointAtBinding.Yes sr -> let collapse = Range.endToEnd sr r @@ -309,7 +309,7 @@ module Structure = parseExpr e | SynExpr.ComputationExpr (_, e, _r) as _c -> parseExpr e - | SynExpr.ObjExpr (_, argOpt, bindings, extraImpls, newRange, wholeRange) as _objExpr -> + | SynExpr.ObjExpr (argOptions=argOpt; bindings=bindings; extraImpls=extraImpls; newExprRange=newRange; range=wholeRange) as _objExpr -> match argOpt with | Some (args, _) -> let collapse = Range.endToEnd args.Range wholeRange @@ -319,7 +319,7 @@ module Structure = rcheck Scope.ObjExpr Collapse.Below wholeRange collapse parseBindings bindings parseExprInterfaces extraImpls - | SynExpr.TryWith (e, _, matchClauses, _, wholeRange, tryPoint, withPoint) -> + | SynExpr.TryWith (tryExpr=e; withCases=matchClauses; range=wholeRange; tryDebugPoint=tryPoint; withDebugPoint=withPoint) -> match tryPoint, withPoint with | DebugPointAtTry.Yes tryRange, DebugPointAtWith.Yes withRange -> let fullrange = Range.startToEnd tryRange wholeRange @@ -456,7 +456,7 @@ module Structure = and parseBindings sqs = for bind in sqs do parseBinding bind - and parseExprInterface (SynInterfaceImpl(synType, bindings, range)) = + and parseExprInterface (SynInterfaceImpl(interfaceTy=synType; bindings=bindings; range=range)) = let collapse = Range.endToEnd synType.Range range |> Range.modEnd -1 rcheck Scope.Interface Collapse.Below range collapse parseBindings bindings @@ -491,7 +491,7 @@ module Structure = parseBinding binding | SynMemberDefn.LetBindings (bindings, _, _, _) -> parseBindings bindings - | SynMemberDefn.Interface (tp, iMembers, r) -> + | SynMemberDefn.Interface (interfaceType=tp; members=iMembers; range=r) -> rcheck Scope.Interface Collapse.Below d.Range (Range.endToEnd tp.Range d.Range) match iMembers with | Some members -> List.iter (parseSynMemberDefn r) members @@ -539,7 +539,7 @@ module Structure = match objectModel with | SynTypeDefnRepr.ObjectModel (defnKind, objMembers, r) -> match defnKind with - | SynTypeDefnKind.Augmentation -> + | SynTypeDefnKind.Augmentation _ -> rcheck Scope.TypeExtension Collapse.Below fullrange collapse | _ -> rcheck Scope.Type Collapse.Below fullrange collapse @@ -765,7 +765,7 @@ module Structure = List.iter parseSynMemberDefnSig objMembers let fullrange, collapse = makeRanges objMembers rcheck Scope.Type Collapse.Below fullrange collapse - | SynTypeDefnSigRepr.ObjectModel (SynTypeDefnKind.Augmentation, objMembers, _) -> + | SynTypeDefnSigRepr.ObjectModel (kind=SynTypeDefnKind.Augmentation _; memberSigs=objMembers) -> let fullrange, collapse = makeRanges objMembers rcheck Scope.TypeExtension Collapse.Below fullrange collapse List.iter parseSynMemberDefnSig objMembers @@ -823,7 +823,7 @@ module Structure = let rec parseModuleSigDeclaration (decl: SynModuleSigDecl) = match decl with - | SynModuleSigDecl.Val (SynValSig(attrs, ident, _, _, _, _, _, _, _, _, valrange), r) -> + | SynModuleSigDecl.Val (SynValSig(attributes=attrs; ident=ident; range=valrange), r) -> let collapse = Range.endToEnd ident.idRange valrange rcheck Scope.Val Collapse.Below r collapse parseAttributes attrs diff --git a/src/fsharp/service/ServiceXmlDocParser.fs b/src/fsharp/service/ServiceXmlDocParser.fs index 5e35ce23751..8ff09483550 100644 --- a/src/fsharp/service/ServiceXmlDocParser.fs +++ b/src/fsharp/service/ServiceXmlDocParser.fs @@ -24,7 +24,7 @@ module XmlDocParsing = | SynPat.Named (id,_isTheThisVar,_access,_range) -> [id.idText] | SynPat.Typed(pat,_type,_range) -> digNamesFrom pat | SynPat.Attrib(pat,_attrs,_range) -> digNamesFrom pat - | SynPat.LongIdent(_lid,_idOpt,_typDeclsOpt,ConstructorPats pats,_access,_range) -> + | SynPat.LongIdent(argPats=ConstructorPats pats) -> pats |> List.collect digNamesFrom | SynPat.Tuple(_,pats,_range) -> pats |> List.collect digNamesFrom | SynPat.Paren(pat,_range) -> digNamesFrom pat @@ -122,7 +122,7 @@ module XmlDocParsing = let paramNames = digNamesFrom synPat [XmlDocable(line,indent,paramNames)] else [] - | SynMemberDefn.AbstractSlot(SynValSig(synAttributes, _, _, _, synValInfo, _, _, preXmlDoc, _, _, _), _, range) -> + | SynMemberDefn.AbstractSlot(SynValSig(attributes=synAttributes; arity=synValInfo; xmlDoc=preXmlDoc), _, range) -> if isEmptyXmlDoc preXmlDoc then let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) range let line = fullRange.StartLine @@ -130,7 +130,7 @@ module XmlDocParsing = let paramNames = synValInfo.ArgNames [XmlDocable(line,indent,paramNames)] else [] - | SynMemberDefn.Interface(_synType, synMemberDefnsOption, _range) -> + | SynMemberDefn.Interface(members=synMemberDefnsOption) -> match synMemberDefnsOption with | None -> [] | Some(x) -> x |> List.collect getXmlDocablesSynMemberDefn diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 49201d40170..d19284b9197 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -5651,6 +5651,25 @@ FSharp.Compiler.Syntax.PrettyNaming: System.String FormatAndOtherOverloadsString FSharp.Compiler.Syntax.PrettyNaming: System.String FsiDynamicModulePrefix FSharp.Compiler.Syntax.PrettyNaming: System.String NormalizeIdentifierBackticks(System.String) FSharp.Compiler.Syntax.PrettyNaming: System.String get_FsiDynamicModulePrefix() +FSharp.Compiler.Syntax.PropertyKeyword +FSharp.Compiler.Syntax.PropertyKeyword+And: FSharp.Compiler.Text.Range Item +FSharp.Compiler.Syntax.PropertyKeyword+And: FSharp.Compiler.Text.Range get_Item() +FSharp.Compiler.Syntax.PropertyKeyword+Tags: Int32 And +FSharp.Compiler.Syntax.PropertyKeyword+Tags: Int32 With +FSharp.Compiler.Syntax.PropertyKeyword+With: FSharp.Compiler.Text.Range Item +FSharp.Compiler.Syntax.PropertyKeyword+With: FSharp.Compiler.Text.Range get_Item() +FSharp.Compiler.Syntax.PropertyKeyword: Boolean IsAnd +FSharp.Compiler.Syntax.PropertyKeyword: Boolean IsWith +FSharp.Compiler.Syntax.PropertyKeyword: Boolean get_IsAnd() +FSharp.Compiler.Syntax.PropertyKeyword: Boolean get_IsWith() +FSharp.Compiler.Syntax.PropertyKeyword: FSharp.Compiler.Syntax.PropertyKeyword NewAnd(FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.PropertyKeyword: FSharp.Compiler.Syntax.PropertyKeyword NewWith(FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.PropertyKeyword: FSharp.Compiler.Syntax.PropertyKeyword+And +FSharp.Compiler.Syntax.PropertyKeyword: FSharp.Compiler.Syntax.PropertyKeyword+Tags +FSharp.Compiler.Syntax.PropertyKeyword: FSharp.Compiler.Syntax.PropertyKeyword+With +FSharp.Compiler.Syntax.PropertyKeyword: Int32 Tag +FSharp.Compiler.Syntax.PropertyKeyword: Int32 get_Tag() +FSharp.Compiler.Syntax.PropertyKeyword: System.String ToString() FSharp.Compiler.Syntax.QualifiedNameOfFile FSharp.Compiler.Syntax.QualifiedNameOfFile: FSharp.Compiler.Syntax.Ident Id FSharp.Compiler.Syntax.QualifiedNameOfFile: FSharp.Compiler.Syntax.Ident Item @@ -6133,13 +6152,15 @@ FSharp.Compiler.Syntax.SynExceptionDefnRepr: System.String ToString() FSharp.Compiler.Syntax.SynExceptionSig FSharp.Compiler.Syntax.SynExceptionSig: FSharp.Compiler.Syntax.SynExceptionDefnRepr exnRepr FSharp.Compiler.Syntax.SynExceptionSig: FSharp.Compiler.Syntax.SynExceptionDefnRepr get_exnRepr() -FSharp.Compiler.Syntax.SynExceptionSig: FSharp.Compiler.Syntax.SynExceptionSig NewSynExceptionSig(FSharp.Compiler.Syntax.SynExceptionDefnRepr, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberSig], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExceptionSig: FSharp.Compiler.Syntax.SynExceptionSig NewSynExceptionSig(FSharp.Compiler.Syntax.SynExceptionDefnRepr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberSig], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExceptionSig: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExceptionSig: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynExceptionSig: Int32 Tag FSharp.Compiler.Syntax.SynExceptionSig: Int32 get_Tag() FSharp.Compiler.Syntax.SynExceptionSig: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberSig] get_members() FSharp.Compiler.Syntax.SynExceptionSig: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberSig] members +FSharp.Compiler.Syntax.SynExceptionSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_withKeyword() +FSharp.Compiler.Syntax.SynExceptionSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] withKeyword FSharp.Compiler.Syntax.SynExceptionSig: System.String ToString() FSharp.Compiler.Syntax.SynExpr FSharp.Compiler.Syntax.SynExpr+AddressOf: Boolean get_isByref() @@ -6464,16 +6485,24 @@ FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Syntax.DebugPointAtBinding FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Syntax.DebugPointAtBinding matchDebugPoint FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Syntax.SynExpr expr FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Syntax.SynExpr get_expr() +FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Text.Range get_matchKeyword() FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Text.Range get_withKeyword() +FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Text.Range matchKeyword FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynExpr+Match: FSharp.Compiler.Text.Range withKeyword FSharp.Compiler.Syntax.SynExpr+Match: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause] clauses FSharp.Compiler.Syntax.SynExpr+Match: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause] get_clauses() FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Syntax.DebugPointAtBinding get_matchDebugPoint() FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Syntax.DebugPointAtBinding matchDebugPoint FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Syntax.SynExpr expr FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Syntax.SynExpr get_expr() +FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Text.Range get_matchKeyword() FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Text.Range get_withKeyword() +FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Text.Range matchKeyword FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynExpr+MatchBang: FSharp.Compiler.Text.Range withKeyword FSharp.Compiler.Syntax.SynExpr+MatchBang: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause] clauses FSharp.Compiler.Syntax.SynExpr+MatchBang: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause] get_clauses() FSharp.Compiler.Syntax.SynExpr+MatchLambda: Boolean get_isExnMatch() @@ -6514,6 +6543,8 @@ FSharp.Compiler.Syntax.SynExpr+ObjExpr: Microsoft.FSharp.Collections.FSharpList` FSharp.Compiler.Syntax.SynExpr+ObjExpr: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding] get_bindings() FSharp.Compiler.Syntax.SynExpr+ObjExpr: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynInterfaceImpl] extraImpls FSharp.Compiler.Syntax.SynExpr+ObjExpr: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynInterfaceImpl] get_extraImpls() +FSharp.Compiler.Syntax.SynExpr+ObjExpr: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_withKeyword() +FSharp.Compiler.Syntax.SynExpr+ObjExpr: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] withKeyword FSharp.Compiler.Syntax.SynExpr+ObjExpr: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident]]] argOptions FSharp.Compiler.Syntax.SynExpr+ObjExpr: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident]]] get_argOptions() FSharp.Compiler.Syntax.SynExpr+Paren: FSharp.Compiler.Syntax.SynExpr expr @@ -6658,10 +6689,14 @@ FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Syntax.DebugPointAtWith FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Syntax.SynExpr get_tryExpr() FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Syntax.SynExpr tryExpr FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range get_tryKeywordRange() FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range get_tryRange() +FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range get_withKeywordRange() FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range get_withRange() FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range tryKeywordRange FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range tryRange +FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range withKeywordRange FSharp.Compiler.Syntax.SynExpr+TryWith: FSharp.Compiler.Text.Range withRange FSharp.Compiler.Syntax.SynExpr+TryWith: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause] get_withCases() FSharp.Compiler.Syntax.SynExpr+TryWith: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause] withCases @@ -6898,13 +6933,13 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewLibraryOnlyUni FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewLibraryOnlyUnionCaseFieldSet(FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident], Int32, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewLongIdent(Boolean, FSharp.Compiler.Syntax.LongIdentWithDots, Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Core.FSharpRef`1[FSharp.Compiler.Syntax.SynSimplePatAlternativeIdInfo]], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewLongIdentSet(FSharp.Compiler.Syntax.LongIdentWithDots, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewMatch(FSharp.Compiler.Syntax.DebugPointAtBinding, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewMatchBang(FSharp.Compiler.Syntax.DebugPointAtBinding, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewMatch(FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtBinding, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewMatchBang(FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtBinding, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewMatchLambda(Boolean, FSharp.Compiler.Text.Range, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Syntax.DebugPointAtBinding, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewNamedIndexedPropertySet(FSharp.Compiler.Syntax.LongIdentWithDots, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewNew(Boolean, FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewNull(FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewObjExpr(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident]]], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynInterfaceImpl], FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewObjExpr(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident]]], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynInterfaceImpl], FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewParen(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewQuote(FSharp.Compiler.Syntax.SynExpr, Boolean, FSharp.Compiler.Syntax.SynExpr, Boolean, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewRecord(Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`5[FSharp.Compiler.Syntax.SynType,FSharp.Compiler.Syntax.SynExpr,FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]],FSharp.Compiler.Text.Range]], Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExprRecordField], FSharp.Compiler.Text.Range) @@ -6913,7 +6948,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSequentialOrIm FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSet(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTraitCall(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynTypar], FSharp.Compiler.Syntax.SynMemberSig, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryFinally(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtFinally) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryWith(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtWith) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryWith(FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtWith) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTuple(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTypeApp(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynType], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTypeTest(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Text.Range) @@ -7051,7 +7086,7 @@ FSharp.Compiler.Syntax.SynField: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Com FSharp.Compiler.Syntax.SynField: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess] get_accessibility() FSharp.Compiler.Syntax.SynField: System.String ToString() FSharp.Compiler.Syntax.SynInterfaceImpl -FSharp.Compiler.Syntax.SynInterfaceImpl: FSharp.Compiler.Syntax.SynInterfaceImpl NewSynInterfaceImpl(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynInterfaceImpl: FSharp.Compiler.Syntax.SynInterfaceImpl NewSynInterfaceImpl(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynInterfaceImpl: FSharp.Compiler.Syntax.SynType get_interfaceTy() FSharp.Compiler.Syntax.SynInterfaceImpl: FSharp.Compiler.Syntax.SynType interfaceTy FSharp.Compiler.Syntax.SynInterfaceImpl: FSharp.Compiler.Text.Range get_range() @@ -7060,6 +7095,8 @@ FSharp.Compiler.Syntax.SynInterfaceImpl: Int32 Tag FSharp.Compiler.Syntax.SynInterfaceImpl: Int32 get_Tag() FSharp.Compiler.Syntax.SynInterfaceImpl: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding] bindings FSharp.Compiler.Syntax.SynInterfaceImpl: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding] get_bindings() +FSharp.Compiler.Syntax.SynInterfaceImpl: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_withKeyword() +FSharp.Compiler.Syntax.SynInterfaceImpl: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] withKeyword FSharp.Compiler.Syntax.SynInterfaceImpl: System.String ToString() FSharp.Compiler.Syntax.SynInterpolatedStringPart FSharp.Compiler.Syntax.SynInterpolatedStringPart+FillExpr: FSharp.Compiler.Syntax.SynExpr fillExpr @@ -7213,6 +7250,8 @@ FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpO FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType] typeOpt FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] getSetRange FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_getSetRange() +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_withKeyword() +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] withKeyword FSharp.Compiler.Syntax.SynMemberDefn+ImplicitCtor: FSharp.Compiler.Syntax.SynSimplePats ctorArgs FSharp.Compiler.Syntax.SynMemberDefn+ImplicitCtor: FSharp.Compiler.Syntax.SynSimplePats get_ctorArgs() FSharp.Compiler.Syntax.SynMemberDefn+ImplicitCtor: FSharp.Compiler.Text.Range get_range() @@ -7243,6 +7282,8 @@ FSharp.Compiler.Syntax.SynMemberDefn+Interface: FSharp.Compiler.Syntax.SynType g FSharp.Compiler.Syntax.SynMemberDefn+Interface: FSharp.Compiler.Syntax.SynType interfaceType FSharp.Compiler.Syntax.SynMemberDefn+Interface: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynMemberDefn+Interface: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynMemberDefn+Interface: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_withKeyword() +FSharp.Compiler.Syntax.SynMemberDefn+Interface: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] withKeyword FSharp.Compiler.Syntax.SynMemberDefn+Interface: Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberDefn]] get_members() FSharp.Compiler.Syntax.SynMemberDefn+Interface: Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberDefn]] members FSharp.Compiler.Syntax.SynMemberDefn+LetBindings: Boolean get_isRecursive() @@ -7305,11 +7346,11 @@ FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsNestedType() FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsOpen() FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsValField() FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAbstractSlot(FSharp.Compiler.Syntax.SynValSig, FSharp.Compiler.Syntax.SynMemberFlags, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAutoProperty(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], Boolean, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType], FSharp.Compiler.Syntax.SynMemberKind, Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Syntax.SynMemberKind,FSharp.Compiler.Syntax.SynMemberFlags], FSharp.Compiler.Xml.PreXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAutoProperty(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], Boolean, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType], FSharp.Compiler.Syntax.SynMemberKind, Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Syntax.SynMemberKind,FSharp.Compiler.Syntax.SynMemberFlags], FSharp.Compiler.Xml.PreXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitCtor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynSimplePats, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitInherit(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInherit(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInterface(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberDefn]], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInterface(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberDefn]], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewLetBindings(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding], Boolean, Boolean, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewMember(FSharp.Compiler.Syntax.SynBinding, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewNestedType(FSharp.Compiler.Syntax.SynTypeDefn, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range) @@ -7803,6 +7844,8 @@ FSharp.Compiler.Syntax.SynPat+LongIdent: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynPat+LongIdent: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynPat+LongIdent: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident] extraId FSharp.Compiler.Syntax.SynPat+LongIdent: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident] get_extraId() +FSharp.Compiler.Syntax.SynPat+LongIdent: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.PropertyKeyword] get_propertyKeyword() +FSharp.Compiler.Syntax.SynPat+LongIdent: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.PropertyKeyword] propertyKeyword FSharp.Compiler.Syntax.SynPat+LongIdent: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess] accessibility FSharp.Compiler.Syntax.SynPat+LongIdent: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess] get_accessibility() FSharp.Compiler.Syntax.SynPat+LongIdent: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynValTyparDecls] get_typarDecls() @@ -7922,7 +7965,7 @@ FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewDeprecatedCharRa FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewFromParseError(FSharp.Compiler.Syntax.SynPat, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewInstanceMember(FSharp.Compiler.Syntax.Ident, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewIsInst(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewLongIdent(FSharp.Compiler.Syntax.LongIdentWithDots, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynValTyparDecls], FSharp.Compiler.Syntax.SynArgPats, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewLongIdent(FSharp.Compiler.Syntax.LongIdentWithDots, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.PropertyKeyword], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynValTyparDecls], FSharp.Compiler.Syntax.SynArgPats, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewNamed(FSharp.Compiler.Syntax.Ident, Boolean, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewNull(FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewOptionalVal(FSharp.Compiler.Syntax.Ident, FSharp.Compiler.Text.Range) @@ -8533,6 +8576,8 @@ FSharp.Compiler.Syntax.SynTypeDefn: Microsoft.FSharp.Core.FSharpOption`1[FSharp. FSharp.Compiler.Syntax.SynTypeDefn: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_equalsRange() FSharp.Compiler.Syntax.SynTypeDefn: System.String ToString() FSharp.Compiler.Syntax.SynTypeDefnKind +FSharp.Compiler.Syntax.SynTypeDefnKind+Augmentation: FSharp.Compiler.Text.Range get_withKeyword() +FSharp.Compiler.Syntax.SynTypeDefnKind+Augmentation: FSharp.Compiler.Text.Range withKeyword FSharp.Compiler.Syntax.SynTypeDefnKind+Delegate: FSharp.Compiler.Syntax.SynType get_signature() FSharp.Compiler.Syntax.SynTypeDefnKind+Delegate: FSharp.Compiler.Syntax.SynType signature FSharp.Compiler.Syntax.SynTypeDefnKind+Delegate: FSharp.Compiler.Syntax.SynValInfo get_signatureInfo() @@ -8571,10 +8616,10 @@ FSharp.Compiler.Syntax.SynTypeDefnKind: Boolean get_IsStruct() FSharp.Compiler.Syntax.SynTypeDefnKind: Boolean get_IsUnion() FSharp.Compiler.Syntax.SynTypeDefnKind: Boolean get_IsUnspecified() FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind Abbrev -FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind Augmentation FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind Class FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind IL FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind Interface +FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind NewAugmentation(FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind NewDelegate(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynValInfo) FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind Opaque FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind Record @@ -8582,7 +8627,6 @@ FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind S FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind Union FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind Unspecified FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind get_Abbrev() -FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind get_Augmentation() FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind get_Class() FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind get_IL() FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind get_Interface() @@ -8591,6 +8635,7 @@ FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind g FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind get_Struct() FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind get_Union() FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind get_Unspecified() +FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind+Augmentation FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind+Delegate FSharp.Compiler.Syntax.SynTypeDefnKind: FSharp.Compiler.Syntax.SynTypeDefnKind+Tags FSharp.Compiler.Syntax.SynTypeDefnKind: Int32 Tag @@ -8633,7 +8678,7 @@ FSharp.Compiler.Syntax.SynTypeDefnRepr: System.String ToString() FSharp.Compiler.Syntax.SynTypeDefnSig FSharp.Compiler.Syntax.SynTypeDefnSig: FSharp.Compiler.Syntax.SynComponentInfo get_typeInfo() FSharp.Compiler.Syntax.SynTypeDefnSig: FSharp.Compiler.Syntax.SynComponentInfo typeInfo -FSharp.Compiler.Syntax.SynTypeDefnSig: FSharp.Compiler.Syntax.SynTypeDefnSig NewSynTypeDefnSig(FSharp.Compiler.Syntax.SynComponentInfo, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Syntax.SynTypeDefnSigRepr, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberSig], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynTypeDefnSig: FSharp.Compiler.Syntax.SynTypeDefnSig NewSynTypeDefnSig(FSharp.Compiler.Syntax.SynComponentInfo, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Syntax.SynTypeDefnSigRepr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberSig], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynTypeDefnSig: FSharp.Compiler.Syntax.SynTypeDefnSigRepr get_typeRepr() FSharp.Compiler.Syntax.SynTypeDefnSig: FSharp.Compiler.Syntax.SynTypeDefnSigRepr typeRepr FSharp.Compiler.Syntax.SynTypeDefnSig: FSharp.Compiler.Text.Range Range @@ -8646,6 +8691,8 @@ FSharp.Compiler.Syntax.SynTypeDefnSig: Microsoft.FSharp.Collections.FSharpList`1 FSharp.Compiler.Syntax.SynTypeDefnSig: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberSig] members FSharp.Compiler.Syntax.SynTypeDefnSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] equalsRange FSharp.Compiler.Syntax.SynTypeDefnSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_equalsRange() +FSharp.Compiler.Syntax.SynTypeDefnSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_withKeyword() +FSharp.Compiler.Syntax.SynTypeDefnSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] withKeyword FSharp.Compiler.Syntax.SynTypeDefnSig: System.String ToString() FSharp.Compiler.Syntax.SynTypeDefnSigRepr FSharp.Compiler.Syntax.SynTypeDefnSigRepr+Exception: FSharp.Compiler.Syntax.SynExceptionDefnRepr get_repr() @@ -8855,7 +8902,7 @@ FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Syntax.SynValInfo SynInfo FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Syntax.SynValInfo arity FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Syntax.SynValInfo get_SynInfo() FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Syntax.SynValInfo get_arity() -FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Syntax.SynValSig NewSynValSig(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.Ident, FSharp.Compiler.Syntax.SynValTyparDecls, FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynValInfo, Boolean, Boolean, FSharp.Compiler.Xml.PreXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynExpr], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Syntax.SynValSig NewSynValSig(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.Ident, FSharp.Compiler.Syntax.SynValTyparDecls, FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynValInfo, Boolean, Boolean, FSharp.Compiler.Xml.PreXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynExpr], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Syntax.SynValTyparDecls explicitValDecls FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Syntax.SynValTyparDecls get_explicitValDecls() FSharp.Compiler.Syntax.SynValSig: FSharp.Compiler.Text.Range RangeOfId @@ -8872,6 +8919,8 @@ FSharp.Compiler.Syntax.SynValSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Co FSharp.Compiler.Syntax.SynValSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess] get_accessibility() FSharp.Compiler.Syntax.SynValSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynExpr] get_synExpr() FSharp.Compiler.Syntax.SynValSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynExpr] synExpr +FSharp.Compiler.Syntax.SynValSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_withKeyword() +FSharp.Compiler.Syntax.SynValSig: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] withKeyword FSharp.Compiler.Syntax.SynValSig: System.String ToString() FSharp.Compiler.Syntax.SynValTyparDecls FSharp.Compiler.Syntax.SynValTyparDecls: Boolean canInfer @@ -10547,4 +10596,4 @@ FSharp.Compiler.Xml.XmlDoc: System.String GetXmlText() FSharp.Compiler.Xml.XmlDoc: System.String[] GetElaboratedXmlLines() FSharp.Compiler.Xml.XmlDoc: System.String[] UnprocessedLines FSharp.Compiler.Xml.XmlDoc: System.String[] get_UnprocessedLines() -FSharp.Compiler.Xml.XmlDoc: Void .ctor(System.String[], FSharp.Compiler.Text.Range) +FSharp.Compiler.Xml.XmlDoc: Void .ctor(System.String[], FSharp.Compiler.Text.Range) \ No newline at end of file diff --git a/tests/fsharp/typecheck/sigs/neg103.bsl b/tests/fsharp/typecheck/sigs/neg103.bsl index d2a0cc1220d..bd0e3db1a8a 100644 --- a/tests/fsharp/typecheck/sigs/neg103.bsl +++ b/tests/fsharp/typecheck/sigs/neg103.bsl @@ -19,7 +19,7 @@ neg103.fs(21,7,21,9): typecheck error FS0001: This expression was expected to ha but here has type 'int' -neg103.fs(20,5,20,29): typecheck error FS0025: Incomplete pattern matches on this expression. +neg103.fs(20,5,20,11): typecheck error FS0025: Incomplete pattern matches on this expression. neg103.fs(25,11,25,19): typecheck error FS0001: This expression was expected to have type 'int' diff --git a/tests/fsharp/typecheck/sigs/neg103.vsbsl b/tests/fsharp/typecheck/sigs/neg103.vsbsl index d2a0cc1220d..bd0e3db1a8a 100644 --- a/tests/fsharp/typecheck/sigs/neg103.vsbsl +++ b/tests/fsharp/typecheck/sigs/neg103.vsbsl @@ -19,7 +19,7 @@ neg103.fs(21,7,21,9): typecheck error FS0001: This expression was expected to ha but here has type 'int' -neg103.fs(20,5,20,29): typecheck error FS0025: Incomplete pattern matches on this expression. +neg103.fs(20,5,20,11): typecheck error FS0025: Incomplete pattern matches on this expression. neg103.fs(25,11,25,19): typecheck error FS0001: This expression was expected to have type 'int' diff --git a/tests/fsharp/typecheck/sigs/neg104.vsbsl b/tests/fsharp/typecheck/sigs/neg104.vsbsl index 87d4a4e89db..89206431139 100644 --- a/tests/fsharp/typecheck/sigs/neg104.vsbsl +++ b/tests/fsharp/typecheck/sigs/neg104.vsbsl @@ -23,9 +23,9 @@ neg104.fs(8,9,8,30): typecheck error FS0750: This construct may only be used wit neg104.fs(10,9,10,30): typecheck error FS0750: This construct may only be used within computation expressions -neg104.fs(20,9,20,22): typecheck error FS0025: Incomplete pattern matches on this expression. +neg104.fs(20,9,20,15): typecheck error FS0025: Incomplete pattern matches on this expression. -neg104.fs(23,9,23,22): typecheck error FS0025: Incomplete pattern matches on this expression. +neg104.fs(23,9,23,15): typecheck error FS0025: Incomplete pattern matches on this expression. neg104.fs(32,21,32,26): typecheck error FS0003: This value is not a function and cannot be applied. diff --git a/tests/fsharp/typecheck/sigs/neg59.bsl b/tests/fsharp/typecheck/sigs/neg59.bsl index c4f55d1e06b..fc509efa297 100644 --- a/tests/fsharp/typecheck/sigs/neg59.bsl +++ b/tests/fsharp/typecheck/sigs/neg59.bsl @@ -21,9 +21,9 @@ neg59.fs(49,15,49,27): typecheck error FS3090: An if/then/else expression may no neg59.fs(56,15,56,27): typecheck error FS3090: An if/then/else expression may not be used within queries. Consider using either an if/then expression, or use a sequence expression instead. -neg59.fs(63,15,63,27): typecheck error FS3163: 'match' expressions may not be used in queries +neg59.fs(63,15,63,20): typecheck error FS3163: 'match' expressions may not be used in queries -neg59.fs(69,15,69,27): typecheck error FS3163: 'match' expressions may not be used in queries +neg59.fs(69,15,69,20): typecheck error FS3163: 'match' expressions may not be used in queries neg59.fs(76,15,76,18): typecheck error FS3146: 'try/with' expressions may not be used in queries diff --git a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_MismatchedConditionalBranches01.fs b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_MismatchedConditionalBranches01.fs index 9152801f873..7066abe0da6 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_MismatchedConditionalBranches01.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_MismatchedConditionalBranches01.fs @@ -1,6 +1,6 @@ // #Conformance #DataExpressions #Query #Regression // DevDiv:196007, this used to throw -//'match' expressions may not be used in queries$ +//'match' expressions may not be used in queries$ let x = query { diff --git a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_MismatchedConditionalBranches02.fs b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_MismatchedConditionalBranches02.fs index 66be1818bac..bc4e2a0280a 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_MismatchedConditionalBranches02.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_MismatchedConditionalBranches02.fs @@ -1,5 +1,5 @@ // #Conformance #DataExpressions #Query #Regression -//'match' expressions may not be used in queries$ +//'match' expressions may not be used in queries$ let q10 = query { for i in [1..10] do diff --git a/tests/service/ParserTests.fs b/tests/service/ParserTests.fs index e90888280b8..a53ec060ab6 100644 --- a/tests/service/ParserTests.fs +++ b/tests/service/ParserTests.fs @@ -52,7 +52,7 @@ match () with | x """ match getSingleExprInModule parseResults with - | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.ArbitraryAfterError _, _, _) ], _) -> () + | SynExpr.Match (clauses=[ SynMatchClause (resultExpr=SynExpr.ArbitraryAfterError _) ]) -> () | _ -> failwith "Unexpected tree" @@ -64,7 +64,7 @@ match () with """ match getSingleExprInModule parseResults with - | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.ArbitraryAfterError _, _, _) ], _) -> () + | SynExpr.Match (clauses=[ SynMatchClause (resultExpr=SynExpr.ArbitraryAfterError _) ]) -> () | _ -> failwith "Unexpected tree" [] @@ -76,7 +76,7 @@ match () with """ match getSingleExprInModule parseResults with - | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.ArbitraryAfterError _, _, _); _ ], _) -> () + | SynExpr.Match (clauses=[ SynMatchClause (resultExpr=SynExpr.ArbitraryAfterError _); _ ]) -> () | _ -> failwith "Unexpected tree" [] @@ -88,7 +88,7 @@ match () with """ match getSingleExprInModule parseResults with - | SynExpr.Match (_, _, [ SynMatchClause (SynPat.Or _, _, _, SynExpr.Const _, _, _) ], _) -> () + | SynExpr.Match (clauses=[ SynMatchClause (SynPat.Or _, _, _, SynExpr.Const _, _, _) ]) -> () | _ -> failwith "Unexpected tree" [] @@ -100,8 +100,8 @@ match () with """ match getSingleExprInModule parseResults with - | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.ArbitraryAfterError _, _, _) - SynMatchClause (_, _, _, SynExpr.Const _, _, _) ], _) -> () + | SynExpr.Match (clauses=[ SynMatchClause (resultExpr=SynExpr.ArbitraryAfterError _) + SynMatchClause (resultExpr=SynExpr.Const _) ]) -> () | _ -> failwith "Unexpected tree" [] @@ -113,7 +113,7 @@ match () with """ match getSingleExprInModule parseResults with - | SynExpr.Match (_, _, [ SynMatchClause (pat = pat) ], _) -> + | SynExpr.Match (clauses=[ SynMatchClause (pat=pat) ]) -> match pat with | SynPat.FromParseError (SynPat.Paren (SynPat.Or (SynPat.Named _, SynPat.Named _, _), _), _) -> () | _ -> failwith "Unexpected pattern" @@ -128,7 +128,7 @@ match () with """ match getSingleExprInModule parseResults with - | SynExpr.Match (_, _, [ SynMatchClause (pat = pat) ], _) -> + | SynExpr.Match (clauses=[ SynMatchClause (pat=pat) ]) -> match pat with | SynPat.Or (SynPat.FromParseError (SynPat.Paren (SynPat.FromParseError (SynPat.Wild _, _), _), _), @@ -158,7 +158,7 @@ let f (x match getSingleDeclInModule parseResults with | SynModuleDecl.Let (_, [ SynBinding (headPat = headPat) ], _) -> match headPat with - | SynPat.LongIdent (_, _, _, SynArgPats.Pats [ SynPat.FromParseError (SynPat.Paren (SynPat.Named _, _), _) ], _, _) -> () + | SynPat.LongIdent (argPats=SynArgPats.Pats [ SynPat.FromParseError (SynPat.Paren (SynPat.Named _, _), _) ]) -> () | _ -> failwith "Unexpected tree" | _ -> failwith "Unexpected tree" @@ -171,7 +171,7 @@ let f (x, y match getSingleDeclInModule parseResults with | SynModuleDecl.Let (_, [ SynBinding (headPat = headPat) ], _) -> match headPat with - | SynPat.LongIdent (_, _, _, SynArgPats.Pats [ SynPat.FromParseError (SynPat.Paren (SynPat.Tuple _, _), _) ], _, _) -> () + | SynPat.LongIdent (argPats=SynArgPats.Pats [ SynPat.FromParseError (SynPat.Paren (SynPat.Tuple _, _), _) ]) -> () | _ -> failwith "Unexpected tree" | _ -> failwith "Unexpected tree" diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index d1d753904d6..2c3bf311292 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -453,6 +453,152 @@ type Person(name : string, age : int) = assertRange (5, 20) (5, 21) mEquals | _ -> Assert.Fail "Could not get valid AST" + [] + let ``SynTypeDefn with Augmentation contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Int32 with + member _.Zero = 0 +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind=SynTypeDefnKind.Augmentation mWithKeyword)) ] + ) + ]) ])) -> + assertRange (2, 11) (2, 15) mWithKeyword + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``SynMemberDefn.Interface contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + interface Bar with + member Meh () = () + interface Other +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members=[ SynMemberDefn.ImplicitCtor _ + SynMemberDefn.Interface(withKeyword=Some mWithKeyword) + SynMemberDefn.Interface(withKeyword=None) ])) ] + ) + ]) ])) -> + assertRange (3, 18) (3, 22) mWithKeyword + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``SynTypeDefn with AutoProperty contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + member val AutoProperty = autoProp with get, set + member val AutoProperty2 = autoProp +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ + SynMemberDefn.AutoProperty(withKeyword=Some mWith) + SynMemberDefn.AutoProperty(withKeyword=None)])) ] + ) + ]) ])) -> + assertRange (3, 39) (3, 43) mWith + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``SynTypeDefn with AbstractSlot contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + abstract member Bar : int with get,set +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ + SynMemberDefn.AbstractSlot(slotSig=SynValSig(withKeyword=Some mWith))])) ] + ) + ]) ])) -> + assertRange (3, 30) (3, 34) mWith + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``read-only property in SynMemberDefn.Member contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + // A read-only property. + member this.MyReadProperty with get () = myInternalValue +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = + SynTypeDefnRepr.ObjectModel(members=[ _ + SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(propertyKeyword=Some(PropertyKeyword.With mWith)))) ]) + ) ]) + ]) ])) -> + assertRange (4, 31) (4, 35) mWith + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``write-only property in SynMemberDefn.Member contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + // A write-only property. + member this.MyWriteOnlyProperty with set (value) = myInternalValue <- value +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = + SynTypeDefnRepr.ObjectModel(members=[ _ + SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(propertyKeyword=Some(PropertyKeyword.With mWith)))) ]) + ) ]) + ]) ])) -> + assertRange (4, 36) (4, 40) mWith + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``read/write property in SynMemberDefn.Member contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + // A read-write property. + member this.MyReadWriteProperty + with get () = myInternalValue + and set (value) = myInternalValue <- value +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = + SynTypeDefnRepr.ObjectModel(members=[ _ + SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(propertyKeyword=Some(PropertyKeyword.With mWith)))) + SynMemberDefn.Member _ ]) + ) ]) + ]) ])) -> + assertRange (5, 8) (5, 12) mWith + | _ -> Assert.Fail "Could not get valid AST" + module SyntaxExpressions = [] let ``SynExpr.Do contains the range of the do keyword`` () = @@ -617,6 +763,91 @@ for i = 1 to 10 do assertRange (2, 6) (2, 7) mEquals | _ -> Assert.Fail "Could not get valid AST" + [] + let ``SynExpr.TryWith contains the range of the try and with keyword`` () = + let ast = + """ +try + x +with +| ex -> y +""" + |> getParseResults + + match ast with + | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.DoExpr(expr = + SynExpr.TryWith(tryKeywordRange=mTry; withKeywordRange=mWith)) + ]) + ])) -> + assertRange (2, 0) (2, 3) mTry + assertRange (4, 0) (4, 4) mWith + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``SynExpr.Match contains the range of the match and with keyword`` () = + let ast = + """ +match x with +| y -> z +""" + |> getParseResults + + match ast with + | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.DoExpr(expr = + SynExpr.Match(matchKeyword=mMatch; withKeyword=mWith)) + ]) + ])) -> + assertRange (2, 0) (2, 5) mMatch + assertRange (2, 8) (2, 12) mWith + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``SynExpr.MatchBang contains the range of the match and with keyword`` () = + let ast = + """ +match! x with +| y -> z +""" + |> getParseResults + + match ast with + | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.DoExpr(expr = + SynExpr.MatchBang(matchKeyword=mMatch; withKeyword=mWith)) + ]) + ])) -> + assertRange (2, 0) (2, 6) mMatch + assertRange (2, 9) (2, 13) mWith + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``SynExpr.ObjExpr contains the range of with keyword`` () = + let ast = + """ +{ new obj() with + member x.ToString() = "INotifyEnumerableInternal" + interface INotifyEnumerableInternal<'T> + interface IEnumerable<_> with + member x.GetEnumerator() = null } +""" + |> getParseResults + + match ast with + | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.DoExpr(expr = + SynExpr.ObjExpr(withKeyword=Some mWithObjExpr; extraImpls=[ SynInterfaceImpl(withKeyword=None); SynInterfaceImpl(withKeyword=Some mWithSynInterfaceImpl) ])) + ]) + ])) -> + assertRange (2, 12) (2, 16) mWithObjExpr + assertRange (5, 27) (5, 31) mWithSynInterfaceImpl + | _ -> Assert.Fail "Could not get valid AST" + module Strings = let getBindingExpressionValue (parseResults: ParsedInput) = match parseResults with @@ -1121,6 +1352,67 @@ type Shape = assertRange (4, 11) (4, 12) mEquals | _ -> Assert.Fail "Could not get valid AST" + [] + let ``SynTypeDefnSig should contains the range of the with keyword`` () = + let parseResults = + getParseResultsOfSignatureFile + """ +namespace X + +type Foo with + member Meh : unit -> unit +""" + + match parseResults with + | ParsedInput.SigFile (ParsedSigFileInput (modules =[ SynModuleOrNamespaceSig(decls =[ + SynModuleSigDecl.Types( + types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.Simple _ + withKeyword=Some mWithKeyword) ] + ) + ]) ])) -> + assertRange (4, 9) (4, 13) mWithKeyword + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``SynExceptionSig should contains the range of the with keyword`` () = + let parseResults = + getParseResultsOfSignatureFile + """ +namespace X + +exception Foo with + member Meh : unit -> unit +""" + + match parseResults with + | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + SynModuleSigDecl.Exception( + exnSig=SynExceptionSig(withKeyword = Some mWithKeyword) + ) + ]) ])) -> + assertRange (4, 14) (4, 18) mWithKeyword + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``memberSig of SynMemberSig.Member should contains the range of the with keyword`` () = + let parseResults = + getParseResultsOfSignatureFile + """ +namespace X + +type Foo = + abstract member Bar : int with get,set +""" + + match parseResults with + | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + SynModuleSigDecl.Types( + types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.ObjectModel(memberSigs=[SynMemberSig.Member(memberSig=SynValSig(withKeyword=Some mWithKeyword))])) ] + ) + ]) ])) -> + assertRange (5, 30) (5, 34) mWithKeyword + | _ -> Assert.Fail "Could not get valid AST" + module SynMatchClause = [] let ``Range of single SynMatchClause`` () = diff --git a/vsintegration/src/FSharp.Editor/Common/FSharpCodeAnalysisExtensions.fs b/vsintegration/src/FSharp.Editor/Common/FSharpCodeAnalysisExtensions.fs index 1224200fbcb..02029e11f21 100644 --- a/vsintegration/src/FSharp.Editor/Common/FSharpCodeAnalysisExtensions.fs +++ b/vsintegration/src/FSharp.Editor/Common/FSharpCodeAnalysisExtensions.fs @@ -20,7 +20,7 @@ type FSharpParseFileResults with else // Check if it's an operator match pat with - | SynPat.LongIdent(LongIdentWithDots([id], _), _, _, _, _, _) when id.idText.StartsWith("op_") -> + | SynPat.LongIdent(longDotId=LongIdentWithDots([id], _)) when id.idText.StartsWith("op_") -> if Position.posEq id.idRange.Start pos then Some binding.RangeOfBindingWithRhs else From 8faf123f625c17ebca2d8acb04b8ef2df2c41715 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 20 Nov 2021 02:24:01 +0000 Subject: [PATCH 09/26] Fixes 12414: int32 --> Nullable Int64 additional implicit conversion (#12423) * add tests * add more tests --- src/fsharp/MethodCalls.fs | 6 +- .../compilation.errors.output.bsl | 72 +++-- .../compilation.langversion.old.output.bsl | 281 +++++++++++++++++- tests/fsharp/core/fsfromfsviacs/lib3.cs | 26 ++ tests/fsharp/core/fsfromfsviacs/test.fsx | 65 +++- tests/fsharp/core/quotes/test.fsx | 3 - tests/fsharp/tests.fs | 32 +- 7 files changed, 427 insertions(+), 58 deletions(-) diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 818d0127214..7d93e93ea26 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -1462,7 +1462,8 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: else let calledNonOptTy = destNullableTy g calledArgTy let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr - MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy callerArgExpr2 m + let callerArgTy2 = tyOfExpr g callerArgExpr2 + MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy2 callerArgExpr2 m else failwith "unreachable" // see case above @@ -1493,7 +1494,8 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: // CSharpMethod(x=b) when 'x' has nullable type and 'b' does not --> CSharpMethod(x=Nullable(b)) let calledNonOptTy = destNullableTy g calledArgTy let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr - MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy callerArgExpr2 m + let callerArgTy2 = tyOfExpr g callerArgExpr2 + MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy2 callerArgExpr2 m else // CSharpMethod(x=b) --> CSharpMethod(?x=b) let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledArgTy reflArgInfo callerArgTy m callerArgExpr diff --git a/tests/fsharp/core/fsfromfsviacs/compilation.errors.output.bsl b/tests/fsharp/core/fsfromfsviacs/compilation.errors.output.bsl index 8e846a78b70..4c76cf6f127 100644 --- a/tests/fsharp/core/fsfromfsviacs/compilation.errors.output.bsl +++ b/tests/fsharp/core/fsfromfsviacs/compilation.errors.output.bsl @@ -1,10 +1,10 @@ -test.fsx(217,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(216,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(218,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(217,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: x: int @@ -12,7 +12,7 @@ Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(219,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(218,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: y: string @@ -20,7 +20,7 @@ Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(220,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(219,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: x: int option @@ -28,7 +28,7 @@ Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(221,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(220,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: y: string option @@ -36,7 +36,7 @@ Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(222,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(221,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: x: 'a option @@ -44,7 +44,7 @@ Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(223,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(222,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: y: 'a option @@ -52,7 +52,7 @@ Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(224,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(223,34): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: 'a option @@ -60,7 +60,7 @@ Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(227,42): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(226,42): error FS0041: A unique overload for method 'OverloadedMethodTakingOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: 'a0 @@ -68,12 +68,12 @@ Candidates: - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int -test.fsx(229,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(228,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(230,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(229,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: y: string @@ -81,7 +81,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(231,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(230,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: Nullable @@ -89,7 +89,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(232,36): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(231,36): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: float @@ -97,7 +97,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(233,36): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(232,36): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: float option @@ -105,7 +105,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(234,36): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(233,36): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: x: 'a option @@ -113,7 +113,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(235,36): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(234,36): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: 'a option @@ -121,7 +121,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(237,43): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(236,43): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionalsWithDefaults' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: 'a0 @@ -129,12 +129,12 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(239,34): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(238,34): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(240,34): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(239,34): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: y: string @@ -142,7 +142,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(241,33): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(240,33): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: float @@ -150,7 +150,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(242,34): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(241,34): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: Nullable @@ -158,7 +158,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(243,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(242,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: float @@ -166,7 +166,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(244,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(243,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: float option @@ -174,7 +174,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(245,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(244,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: x: 'a option @@ -182,7 +182,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(246,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(245,35): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: d: 'a option @@ -190,7 +190,7 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(247,42): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(246,42): error FS0041: A unique overload for method 'OverloadedMethodTakingNullableOptionals' could not be determined based on type information prior to this program point. A type annotation may be needed. Known type of argument: 'a0 @@ -198,9 +198,9 @@ Candidates: - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int -test.fsx(249,93): error FS0691: Named arguments must appear after all other arguments +test.fsx(248,93): error FS0691: Named arguments must appear after all other arguments -test.fsx(250,88): error FS0041: A unique overload for method 'OverloadedMethodTakingNullables' could not be determined based on type information prior to this program point. A type annotation may be needed. +test.fsx(249,88): error FS0041: A unique overload for method 'OverloadedMethodTakingNullables' could not be determined based on type information prior to this program point. A type annotation may be needed. Known types of arguments: Nullable<'a> * string * Nullable<'b> when 'a: (new: unit -> 'a) and 'a: struct and 'a :> ValueType and 'b: (new: unit -> 'b) and 'b: struct and 'b :> ValueType @@ -208,6 +208,18 @@ Candidates: - SomeClass.OverloadedMethodTakingNullables(x: Nullable, y: string, d: Nullable) : int - SomeClass.OverloadedMethodTakingNullables(x: Nullable, y: string, d: Nullable) : int -test.fsx(267,15): warning FS0025: Incomplete pattern matches on this expression. For example, the value 'U2 (_, U1 (_, "a"))' may indicate a case not covered by the pattern(s). +test.fsx(266,15): warning FS0025: Incomplete pattern matches on this expression. For example, the value 'U2 (_, U1 (_, "a"))' may indicate a case not covered by the pattern(s). + +test.fsx(283,15): warning FS0025: Incomplete pattern matches on this expression. For example, the value 'U2 (_, U1 (_, "a"))' may indicate a case not covered by the pattern(s). + +test.fsx(457,94): error FS0193: Type constraint mismatch. The type + 'Nullable' +is not compatible with type + 'Nullable' + + +test.fsx(458,82): error FS0193: Type constraint mismatch. The type + 'Nullable' +is not compatible with type + 'Nullable' -test.fsx(284,15): warning FS0025: Incomplete pattern matches on this expression. For example, the value 'U2 (_, U1 (_, "a"))' may indicate a case not covered by the pattern(s). diff --git a/tests/fsharp/core/fsfromfsviacs/compilation.langversion.old.output.bsl b/tests/fsharp/core/fsfromfsviacs/compilation.langversion.old.output.bsl index 10932d2ab4a..1dfbb6c1150 100644 --- a/tests/fsharp/core/fsfromfsviacs/compilation.langversion.old.output.bsl +++ b/tests/fsharp/core/fsfromfsviacs/compilation.langversion.old.output.bsl @@ -118,11 +118,286 @@ is not compatible with type 'Nullable' -test.fsx(267,15): warning FS0025: Incomplete pattern matches on this expression. For example, the value 'U2 (_, U1 (_, "a"))' may indicate a case not covered by the pattern(s). +test.fsx(152,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(152,79): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(153,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(154,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(155,89): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(156,88): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(158,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(158,81): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(159,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(160,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(161,91): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(162,90): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(164,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(164,83): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(165,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(166,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(167,93): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(168,92): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(170,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(170,83): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(171,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(172,66): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(173,93): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(174,92): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'float' + +test.fsx(190,34): error FS0041: No overloads match for method 'OverloadedMethodTakingOptionals'. + +Known type of argument: d: float option + +Available overloads: + - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float) : int // Argument 'd' doesn't match + - SomeClass.OverloadedMethodTakingOptionals(?x: int, ?y: string, ?d: float32) : int // Argument 'd' doesn't match + +test.fsx(192,34): error FS0041: No overloads match for method 'OverloadedMethodTakingNullableOptionalsWithDefaults'. + +Known type of argument: x: int + +Available overloads: + - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + +test.fsx(197,35): error FS0041: No overloads match for method 'OverloadedMethodTakingNullableOptionalsWithDefaults'. + +Known type of argument: x: int + +Available overloads: + - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + +test.fsx(200,35): error FS0041: No overloads match for method 'OverloadedMethodTakingNullableOptionalsWithDefaults'. + +Known type of argument: x: int option + +Available overloads: + - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + - SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match -test.fsx(284,15): warning FS0025: Incomplete pattern matches on this expression. For example, the value 'U2 (_, U1 (_, "a"))' may indicate a case not covered by the pattern(s). +test.fsx(202,34): error FS0041: No overloads match for method 'OverloadedMethodTakingNullableOptionals'. -test.fsx(418,29): error FS0041: A unique overload for method 'SimpleOverload' could not be determined based on type information prior to this program point. A type annotation may be needed. +Known type of argument: x: int + +Available overloads: + - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + +test.fsx(207,35): error FS0041: No overloads match for method 'OverloadedMethodTakingNullableOptionals'. + +Known type of argument: x: int + +Available overloads: + - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + - SomeClass.OverloadedMethodTakingNullableOptionals(?x: Nullable, ?y: string, ?d: Nullable) : int // Argument 'x' doesn't match + +test.fsx(209,35): error FS0041: No overloads match for method 'OverloadedMethodTakingNullables'. + +Known types of arguments: int * string * float + +Available overloads: + - SomeClass.OverloadedMethodTakingNullables(x: Nullable, y: string, d: Nullable) : int // Argument 'x' doesn't match + - SomeClass.OverloadedMethodTakingNullables(x: Nullable, y: string, d: Nullable) : int // Argument 'x' doesn't match + +test.fsx(210,35): error FS0041: No overloads match for method 'OverloadedMethodTakingNullables'. + +Known types of arguments: Nullable * string * float + +Available overloads: + - SomeClass.OverloadedMethodTakingNullables(x: Nullable, y: string, d: Nullable) : int // Argument 'x' doesn't match + - SomeClass.OverloadedMethodTakingNullables(x: Nullable, y: string, d: Nullable) : int // Argument 'd' doesn't match + +test.fsx(266,15): warning FS0025: Incomplete pattern matches on this expression. For example, the value 'U2 (_, U1 (_, "a"))' may indicate a case not covered by the pattern(s). + +test.fsx(283,15): warning FS0025: Incomplete pattern matches on this expression. For example, the value 'U2 (_, U1 (_, "a"))' may indicate a case not covered by the pattern(s). + +test.fsx(417,29): error FS0041: A unique overload for method 'SimpleOverload' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: - SomeClass.SimpleOverload(?x: Nullable) : int - SomeClass.SimpleOverload(?x: int) : int + +test.fsx(431,74): error FS0001: This expression was expected to have type + 'int64' +but here has type + 'int' + +test.fsx(432,75): error FS0193: Type constraint mismatch. The type + 'int option' +is not compatible with type + 'int64' + + +test.fsx(434,75): error FS0193: Type constraint mismatch. The type + 'int64 option' +is not compatible with type + 'int64' + + +test.fsx(438,94): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(439,95): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(440,96): error FS0193: Type constraint mismatch. The type + 'int option' +is not compatible with type + 'Nullable' + + +test.fsx(441,94): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int64' + +test.fsx(443,95): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int64' + +test.fsx(444,96): error FS0193: Type constraint mismatch. The type + 'int64 option' +is not compatible with type + 'Nullable' + + +test.fsx(447,82): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(448,83): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(449,84): error FS0193: Type constraint mismatch. The type + 'int option' +is not compatible with type + 'Nullable' + + +test.fsx(450,82): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int64' + +test.fsx(452,83): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int64' + +test.fsx(453,84): error FS0193: Type constraint mismatch. The type + 'int64 option' +is not compatible with type + 'Nullable' + + +test.fsx(467,24): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' + +test.fsx(471,24): error FS0001: This expression was expected to have type + 'Nullable' +but here has type + 'int' diff --git a/tests/fsharp/core/fsfromfsviacs/lib3.cs b/tests/fsharp/core/fsfromfsviacs/lib3.cs index ee7ed96c52c..a2c1bf8c618 100644 --- a/tests/fsharp/core/fsfromfsviacs/lib3.cs +++ b/tests/fsharp/core/fsfromfsviacs/lib3.cs @@ -34,10 +34,18 @@ public static int MethodTakingOptionals(int x = 3, string y = "abc", double d = { return x + y.Length + (int) d; } + public static long MethodTakingOptionalsInt64(long x = 3, string y = "abc", double d = 5.0) + { + return x + y.Length + (int) d; + } public static int MethodTakingNullableOptionalsWithDefaults(int? x = 3, string y = "abc", double? d = 5.0) { return (x.HasValue ? x.Value : -100) + y.Length + (int) (d.HasValue ? d.Value : 0.0); } + public static long MethodTakingNullableOptionalsWithDefaultsInt64(long? x = 3, string y = "abc", double? d = 5.0) + { + return (x.HasValue ? x.Value : -100) + y.Length + (int) (d.HasValue ? d.Value : 0.0); + } public static int MethodTakingNullableOptionals(int? x = null, string y = null, double? d = null) { int length; @@ -47,6 +55,15 @@ public static int MethodTakingNullableOptionals(int? x = null, string y = null, length = y.Length; return (x.HasValue ? x.Value : -1) + length + (int) (d.HasValue ? d.Value : -1.0); } + public static long MethodTakingNullableOptionalsInt64(long? x = null, string y = null, double? d = null) + { + int length; + if (y == null) + length = -1; + else + length = y.Length; + return (x.HasValue ? x.Value : -1) + length + (int) (d.HasValue ? d.Value : -1.0); + } public static int OverloadedMethodTakingOptionals(int x = 3, string y = "abc", double d = 5.0) { return x + y.Length + (int) d; @@ -91,6 +108,15 @@ public static int MethodTakingNullables(int? x, string y, double? d) return (x.HasValue ? x.Value : -1) + length + (int) (d.HasValue ? d.Value : -1.0); } + public static long MethodTakingNullablesInt64(long? x, string y, double? d) + { + int length; + if (y == null) + length = -1; + else + length = y.Length; + return (x.HasValue ? x.Value : -1) + length + (int) (d.HasValue ? d.Value : -1.0); + } public static int OverloadedMethodTakingNullables(int? x, string y, double? d) { int length; diff --git a/tests/fsharp/core/fsfromfsviacs/test.fsx b/tests/fsharp/core/fsfromfsviacs/test.fsx index 732c127e7d6..5f57e17f6ef 100644 --- a/tests/fsharp/core/fsfromfsviacs/test.fsx +++ b/tests/fsharp/core/fsfromfsviacs/test.fsx @@ -148,7 +148,7 @@ module TestConsumeCSharpOptionalParameter = // Check the type inferred for an un-annotated first-class use of the method check "csoptional23982f55" (let f = SomeClass.MethodTakingNullableOptionals in ((f : unit -> int) ())) -3 -#if LANGVERSION_PREVIEW + check "acsoptional23982f51" (SomeClass.MethodTakingNullables(6, "aaaaaa", 8.0)) 20 check "acsoptional23982f51" (SomeClass.MethodTakingNullables(6, "aaaaaa", Nullable 8.0)) 20 check "acsoptional23982f51" (SomeClass.MethodTakingNullables(6, "aaaaaa", Nullable ())) 11 @@ -175,7 +175,7 @@ module TestConsumeCSharpOptionalParameter = // Check the type inferred for an un-annotated first-class use of the method check "acsoptional23982f55" (let f = SomeClass.MethodTakingNullables in ((f : Nullable * string * Nullable -> int) (Nullable 1,"aaaa",Nullable 3.0))) 8 -#endif + // This tests overloaded variaitons of the methods, where the overloads vary by type but not nullability // @@ -186,7 +186,7 @@ module TestConsumeCSharpOptionalParameterOverloads = check "csoptional23982f34o" (SomeClass.OverloadedMethodTakingOptionals(d = 8.0)) 14 -#if LANGVERSION_PREVIEW + check "csoptional23982f3ao" (SomeClass.OverloadedMethodTakingOptionals(?d = Some 8.0)) 14 check "csoptional23982f42o" (SomeClass.OverloadedMethodTakingNullableOptionalsWithDefaults(x = 6)) 14 // can provide non-nullable @@ -210,7 +210,6 @@ module TestConsumeCSharpOptionalParameterOverloads = check "csoptional23982f52o2" (SomeClass.OverloadedMethodTakingNullables(Nullable(6), "aaaaaa", 8.0)) 20 // can provide nullable check "csoptional23982f52o3" (SomeClass.OverloadedMethodTakingNullables(Nullable(6), "aaaaaa", Nullable(8.0))) 20 // can provide nullable -#endif #if CHECK_ERRORS // in these cases there's not enough information to resolve the overload @@ -423,6 +422,64 @@ module TestConsumeCSharpOptionalParameterOverloads_ByNullability = check "cenwceoweioij4" (SomeClass.SimpleOverload(x=Nullable(6))) 6 check "cenwceoweioij5" (SomeClass.SimpleOverload(x=Nullable())) 100 +module TestOptionalsAndNullablesInt32ToInt64 = + open System + open CSharpOptionalParameters + + // Check can give 32-bit or 64-bit + check "csoptional23982f31" (SomeClass.MethodTakingOptionalsInt64()) 11L + check "csoptional23982f32" (SomeClass.MethodTakingOptionalsInt64(x = 6)) 14L + check "csoptional23982f3a" (SomeClass.MethodTakingOptionalsInt64(?x = Some 6)) 14L + check "csoptional23982f32" (SomeClass.MethodTakingOptionalsInt64(x = 6L)) 14L + check "csoptional23982f3a" (SomeClass.MethodTakingOptionalsInt64(?x = Some 6L)) 14L + + // Check can take 32-bit or 64-bit + check "csoptional23982f41" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64()) 11L + check "csoptional23982f42" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64(x = 6)) 14L // can provide non-nullable + check "csoptional23982f431" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64(x = 6)) 14L + check "csoptional23982f435" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64(?x = Some 6)) 14L + check "csoptional23982f42" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64(x = 6L)) 14L // can provide non-nullable + check "csoptional23982f42" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64(x = Nullable 6L)) 14L // can provide nullable for legacy + check "csoptional23982f431" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64(x = 6L)) 14L + check "csoptional23982f435" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64(?x = Some 6L)) 14L + + check "csoptional23982f51" (SomeClass.MethodTakingNullableOptionalsInt64()) -3L + check "csoptional23982f52" (SomeClass.MethodTakingNullableOptionalsInt64(x = 6)) 4L // can provide nullable for legacy + check "csoptional23982f523" (SomeClass.MethodTakingNullableOptionalsInt64(x = 6)) 4L + check "csoptional23982f527" (SomeClass.MethodTakingNullableOptionalsInt64(?x = Some 6)) 4L + check "csoptional23982f52" (SomeClass.MethodTakingNullableOptionalsInt64(x = 6L)) 4L // can provide nullable for legacy + check "csoptional23982f52" (SomeClass.MethodTakingNullableOptionalsInt64(x = Nullable 6L)) 4L // can provide nullable for legacy + check "csoptional23982f523" (SomeClass.MethodTakingNullableOptionalsInt64(x = 6L)) 4L + check "csoptional23982f527" (SomeClass.MethodTakingNullableOptionalsInt64(?x = Some 6L)) 4L + +#if CHECK_ERRORS + // A 32-bit to 64-bit type directed conversion is not allowed for the legacy support of passing a Nullable as named argument + check "csoptional23982f42" (SomeClass.MethodTakingNullableOptionalsWithDefaultsInt64(x = Nullable 6)) 14 // can provide nullable for legacy + check "csoptional23982f52" (SomeClass.MethodTakingNullableOptionalsInt64(x = Nullable 6)) 4 // can provide nullable for legacy +#endif + +module Test12414 = + open System + type C() = + member val ContentLength: Nullable = Nullable(0L) with get, set + + let c = C() + c.ContentLength <- 0 + + check "welewcvwlej1" c.ContentLength (Nullable(0L)) + + c.ContentLength <- 6 + + check "welewcvwlej2" c.ContentLength (Nullable(6L)) + + c.ContentLength <- Nullable 7L + + check "welewcvwlej3" c.ContentLength (Nullable(7L)) + + c.ContentLength <- Nullable() + + check "welewcvwlej4" c.ContentLength (Nullable()) + #if TESTS_AS_APP let RUN() = !failures #else diff --git a/tests/fsharp/core/quotes/test.fsx b/tests/fsharp/core/quotes/test.fsx index 39d2e4218ed..67eab651d47 100644 --- a/tests/fsharp/core/quotes/test.fsx +++ b/tests/fsharp/core/quotes/test.fsx @@ -3255,7 +3255,6 @@ module TestMatchBang = testSimpleMatchBang() -#if LANGVERSION_PREVIEW module WitnessTests = open FSharp.Data.UnitSystems.SI.UnitSymbols @@ -4064,8 +4063,6 @@ module ComputationExpressionWithOptionalsAndParamArray = check "vewhkvh5" password.Label (Some "Password") check "vewhkvh6" password.Validators.Length 3 -#endif - module QuotationOfComputationExpressionZipOperation = type Builder() = diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index d7561eef8a0..b9f831522bb 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -866,42 +866,42 @@ module CoreTests = csc cfg """/nologo /target:library /r:"%s" /out:lib3.dll /langversion:7.2""" cfg.FSCOREDLLPATH ["lib3.cs"] - // some features missing in 4.7 - for version in ["4.7"] do - let outFile = "compilation.langversion.old.output.txt" - let expectedFile = "compilation.langversion.old.output.bsl" - fscBothToOutExpectFail cfg outFile "%s -r:lib.dll -r:lib2.dll -r:lib3.dll -o:test.exe -g --nologo --define:LANGVERSION_%s --langversion:%s" cfg.fsc_flags (version.Replace(".","_")) version ["test.fsx"] - - let diffs = fsdiff cfg outFile expectedFile - match diffs with - | "" -> () - | _ -> Assert.Fail (sprintf "'%s' and '%s' differ; %A" outFile expectedFile diffs) - // all features available in preview - fsc cfg "%s -r:lib.dll -r:lib2.dll -r:lib3.dll -o:test.exe -g --define:LANGVERSION_PREVIEW --langversion:preview" cfg.fsc_flags ["test.fsx"] + fsc cfg "%s -r:lib.dll -r:lib2.dll -r:lib3.dll -o:test.exe -g" cfg.fsc_flags ["test.fsx"] peverify cfg "test.exe" exec cfg ("." ++ "test.exe") "" // Same with library references the other way around - fsc cfg "%s -r:lib.dll -r:lib3.dll -r:lib2.dll -o:test.exe -g --define:LANGVERSION_PREVIEW --langversion:preview" cfg.fsc_flags ["test.fsx"] + fsc cfg "%s -r:lib.dll -r:lib3.dll -r:lib2.dll -o:test.exe -g" cfg.fsc_flags ["test.fsx"] peverify cfg "test.exe" exec cfg ("." ++ "test.exe") "" // Same without the reference to lib.dll - testing an incomplete reference set, but only compiling a subset of the code - fsc cfg "%s --define:NO_LIB_REFERENCE -r:lib3.dll -r:lib2.dll -o:test.exe -g --define:LANGVERSION_PREVIEW --langversion:preview" cfg.fsc_flags ["test.fsx"] + fsc cfg "%s --define:NO_LIB_REFERENCE -r:lib3.dll -r:lib2.dll -o:test.exe -g" cfg.fsc_flags ["test.fsx"] peverify cfg "test.exe" exec cfg ("." ++ "test.exe") "" + // some features missing in 4.7 + for version in ["4.7"] do + let outFile = "compilation.langversion.old.output.txt" + let expectedFile = "compilation.langversion.old.output.bsl" + fscBothToOutExpectFail cfg outFile "%s -r:lib.dll -r:lib2.dll -r:lib3.dll -o:test.exe -g --nologo --langversion:%s" cfg.fsc_flags version ["test.fsx"] + + let diffs = fsdiff cfg outFile expectedFile + match diffs with + | "" -> () + | _ -> Assert.Fail (sprintf "'%s' and '%s' differ; %A" outFile expectedFile diffs) + // check error messages for some cases let outFile = "compilation.errors.output.txt" let expectedFile = "compilation.errors.output.bsl" - fscBothToOutExpectFail cfg outFile "%s -r:lib.dll -r:lib2.dll -r:lib3.dll -o:test.exe -g --nologo --define:LANGVERSION_PREVIEW --langversion:preview --define:CHECK_ERRORS" cfg.fsc_flags ["test.fsx"] + fscBothToOutExpectFail cfg outFile "%s -r:lib.dll -r:lib2.dll -r:lib3.dll -o:test.exe -g --nologo --define:CHECK_ERRORS" cfg.fsc_flags ["test.fsx"] let diffs = fsdiff cfg outFile expectedFile match diffs with @@ -1197,7 +1197,7 @@ module CoreTests = csc cfg """/nologo /target:library /out:cslib.dll""" ["cslib.cs"] - fsc cfg "%s --define:LANGVERSION_PREVIEW --langversion:preview -o:test.exe -r cslib.dll -g" cfg.fsc_flags ["test.fsx"] + fsc cfg "%s -o:test.exe -r cslib.dll -g" cfg.fsc_flags ["test.fsx"] peverify cfg "test.exe" From e989f811153f4edfd6fccc1015a41c5370f653f9 Mon Sep 17 00:00:00 2001 From: "dotnet-maestro[bot]" <42748379+dotnet-maestro[bot]@users.noreply.github.com> Date: Mon, 22 Nov 2021 12:33:08 +0100 Subject: [PATCH 10/26] [main] Update dependencies from dotnet/arcade (#12426) Co-authored-by: dotnet-maestro[bot] --- .config/dotnet-tools.json | 2 +- eng/Version.Details.xml | 4 ++-- eng/common/darc-init.sh | 2 +- global.json | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 981fafc4d56..3bf522e0707 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -9,4 +9,4 @@ ] } } -} \ No newline at end of file +} diff --git a/eng/Version.Details.xml b/eng/Version.Details.xml index 83a27b3edd6..929f04667ef 100644 --- a/eng/Version.Details.xml +++ b/eng/Version.Details.xml @@ -8,9 +8,9 @@ - + https://github.com/dotnet/arcade - 53cc1bc2e555aa7aea95884575d22e21d63708cf + 97463777ee9a8445d4a4c5911ede0f0cd71fa8aa diff --git a/eng/common/darc-init.sh b/eng/common/darc-init.sh index 39abdbecdcf..84c1d0cc2e7 100755 --- a/eng/common/darc-init.sh +++ b/eng/common/darc-init.sh @@ -53,7 +53,7 @@ fi function InstallDarcCli { local darc_cli_package_name="microsoft.dotnet.darc" - InitializeDotNetCli + InitializeDotNetCli true local dotnet_root=$_InitializeDotNetCli if [ -z "$toolpath" ]; then diff --git a/global.json b/global.json index 274f29b114c..be8025025fe 100644 --- a/global.json +++ b/global.json @@ -14,7 +14,7 @@ } }, "msbuild-sdks": { - "Microsoft.DotNet.Arcade.Sdk": "7.0.0-beta.21566.10", + "Microsoft.DotNet.Arcade.Sdk": "7.0.0-beta.21569.2", "Microsoft.DotNet.Helix.Sdk": "2.0.0-beta.19069.2" } -} \ No newline at end of file +} From ef7944d3e810624c5d87ce56996fc0511612f28e Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 22 Nov 2021 12:51:47 +0000 Subject: [PATCH 11/26] make diagnostic numbers unique (#12428) --- src/fsharp/CompilerDiagnostics.fs | 3 +- src/fsharp/FSComp.txt | 4 +-- .../FSharp.Compiler.Service.fsproj | 8 ++++- .../ErrorMessages/InvalidLiteralTests.fs | 2 +- tests/fsharp/core/auto-widen/preview/test.bsl | 32 +++++++++---------- tests/fsharp/tests.fs | 2 +- 6 files changed, 29 insertions(+), 22 deletions(-) diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index d368392468a..bda44aac036 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -377,7 +377,8 @@ let IsWarningOrInfoEnabled (err, severity) n level specificWarnOn = | 3517 -> false // optFailedToInlineSuggestedValue - off by default | 3388 -> false // tcSubsumptionImplicitConversionUsed - off by default | 3389 -> false // tcBuiltInImplicitConversionUsed - off by default - | 3390 -> false // tcImplicitConversionUsedForMethodArg - off by default + | 3390 -> false // xmlDocBadlyFormed - off by default + | 3395 -> false // tcImplicitConversionUsedForMethodArg - off by default | _ -> (severity = FSharpDiagnosticSeverity.Info) || (severity = FSharpDiagnosticSeverity.Warning && level >= GetWarningLevel err) diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index acad18382fd..a0446b9d35d 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1594,7 +1594,6 @@ forFormatInvalidForInterpolated4,"Interpolated strings used as type IFormattable 3387,tcAmbiguousImplicitConversion,"This expression has type '%s' and is only made compatible with type '%s' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:%s" 3388,tcSubsumptionImplicitConversionUsed,"This expression implicitly converts type '%s' to type '%s'. See https://aka.ms/fsharp-implicit-convs." 3389,tcBuiltInImplicitConversionUsed,"This expression uses a built-in implicit conversion to convert type '%s' to type '%s'. See https://aka.ms/fsharp-implicit-convs." -3390,tcImplicitConversionUsedForMethodArg,"This expression uses the implicit conversion '%s' to convert type '%s' to type '%s'." 3391,tcImplicitConversionUsedForNonMethodArg,"This expression uses the implicit conversion '%s' to convert type '%s' to type '%s'. See https://aka.ms/fsharp-implicit-convs. This warning may be disabled using '#nowarn \"3391\"." #3501 "This construct is not supported by your version of the F# compiler" CompilerMessage(ExperimentalAttributeMessages.NotSupportedYet, 3501, IsError=true) 3390,xmlDocBadlyFormed,"This XML comment is invalid: '%s'" @@ -1604,10 +1603,11 @@ forFormatInvalidForInterpolated4,"Interpolated strings used as type IFormattable 3390,xmlDocDuplicateParameter,"This XML comment is invalid: multiple documentation entries for parameter '%s'" 3390,xmlDocUnresolvedCrossReference,"This XML comment is invalid: unresolved cross-reference '%s'" 3390,xmlDocMissingParameter,"This XML comment is incomplete: no documentation for parameter '%s'" -3391,tcLiteralAttributeCannotUseActivePattern,"A [] declaration cannot use an active pattern for its identifier" 3392,containerDeprecated,"The 'AssemblyKeyNameAttribute' has been deprecated. Use 'AssemblyKeyFileAttribute' instead." 3393,containerSigningUnsupportedOnThisPlatform,"Key container signing is not supported on this platform." 3394,parsNewExprMemberAccess,"This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName'" +3395,tcImplicitConversionUsedForMethodArg,"This expression uses the implicit conversion '%s' to convert type '%s' to type '%s'." +3396,tcLiteralAttributeCannotUseActivePattern,"A [] declaration cannot use an active pattern for its identifier" 3401,ilxgenInvalidConstructInStateMachineDuringCodegen,"The resumable code construct '%s' may only be used in inlined code protected by 'if __useResumableCode then ...' and the overall composition must form valid resumable code." 3402,tcInvalidResumableConstruct,"The construct '%s' may only be used in valid resumable code." 3501,tcResumableCodeFunctionMustBeInline,"Invalid resumable code. Any method of function accepting or returning resumable code must be marked 'inline'" diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 36a323cc231..ae388ec4d33 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -15,7 +15,13 @@ $(DefineConstants);COMPILER $(DefineConstants);ENABLE_MONO_SUPPORT $(DefineConstants);USE_SHIPPED_FSCORE - $(OtherFlags) /warnon:3218 /warnon:1182 /warnon:3390 --extraoptimizationloops:1 --times + $(OtherFlags) --extraoptimizationloops:1 --times + + $(OtherFlags) --warnon:1182 + + $(OtherFlags) --warnon:3218 + + $(OtherFlags) --warnon:3390 true $(IntermediateOutputPath)$(TargetFramework)\ $(IntermediateOutputPath)$(TargetFramework)\ diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/InvalidLiteralTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/InvalidLiteralTests.fs index bf6630b4313..a72d93c2743 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/InvalidLiteralTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/InvalidLiteralTests.fs @@ -15,4 +15,4 @@ let [] (A x) = 1 """ |> typecheck |> shouldFail - |> withSingleDiagnostic (Error 3391, Line 3, Col 5, Line 3, Col 22, "A [] declaration cannot use an active pattern for its identifier") + |> withSingleDiagnostic (Error 3396, Line 3, Col 5, Line 3, Col 22, "A [] declaration cannot use an active pattern for its identifier") diff --git a/tests/fsharp/core/auto-widen/preview/test.bsl b/tests/fsharp/core/auto-widen/preview/test.bsl index 947390ac100..94ad06d8bc0 100644 --- a/tests/fsharp/core/auto-widen/preview/test.bsl +++ b/tests/fsharp/core/auto-widen/preview/test.bsl @@ -133,7 +133,7 @@ test.fsx(128,22,128,23): typecheck error FS3389: This expression uses a built-in test.fsx(128,22,128,23): typecheck error FS3388: This expression implicitly converts type 'int' to type 'double'. See https://aka.ms/fsharp-implicit-convs. -test.fsx(135,18,135,19): typecheck error FS3390: This expression uses the implicit conversion 'static member C.op_Implicit: x: int -> C' to convert type 'int' to type 'C'. +test.fsx(135,18,135,19): typecheck error FS3395: This expression uses the implicit conversion 'static member C.op_Implicit: x: int -> C' to convert type 'int' to type 'C'. test.fsx(135,18,135,19): typecheck error FS3388: This expression implicitly converts type 'int' to type 'C'. See https://aka.ms/fsharp-implicit-convs. @@ -141,7 +141,7 @@ test.fsx(140,18,140,19): typecheck error FS3389: This expression uses a built-in test.fsx(140,18,140,19): typecheck error FS3388: This expression implicitly converts type 'int' to type 'int64'. See https://aka.ms/fsharp-implicit-convs. -test.fsx(145,18,145,19): typecheck error FS3390: This expression uses the implicit conversion 'Decimal.op_Implicit(value: int) : decimal' to convert type 'int' to type 'decimal'. +test.fsx(145,18,145,19): typecheck error FS3395: This expression uses the implicit conversion 'Decimal.op_Implicit(value: int) : decimal' to convert type 'int' to type 'decimal'. test.fsx(145,18,145,19): typecheck error FS3388: This expression implicitly converts type 'int' to type 'decimal'. See https://aka.ms/fsharp-implicit-convs. @@ -153,21 +153,21 @@ test.fsx(149,39,149,41): typecheck error FS3391: This expression uses the implic test.fsx(149,39,149,41): typecheck error FS3388: This expression implicitly converts type 'string' to type 'Xml.Linq.XNamespace'. See https://aka.ms/fsharp-implicit-convs. -test.fsx(154,18,154,20): typecheck error FS3390: This expression uses the implicit conversion 'Xml.Linq.XNamespace.op_Implicit(namespaceName: string) : Xml.Linq.XNamespace' to convert type 'string' to type 'Xml.Linq.XNamespace'. +test.fsx(154,18,154,20): typecheck error FS3395: This expression uses the implicit conversion 'Xml.Linq.XNamespace.op_Implicit(namespaceName: string) : Xml.Linq.XNamespace' to convert type 'string' to type 'Xml.Linq.XNamespace'. test.fsx(154,18,154,20): typecheck error FS3388: This expression implicitly converts type 'string' to type 'Xml.Linq.XNamespace'. See https://aka.ms/fsharp-implicit-convs. -test.fsx(159,18,159,21): typecheck error FS3390: This expression uses the implicit conversion 'Xml.Linq.XName.op_Implicit(expandedName: string) : Xml.Linq.XName' to convert type 'string' to type 'Xml.Linq.XName'. +test.fsx(159,18,159,21): typecheck error FS3395: This expression uses the implicit conversion 'Xml.Linq.XName.op_Implicit(expandedName: string) : Xml.Linq.XName' to convert type 'string' to type 'Xml.Linq.XName'. test.fsx(159,18,159,21): typecheck error FS3388: This expression implicitly converts type 'string' to type 'Xml.Linq.XName'. See https://aka.ms/fsharp-implicit-convs. -test.fsx(165,18,165,19): typecheck error FS3390: This expression uses the implicit conversion 'static member C.op_Implicit: x: int -> C' to convert type 'int' to type 'C'. +test.fsx(165,18,165,19): typecheck error FS3395: This expression uses the implicit conversion 'static member C.op_Implicit: x: int -> C' to convert type 'int' to type 'C'. test.fsx(165,18,165,19): typecheck error FS3388: This expression implicitly converts type 'int' to type 'C'. See https://aka.ms/fsharp-implicit-convs. -test.fsx(172,18,172,21): typecheck error FS3390: This expression uses the implicit conversion 'static member Y.op_Implicit: y: Y -> X' to convert type 'Y' to type 'X'. +test.fsx(172,18,172,21): typecheck error FS3395: This expression uses the implicit conversion 'static member Y.op_Implicit: y: Y -> X' to convert type 'Y' to type 'X'. -test.fsx(172,18,172,21): typecheck error FS3390: This expression uses the implicit conversion 'static member Y.op_Implicit: y: Y -> X' to convert type 'Y' to type 'X'. +test.fsx(172,18,172,21): typecheck error FS3395: This expression uses the implicit conversion 'static member Y.op_Implicit: y: Y -> X' to convert type 'Y' to type 'X'. test.fsx(178,20,178,21): typecheck error FS3391: This expression uses the implicit conversion 'static member C.op_Implicit: x: 'T -> C<'T>' to convert type 'int' to type 'C'. See https://aka.ms/fsharp-implicit-convs. This warning may be disabled using '#nowarn "3391". @@ -592,7 +592,7 @@ test.fsx(463,18,463,19): typecheck error FS0001: This expression was expected to but here has type 'int' -test.fsx(471,18,471,19): typecheck error FS3390: This expression uses the implicit conversion 'static member C.op_Implicit: x: int -> C' to convert type 'int' to type 'C'. +test.fsx(471,18,471,19): typecheck error FS3395: This expression uses the implicit conversion 'static member C.op_Implicit: x: int -> C' to convert type 'int' to type 'C'. test.fsx(471,18,471,19): typecheck error FS3388: This expression implicitly converts type 'int' to type 'C'. See https://aka.ms/fsharp-implicit-convs. @@ -602,25 +602,25 @@ test.fsx(482,18,482,21): typecheck error FS3387: This expression has type 'B' an static member B.op_Implicit: x: B -> C static member C.op_Implicit: x: B -> C -test.fsx(482,18,482,21): typecheck error FS3390: This expression uses the implicit conversion 'static member B.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. +test.fsx(482,18,482,21): typecheck error FS3395: This expression uses the implicit conversion 'static member B.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. test.fsx(482,18,482,21): typecheck error FS3387: This expression has type 'B' and is only made compatible with type 'C' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are: static member B.op_Implicit: x: B -> C static member C.op_Implicit: x: B -> C -test.fsx(482,18,482,21): typecheck error FS3390: This expression uses the implicit conversion 'static member B.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. +test.fsx(482,18,482,21): typecheck error FS3395: This expression uses the implicit conversion 'static member B.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. -test.fsx(507,18,507,21): typecheck error FS3390: This expression uses the implicit conversion 'static member C.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. +test.fsx(507,18,507,21): typecheck error FS3395: This expression uses the implicit conversion 'static member C.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. -test.fsx(507,18,507,21): typecheck error FS3390: This expression uses the implicit conversion 'static member C.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. +test.fsx(507,18,507,21): typecheck error FS3395: This expression uses the implicit conversion 'static member C.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. -test.fsx(519,18,519,21): typecheck error FS3390: This expression uses the implicit conversion 'static member B.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. +test.fsx(519,18,519,21): typecheck error FS3395: This expression uses the implicit conversion 'static member B.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. -test.fsx(519,18,519,21): typecheck error FS3390: This expression uses the implicit conversion 'static member B.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. +test.fsx(519,18,519,21): typecheck error FS3395: This expression uses the implicit conversion 'static member B.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. -test.fsx(538,18,538,21): typecheck error FS3390: This expression uses the implicit conversion 'static member C.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. +test.fsx(538,18,538,21): typecheck error FS3395: This expression uses the implicit conversion 'static member C.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. -test.fsx(538,18,538,21): typecheck error FS3390: This expression uses the implicit conversion 'static member C.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. +test.fsx(538,18,538,21): typecheck error FS3395: This expression uses the implicit conversion 'static member C.op_Implicit: x: B -> C' to convert type 'B' to type 'C'. test.fsx(543,30,543,31): typecheck error FS0001: This expression was expected to have type 'float32' diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index b9f831522bb..b17914427c3 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -110,7 +110,7 @@ module CoreTests = [] let ``auto-widen-version-preview-warns-on``() = let cfg = testConfig "core/auto-widen/preview" - let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --warnon:3388 --warnon:3389 --warnon:3390 --warnaserror+ --define:NEGATIVE" } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --warnon:3388 --warnon:3389 --warnon:3395 --warnaserror+ --define:NEGATIVE" } singleVersionedNegTest cfg "preview" "test" [] From 7512e5c287168ae7e199bda580f9b92ca9038fc7 Mon Sep 17 00:00:00 2001 From: dotnet bot Date: Mon, 22 Nov 2021 06:34:28 -0800 Subject: [PATCH 12/26] Localized file check-in by OneLocBuild Task: Build definition ID 499: Build ID 1480730 (#12433) --- src/fsharp/xlf/FSComp.txt.fr.xlf | 2 +- src/fsharp/xlf/FSComp.txt.it.xlf | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 6b79cdb8461..b2255a67342 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -694,7 +694,7 @@ Using methods with 'NoEagerConstraintApplicationAttribute' requires /langversion:6.0 or later - Using methods with 'NoEagerConstraintApplicationAttribute' requires /langversion:6.0 or later + L’utilisation de méthodes avec « NoEagerConstraintApplicationAttribute » requiert/langversion:6.0 ou ultérieur diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index a32205a3a2b..3ad6eb6e9ee 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -694,7 +694,7 @@ Using methods with 'NoEagerConstraintApplicationAttribute' requires /langversion:6.0 or later - Using methods with 'NoEagerConstraintApplicationAttribute' requires /langversion:6.0 or later + L'utilizzo di metodi con 'NoEagerConstraintApplicationAttribute' richiede /langversion: 6.0 o versione successiva From 8c300e6c1d11618bbc6c401bb23e5f5a35792d56 Mon Sep 17 00:00:00 2001 From: Ye Date: Mon, 22 Nov 2021 13:30:10 -0300 Subject: [PATCH 13/26] Improve error message for invalid member declarations (#12342) Co-authored-by: Gauthier Segay Co-authored-by: Gauthier Segay --- src/fsharp/CheckExpressions.fs | 2 ++ src/fsharp/FSComp.txt | 1 + src/fsharp/xlf/FSComp.txt.cs.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.de.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.es.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.fr.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.it.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.ja.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.ko.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.pl.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.pt-BR.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.ru.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.tr.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.zh-Hans.xlf | 5 +++++ src/fsharp/xlf/FSComp.txt.zh-Hant.xlf | 5 +++++ tests/fsharp/tests.fs | 3 +++ tests/fsharp/typecheck/sigs/neg133.bsl | 4 ++++ tests/fsharp/typecheck/sigs/neg133.fs | 7 +++++++ 18 files changed, 82 insertions(+) create mode 100644 tests/fsharp/typecheck/sigs/neg133.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg133.fs diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 01497098333..1d6d30b1084 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -10920,6 +10920,8 @@ and AnalyzeRecursiveDecl bindingAttribs, vis2, tcrefContainerInfo, memberFlagsOpt, ty, bindingRhs, mBinding) + | SynPat.Paren(_, m) -> error(Error(FSComp.SR.tcInvalidMemberDeclNameMissingOrHasParen(), m)) + | _ -> error(Error(FSComp.SR.tcOnlySimplePatternsInLetRec(), mBinding)) analyzeRecursiveDeclPat tpenv declPattern diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index a0446b9d35d..eef43887b13 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1632,3 +1632,4 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3518,implMissingInlineIfLambda,"The 'InlineIfLambda' attribute is present in the signature but not the implementation." 3519,tcInlineIfLambdaUsedOnNonInlineFunctionOrMethod,"The 'InlineIfLambda' attribute may only be used on parameters of inlined functions of methods whose type is a function or F# delegate type." 3520,invalidXmlDocPosition,"XML comment is not placed on a valid language element." +3521,tcInvalidMemberDeclNameMissingOrHasParen,"Invalid member declaration. The name of the member is missing or has parentheses." diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index deeb54bea8b..56358ff58e6 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -647,6 +647,11 @@ Neplatné zarovnání v interpolovaném řetězci + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. Konstruktor {0} je možné použít jenom v platném obnovitelném kódu. diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index cd8ae9c7a51..30e88eb1069 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -647,6 +647,11 @@ Ungültige Ausrichtung in interpolierter Zeichenfolge. + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. Das Konstrukt "{0}" darf nur in einem gültigen fortsetzbaren Code verwendet werden. diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index c6a774bff07..60d6a2df324 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -647,6 +647,11 @@ Alineación no válida en la cadena interpolada + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. La construcción "{0}" solo se puede usar en un código reanudable válido. diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index b2255a67342..a5c7339076d 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -647,6 +647,11 @@ Alignement non valide dans la chaîne interpolée + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. La construction «{0}» ne peut être utilisée que dans un code pouvant être repris valide. diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 3ad6eb6e9ee..d396190c5bc 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -647,6 +647,11 @@ Allineamento non valido nella stringa interpolata + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. Il costrutto '{0}' può essere usato solo in codice ripristinabile valido. diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 8abb9f6a300..30c7b04b0ee 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -647,6 +647,11 @@ 補間された文字列内の配置が無効です + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. コンストラクト '{0}' は、有効な再開可能コードでのみ使用できます。 diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index 184ed54955e..acdf8540ba7 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -647,6 +647,11 @@ 보간 문자열의 잘못된 정렬 + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. '{0}' 구문은 유효한 다시 시작 가능한 코드에서만 사용할 수 있습니다. diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index 25c44f08d99..2e4fdfe91af 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -647,6 +647,11 @@ Nieprawidłowe wyrównanie w ciągu interpolowanym + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. Konstrukcji "{0}" można używać tylko w prawidłowym kodzie z możliwością wznowienia. diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index 132bf3d972e..87dfe7978d4 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -647,6 +647,11 @@ Alinhamento inválido na cadeia de caracteres interpolada + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. A construção '{0}' só pode ser usada em código válido e retomável. diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index 72aac1e833e..00d4f27cf2d 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -647,6 +647,11 @@ Недопустимое выравнивание в интерполированной строке + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. Конструкция "{0}" может использоваться только в допустимом возобновляемом коде. diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index 758bec7b7f7..0a0b55e3d4c 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -647,6 +647,11 @@ Düz metin arasına kod eklenmiş dizede geçersiz hizalama + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. '{0}' yapısı yalnızca geçerli sürdürülebilir kodda kullanılabilir. diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index 07d2c642248..f37cbca5244 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -647,6 +647,11 @@ 内插字符串中的对齐无效 + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. 构造 "{0}" 只能在有效的可恢复代码中使用。 diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index 81313be9467..c3208a14e0e 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -647,6 +647,11 @@ 插補字串中的對齊無效 + + Invalid member declaration. The name of the member is missing or has parentheses. + Invalid member declaration. The name of the member is missing or has parentheses. + + The construct '{0}' may only be used in valid resumable code. 建構 '{0}' 只能用於有效的可繼續程式碼。 diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index b17914427c3..0ca1911eeea 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -3042,6 +3042,9 @@ module TypecheckTests = [] let ``type check neg132`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "5.0" "neg132" + + [] + let ``type check neg133`` () = singleNegTest (testConfig "typecheck/sigs") "neg133" [] let ``type check neg_anon_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_anon_1" diff --git a/tests/fsharp/typecheck/sigs/neg133.bsl b/tests/fsharp/typecheck/sigs/neg133.bsl new file mode 100644 index 00000000000..ed51fcc0580 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg133.bsl @@ -0,0 +1,4 @@ + +neg133.fs(4,19,4,22): typecheck error FS3521: Invalid member declaration. The name of the member is missing or has parentheses. + +neg133.fs(7,19,7,27): typecheck error FS3521: Invalid member declaration. The name of the member is missing or has parentheses. diff --git a/tests/fsharp/typecheck/sigs/neg133.fs b/tests/fsharp/typecheck/sigs/neg133.fs new file mode 100644 index 00000000000..5151f488580 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg133.fs @@ -0,0 +1,7 @@ +module Neg133 + +type T = + static member (y) = 0 + +type U = + static member (y: int) = 0 From c194738cd8786118c6c015d0c2c9e20953f08a6e Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 22 Nov 2021 16:31:48 +0000 Subject: [PATCH 14/26] update messages (#12427) --- src/fsharp/FSComp.txt | 4 ++-- src/fsharp/xlf/FSComp.txt.cs.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.de.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.es.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.fr.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.it.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.ja.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.ko.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.pl.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.pt-BR.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.ru.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.tr.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.zh-Hans.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.zh-Hant.xlf | 4 ++-- 14 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index eef43887b13..057bc042c17 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1511,8 +1511,8 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl 3252,tcIllegalByrefsInOpenTypeDeclaration,"Byref types are not allowed in an open type declaration." 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." -3302,packageManagementRequiresVFive,"The package management feature requires language version 5.0 use /langversion:preview" -3303,fromEndSlicingRequiresVFive,"From the end slicing with requires language version 5.0, use /langversion:preview." +3302,packageManagementRequiresVFive,"The 'package management' feature requires language version 5.0 or above" +3303,fromEndSlicingRequiresVFive,"The 'from the end slicing' feature requires language version 'preview'." 3304,poundiNotSupportedByRegisteredDependencyManagers,"#i is not supported by the registered PackageManagers" 3343,tcRequireMergeSourcesOrBindN,"The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '%s' method or appropriate 'MergeSource' and 'Bind' methods" 3344,tcAndBangNotSupported,"This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature." diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index 56358ff58e6..131794ce3fa 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. Vytváření průřezů od konce vyžaduje jazykovou verzi 5.0, použijte /langversion:preview. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above Funkce správy balíčků vyžaduje jazykovou verzi 5.0, použijte /langversion:preview. diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index 30e88eb1069..05ed294108a 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. Für das vom Ende ausgehende Slicing ist Sprachversion 5.0 erforderlich. Verwenden Sie /langversion:preview. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above Für das Paketverwaltungsfeature ist Sprachversion 5.0 erforderlich. Verwenden Sie /langversion:preview. diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 60d6a2df324..3492f54887e 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. La segmentación desde el final requiere la versión de lenguaje 5.0, use /langversion:preview. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above La característica de administración de paquetes requiere la versión de lenguaje 5.0; use /langversion:preview diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index a5c7339076d..4425a9c5f2a 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. L'extraction à partir de la fin nécessite la version 5.0 du langage. Utilisez /langversion:preview. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above La fonctionnalité de gestion des packages nécessite la version 5.0 du langage. Utilisez /langversion:preview diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index d396190c5bc..9b22c4e0152 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. Con il sezionamento dalla fine è richiesta la versione 5.0 del linguaggio. Usare /langversion:preview. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above Con la funzionalità di gestione pacchetti è richiesta la versione 5.0 del linguaggio. Usare /langversion:preview diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 30c7b04b0ee..c2906db7c8b 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. 言語バージョン 5.0 が必要な最後からのスライスで、/langversion:preview を使用してください。 @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above パッケージ管理機能では、言語バージョン 5.0 で /langversion:preview を使用する必要があります diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index acdf8540ba7..a4e0ceb9cc6 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. 언어 버전 5.0이 필요한 끝 조각화에서는 /langversion:preview를 사용하세요. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above 패키지 관리 기능을 사용하려면 언어 버전 5.0이 필요합니다. /langversion:preview를 사용하세요. diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index 2e4fdfe91af..5441e5bf864 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. Wycinanie od końca wymaga języka w wersji 5.0, użyj parametru /langversion:preview. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above Funkcja zarządzania pakietami wymaga języka w wersji 5.0, użyj parametru /langversion:preview diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index 87dfe7978d4..fe279606a7c 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. A opção 'Divisão começando no final' requer a versão de idioma 5.0. Use /langversion:preview. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above O recurso de gerenciamento de pacotes requer a versão de idioma 5.0. Use /langversion:preview diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index 00d4f27cf2d..fe070e7f973 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. Для конечного среза, для которого требуется версия языка 5.0, используйте параметр /langversion:preview. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above Для функции управления пакетами требуется версия языка 5.0, используйте параметр /langversion:preview diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index 0a0b55e3d4c..02b6db4cbf4 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. Sondan dilimleme, 5.0 dil sürümünü gerektirir, /langversion:preview kullanın. @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above Paket yönetimi özelliği dil sürümü 5.0 gerektiriyor, /langversion:preview kullanın diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index f37cbca5244..bc71d4c35cc 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. 需要语言版本 5.0 才能从末尾切片，请使用 /langversion:preview。 @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above 包管理功能需要语言版本 5.0，请使用 /langversion:preview diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index c3208a14e0e..3b38645b3da 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -288,7 +288,7 @@ - From the end slicing with requires language version 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. 從結尾處切割需要語言版本 5.0，請使用 /langversion:preview。 @@ -433,7 +433,7 @@ - The package management feature requires language version 5.0 use /langversion:preview + The 'package management' feature requires language version 5.0 or above 套件管理功能需要語言版本 5.0，請使用 /langversion:preview From 5be669b3c649275f41a8dfa3752808c3b7f14e19 Mon Sep 17 00:00:00 2001 From: dotnet bot Date: Mon, 22 Nov 2021 10:20:44 -0800 Subject: [PATCH 15/26] Localized file check-in by OneLocBuild Task: Build definition ID 499: Build ID 1481000 (#12436) --- src/fsharp/xlf/FSComp.txt.cs.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.de.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.es.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.fr.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.it.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.ja.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.ko.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.pl.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.pt-BR.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.ru.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.tr.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.zh-Hans.xlf | 4 ++-- src/fsharp/xlf/FSComp.txt.zh-Hant.xlf | 4 ++-- 13 files changed, 26 insertions(+), 26 deletions(-) diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index 131794ce3fa..d93fe994766 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - Vytváření průřezů od konce vyžaduje jazykovou verzi 5.0, použijte /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - Funkce správy balíčků vyžaduje jazykovou verzi 5.0, použijte /langversion:preview. + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index 05ed294108a..638a9a8de5d 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - Für das vom Ende ausgehende Slicing ist Sprachversion 5.0 erforderlich. Verwenden Sie /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - Für das Paketverwaltungsfeature ist Sprachversion 5.0 erforderlich. Verwenden Sie /langversion:preview. + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 3492f54887e..b7ced72c91b 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - La segmentación desde el final requiere la versión de lenguaje 5.0, use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - La característica de administración de paquetes requiere la versión de lenguaje 5.0; use /langversion:preview + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 4425a9c5f2a..52c3fdcea86 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - L'extraction à partir de la fin nécessite la version 5.0 du langage. Utilisez /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - La fonctionnalité de gestion des packages nécessite la version 5.0 du langage. Utilisez /langversion:preview + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 9b22c4e0152..249887688fd 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - Con il sezionamento dalla fine è richiesta la versione 5.0 del linguaggio. Usare /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - Con la funzionalità di gestione pacchetti è richiesta la versione 5.0 del linguaggio. Usare /langversion:preview + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index c2906db7c8b..15c5da75f0d 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - 言語バージョン 5.0 が必要な最後からのスライスで、/langversion:preview を使用してください。 + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - パッケージ管理機能では、言語バージョン 5.0 で /langversion:preview を使用する必要があります + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index a4e0ceb9cc6..8f28ff6bc5a 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - 언어 버전 5.0이 필요한 끝 조각화에서는 /langversion:preview를 사용하세요. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - 패키지 관리 기능을 사용하려면 언어 버전 5.0이 필요합니다. /langversion:preview를 사용하세요. + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index 5441e5bf864..70627d2892b 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - Wycinanie od końca wymaga języka w wersji 5.0, użyj parametru /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - Funkcja zarządzania pakietami wymaga języka w wersji 5.0, użyj parametru /langversion:preview + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index fe279606a7c..26e583b87bf 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - A opção 'Divisão começando no final' requer a versão de idioma 5.0. Use /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - O recurso de gerenciamento de pacotes requer a versão de idioma 5.0. Use /langversion:preview + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index fe070e7f973..8b2d5dcc6e3 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - Для конечного среза, для которого требуется версия языка 5.0, используйте параметр /langversion:preview. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - Для функции управления пакетами требуется версия языка 5.0, используйте параметр /langversion:preview + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index 02b6db4cbf4..de3cedeb938 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - Sondan dilimleme, 5.0 dil sürümünü gerektirir, /langversion:preview kullanın. + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - Paket yönetimi özelliği dil sürümü 5.0 gerektiriyor, /langversion:preview kullanın + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index bc71d4c35cc..b2a5c4075fd 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - 需要语言版本 5.0 才能从末尾切片，请使用 /langversion:preview。 + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - 包管理功能需要语言版本 5.0，请使用 /langversion:preview + The 'package management' feature requires language version 5.0 or above diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index 3b38645b3da..27dc0b27693 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -289,7 +289,7 @@ The 'from the end slicing' feature requires language version 'preview'. - 從結尾處切割需要語言版本 5.0，請使用 /langversion:preview。 + The 'from the end slicing' feature requires language version 'preview'. @@ -434,7 +434,7 @@ The 'package management' feature requires language version 5.0 or above - 套件管理功能需要語言版本 5.0，請使用 /langversion:preview + The 'package management' feature requires language version 5.0 or above From 3d15c4325f602ef800f09c38e0a7f482139b1a5b Mon Sep 17 00:00:00 2001 From: "Kevin Ransom (msft)" Date: Mon, 22 Nov 2021 10:41:50 -0800 Subject: [PATCH 16/26] Fix 12405 (#12406) --- .../Vsix/VisualFSharpFull/Source.extension.vsixmanifest | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest b/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest index 202f9e69d99..5151aa32db6 100644 --- a/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest +++ b/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest @@ -9,7 +9,9 @@ https://docs.microsoft.com/en-us/dotnet/articles/fsharp/ - + + amd64 + From c5da37846baec2d584e193a796d13a61e9335fe7 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 22 Nov 2021 21:08:34 +0000 Subject: [PATCH 17/26] Fix debug tailcalls for pipelines if /tailcalls+ is explicitly specified (#12430) * don't suppress tailcalls in pipeline debugging if tailcalls are on * don't suppress tailcalls in pipeline debugging if tailcalls are on --- src/fsharp/IlxGen.fs | 39 ++++++++++++------- .../TestFunctions/Testfunction15.il.bsl | 13 ++++--- 2 files changed, 31 insertions(+), 21 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 03f891e6870..f30f7b7c2b8 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -2941,26 +2941,35 @@ and GenLinearExpr cenv cgbuf eenv sp expr sequel preSteps (contf: FakeUnit -> Fa // Compiler generated sequential executions result in suppressions of debug points on both // left and right of the sequence let spStmt, spExpr = - (match spSeq with - | DebugPointAtSequential.SuppressNeither -> SPAlways, SPAlways - | DebugPointAtSequential.SuppressStmt -> SPSuppress, sp - | DebugPointAtSequential.SuppressExpr -> sp, SPSuppress - | DebugPointAtSequential.SuppressBoth -> SPSuppress, SPSuppress) + match spSeq with + | DebugPointAtSequential.SuppressNeither -> SPAlways, SPAlways + | DebugPointAtSequential.SuppressStmt -> SPSuppress, sp + | DebugPointAtSequential.SuppressExpr -> sp, SPSuppress + | DebugPointAtSequential.SuppressBoth -> SPSuppress, SPSuppress + match specialSeqFlag with | NormalSeq -> GenExpr cenv cgbuf eenv spStmt e1 discard GenLinearExpr cenv cgbuf eenv spExpr e2 sequel true contf | ThenDoSeq -> - let g = cenv.g - let isUnit = isUnitTy g (tyOfExpr g e1) - if isUnit then - GenExpr cenv cgbuf eenv spExpr e1 discard - GenExpr cenv cgbuf eenv spStmt e2 discard - GenUnitThenSequel cenv eenv e2.Range eenv.cloc cgbuf sequel - else - GenExpr cenv cgbuf eenv spExpr e1 Continue - GenExpr cenv cgbuf eenv spStmt e2 discard - GenSequel cenv eenv.cloc cgbuf sequel + // "e then ()" with DebugPointAtSequential.SuppressStmt is used + // in mkDebugPoint to emit a debug point on "e". However we don't want this to interfere + // with tailcalls, so detect this case and throw the "then ()" away, having already + // worked out "spExpr" up above. + match e2 with + | Expr.Const (Const.Unit, _, _) -> + GenExpr cenv cgbuf eenv spExpr e1 sequel + | _ -> + let g = cenv.g + let isUnit = isUnitTy g (tyOfExpr g e1) + if isUnit then + GenExpr cenv cgbuf eenv spExpr e1 discard + GenExpr cenv cgbuf eenv spStmt e2 discard + GenUnitThenSequel cenv eenv e2.Range eenv.cloc cgbuf sequel + else + GenExpr cenv cgbuf eenv spExpr e1 Continue + GenExpr cenv cgbuf eenv spStmt e2 discard + GenSequel cenv eenv.cloc cgbuf sequel contf Fake | Expr.Let (bind, body, _, _) -> diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction15.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction15.il.bsl index 9138937e22e..19ecc6f1b00 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction15.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction15.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 5:0:0:0 + .ver 6:0:0:0 } .assembly TestFunction15 { @@ -36,13 +36,13 @@ // Offset: 0x000001F0 Length: 0x00000072 } .module TestFunction15.exe -// MVID: {611B0ED4-A624-4662-A745-0383D40E1B61} +// MVID: {6197D1F9-A624-4662-A745-0383F9D19761} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x07120000 +// Image base: 0x06AD0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -95,7 +95,7 @@ .method public static class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 TestFunction15(int32 inp) cil managed { - // Code size 40 (0x28) + // Code size 42 (0x2a) .maxstack 6 .locals init ([0] int32 x, [1] class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 'Pipe #1 input at line 6') @@ -119,9 +119,10 @@ .line 6,6 : 16,41 '' IL_001c: ldsfld class TestFunction15/TestFunction15@6 TestFunction15/TestFunction15@6::@_instance IL_0021: ldloc.1 - IL_0022: call class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 [FSharp.Core]Microsoft.FSharp.Collections.ListModule::Map(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2, + IL_0022: tail. + IL_0024: call class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 [FSharp.Core]Microsoft.FSharp.Collections.ListModule::Map(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2, class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1) - IL_0027: ret + IL_0029: ret } // end of method TestFunction15::TestFunction15 } // end of class TestFunction15 From 2080a47e88efccbf0309eef2c16548f47fe386b3 Mon Sep 17 00:00:00 2001 From: dotnet bot Date: Mon, 22 Nov 2021 15:54:15 -0800 Subject: [PATCH 18/26] Localized file check-in by OneLocBuild Task: Build definition ID 499: Build ID 1481545 (#12435) * Localized file check-in by OneLocBuild Task: Build definition ID 499: Build ID 1480996 * Localized file check-in by OneLocBuild Task: Build definition ID 499: Build ID 1480996 * Localized file check-in by OneLocBuild Task: Build definition ID 499: Build ID 1481545 * Localized file check-in by OneLocBuild Task: Build definition ID 499: Build ID 1481545 Co-authored-by: Kevin Ransom (msft) From 69ece796e4a6d95f6ac683d9618aa27a98f59200 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Tue, 23 Nov 2021 03:25:55 -0600 Subject: [PATCH 19/26] Rename FSharpReferencedProject.ProjectFileName for clarity (#12431) This renames the `projectFileName` field and `FileName` property to reflect the actual use: the project's output file. This was unclear based on docs, but clear based on usage, and so docs were added to help ensure correct usage. --- src/fsharp/service/FSharpCheckerResults.fs | 40 +++++++++---------- src/fsharp/service/FSharpCheckerResults.fsi | 34 +++++++++++----- ...erService.SurfaceArea.netstandard.expected | 4 +- 3 files changed, 47 insertions(+), 31 deletions(-) diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 8c6945d229b..ada57d64b6e 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -106,41 +106,41 @@ type internal DelayedILModuleReader = [] type FSharpReferencedProject = - | FSharpReference of projectFileName: string * options: FSharpProjectOptions - | PEReference of projectFileName: string * getStamp: (unit -> DateTime) * delayedReader: DelayedILModuleReader - | ILModuleReference of projectFileName: string * getStamp: (unit -> DateTime) * getReader: (unit -> ILModuleReader) + | FSharpReference of projectOutputFile: string * options: FSharpProjectOptions + | PEReference of projectOutputFile: string * getStamp: (unit -> DateTime) * delayedReader: DelayedILModuleReader + | ILModuleReference of projectOutputFile: string * getStamp: (unit -> DateTime) * getReader: (unit -> ILModuleReader) - member this.FileName = + member this.OutputFile = match this with - | FSharpReference(projectFileName=projectFileName) - | PEReference(projectFileName=projectFileName) - | ILModuleReference(projectFileName=projectFileName) -> projectFileName + | FSharpReference(projectOutputFile=projectOutputFile) + | PEReference(projectOutputFile=projectOutputFile) + | ILModuleReference(projectOutputFile=projectOutputFile) -> projectOutputFile - static member CreateFSharp(projectFileName, options) = - FSharpReference(projectFileName, options) + static member CreateFSharp(projectOutputFile, options) = + FSharpReference(projectOutputFile, options) - static member CreatePortableExecutable(projectFileName, getStamp, getStream) = - PEReference(projectFileName, getStamp, DelayedILModuleReader(projectFileName, getStream)) + static member CreatePortableExecutable(projectOutputFile, getStamp, getStream) = + PEReference(projectOutputFile, getStamp, DelayedILModuleReader(projectOutputFile, getStream)) - static member CreateFromILModuleReader(projectFileName, getStamp, getReader) = - ILModuleReference(projectFileName, getStamp, getReader) + static member CreateFromILModuleReader(projectOutputFile, getStamp, getReader) = + ILModuleReference(projectOutputFile, getStamp, getReader) override this.Equals(o) = match o with | :? FSharpReferencedProject as o -> match this, o with - | FSharpReference(projectFileName1, options1), FSharpReference(projectFileName2, options2) -> - projectFileName1 = projectFileName2 && options1 = options2 - | PEReference(projectFileName1, getStamp1, _), PEReference(projectFileName2, getStamp2, _) -> - projectFileName1 = projectFileName2 && (getStamp1()) = (getStamp2()) - | ILModuleReference(projectFileName1, getStamp1, _), ILModuleReference(projectFileName2, getStamp2, _) -> - projectFileName1 = projectFileName2 && (getStamp1()) = (getStamp2()) + | FSharpReference(projectOutputFile1, options1), FSharpReference(projectOutputFile2, options2) -> + projectOutputFile1 = projectOutputFile2 && options1 = options2 + | PEReference(projectOutputFile1, getStamp1, _), PEReference(projectOutputFile2, getStamp2, _) -> + projectOutputFile1 = projectOutputFile2 && (getStamp1()) = (getStamp2()) + | ILModuleReference(projectOutputFile1, getStamp1, _), ILModuleReference(projectOutputFile2, getStamp2, _) -> + projectOutputFile1 = projectOutputFile2 && (getStamp1()) = (getStamp2()) | _ -> false | _ -> false - override this.GetHashCode() = this.FileName.GetHashCode() + override this.GetHashCode() = this.OutputFile.GetHashCode() // NOTE: may be better just to move to optional arguments here and FSharpProjectOptions = diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 5ce5b6d17a9..a32176b61ee 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -96,23 +96,39 @@ type public FSharpProjectOptions = and [] public FSharpReferencedProject = internal - | FSharpReference of projectFileName: string * options: FSharpProjectOptions - | PEReference of projectFileName: string * getStamp: (unit -> DateTime) * delayedReader: DelayedILModuleReader - | ILModuleReference of projectFileName: string * getStamp: (unit -> DateTime) * getReader: (unit -> ILModuleReader) + | FSharpReference of projectOutputFile: string * options: FSharpProjectOptions + | PEReference of projectOutputFile: string * getStamp: (unit -> DateTime) * delayedReader: DelayedILModuleReader + | ILModuleReference of projectOutputFile: string * getStamp: (unit -> DateTime) * getReader: (unit -> ILModuleReader) - member FileName : string + /// + /// The fully qualified path to the output of the referenced project. This should be the same value as the -r + /// reference in the project options for this referenced project. + /// + member OutputFile : string + /// /// Creates a reference for an F# project. The physical data for it is stored/cached inside of the compiler service. - static member CreateFSharp : projectFileName: string * options: FSharpProjectOptions -> FSharpReferencedProject + /// + ///The fully qualified path to the output of the referenced project. This should be the same value as the -r reference in the project options for this referenced project. + ///The Project Options for this F# project + static member CreateFSharp : projectOutputFile: string * options: FSharpProjectOptions -> FSharpReferencedProject + /// /// Creates a reference for any portable executable, including F#. The stream is owned by this reference. /// The stream will be automatically disposed when there are no references to FSharpReferencedProject and is GC collected. /// Once the stream is evaluated, the function that constructs the stream will no longer be referenced by anything. /// If the stream evaluation throws an exception, it will be automatically handled. - static member CreatePortableExecutable : projectFileName: string * getStamp: (unit -> DateTime) * getStream: (CancellationToken -> Stream option) -> FSharpReferencedProject - - /// Creates a reference from an ILModuleReader. - static member CreateFromILModuleReader : projectFileName: string * getStamp: (unit -> DateTime) * getReader: (unit -> ILModuleReader) -> FSharpReferencedProject + /// + ///The fully qualified path to the output of the referenced project. This should be the same value as the -r reference in the project options for this referenced project. + ///A function that calculates a last-modified timestamp for this reference. This will be used to determine if the reference is up-to-date. + ///A function that opens a Portable Executable data stream for reading. + static member CreatePortableExecutable : projectOutputFile: string * getStamp: (unit -> DateTime) * getStream: (CancellationToken -> Stream option) -> FSharpReferencedProject + + ///Creates a reference from an ILModuleReader. + ///The fully qualified path to the output of the referenced project. This should be the same value as the -r reference in the project options for this referenced project. + ///A function that calculates a last-modified timestamp for this reference. This will be used to determine if the reference is up-to-date. + ///A function that creates an ILModuleReader for reading module data. + static member CreateFromILModuleReader : projectOutputFile: string * getStamp: (unit -> DateTime) * getReader: (unit -> ILModuleReader) -> FSharpReferencedProject /// Represents the use of an F# symbol from F# source code [] diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index d19284b9197..9a1367657e6 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -2131,9 +2131,9 @@ FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: FSharp.Compiler.CodeAnalys FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: FSharp.Compiler.CodeAnalysis.FSharpReferencedProject CreateFromILModuleReader(System.String, Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.DateTime], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,FSharp.Compiler.AbstractIL.ILBinaryReader+ILModuleReader]) FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: FSharp.Compiler.CodeAnalysis.FSharpReferencedProject CreatePortableExecutable(System.String, Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.DateTime], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,Microsoft.FSharp.Core.FSharpOption`1[System.IO.Stream]]) FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: Int32 GetHashCode() -FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: System.String FileName +FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: System.String OutputFile FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: System.String ToString() -FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: System.String get_FileName() +FSharp.Compiler.CodeAnalysis.FSharpReferencedProject: System.String get_OutputFile() FSharp.Compiler.CodeAnalysis.FSharpSymbolUse FSharp.Compiler.CodeAnalysis.FSharpSymbolUse: Boolean IsFromAttribute FSharp.Compiler.CodeAnalysis.FSharpSymbolUse: Boolean IsFromComputationExpression From edd4c3b902bb28af15460813a823346fb4c17ad3 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 23 Nov 2021 10:56:11 +0000 Subject: [PATCH 20/26] 12322: Fix deep recursive expression processing (#12420) --- docs/large-inputs-and-stack-overflows.md | 35 + src/fsharp/BuildGraph.fs | 18 +- src/fsharp/BuildGraph.fsi | 7 - src/fsharp/CheckComputationExpressions.fs | 2 + src/fsharp/CheckDeclarations.fs | 6 +- src/fsharp/CheckExpressions.fs | 16 +- src/fsharp/CheckExpressions.fsi | 4 + src/fsharp/CompilerDiagnostics.fs | 2 +- src/fsharp/DetupleArgs.fs | 35 +- src/fsharp/ErrorLogger.fs | 71 +- src/fsharp/ErrorLogger.fsi | 21 + src/fsharp/FindUnsolved.fs | 14 +- src/fsharp/IlxGen.fs | 56 +- src/fsharp/InnerLambdasToTopLevelFuncs.fs | 23 +- src/fsharp/LowerCallsAndSeqs.fs | 13 +- src/fsharp/LowerStateMachines.fs | 6 +- src/fsharp/Optimizer.fs | 16 +- src/fsharp/PostInferenceChecks.fs | 33 +- src/fsharp/TypedTreeOps.fs | 499 +++--- src/fsharp/TypedTreeOps.fsi | 8 +- src/fsharp/TypedTreePickle.fs | 4 +- src/fsharp/absil/illib.fs | 13 +- src/fsharp/absil/ilprint.fs | 5 +- src/fsharp/absil/ilwritepdb.fs | 14 +- src/fsharp/autobox.fs | 7 +- src/fsharp/fscmain.fs | 5 +- src/fsharp/lib.fs | 12 - src/fsharp/lib.fsi | 3 - src/fsharp/tainted.fs | 2 + tests/FSharp.Test.Utilities/TestFramework.fs | 6 +- tests/fsharp/TypeProviderTests.fs | 12 +- tests/fsharp/core/innerpoly/test.fsx | 2 +- tests/fsharp/readme.md | 2 +- tests/fsharp/regression/12322/test.fsx | 1494 ++++++++++++++++++ tests/fsharp/single-test.fs | 47 +- tests/fsharp/tests.fs | 457 +++--- 36 files changed, 2358 insertions(+), 612 deletions(-) create mode 100644 tests/fsharp/regression/12322/test.fsx diff --git a/docs/large-inputs-and-stack-overflows.md b/docs/large-inputs-and-stack-overflows.md index 0f8dc53da9f..dc3d2adb5fb 100644 --- a/docs/large-inputs-and-stack-overflows.md +++ b/docs/large-inputs-and-stack-overflows.md @@ -21,6 +21,13 @@ The compiler performs constant folding for large constants so there are no costs Many sources of `StackOverflow` exceptions prior to F# 4.7 when processing these kinds of constructs were resolved by processing them on the heap via continuation passing techniques. This avoids filling data on the stack and appears to have negligible effects on overall throughout or memory usage of the compiler. +There are two techniques to deal with this + +1. Linearizing processing of specific input shapes, keeping stacks small +2. Using stack guards to simply temporarily move to a new thread when a certain threshold is reached. + +## Linearizing processing if certain inputs + Aside from array expressions, most of the previously-listed inputs are called "linear" expressions. This means that there is a single linear hole in the shape of expressions. For example: * `expr :: HOLE` (list expressions or other right-linear constructions) @@ -80,3 +87,31 @@ Some common aspects of this style of programming are: The previous example is considered incomplete, because arbitrary _combinations_ of `let` and sequential expressions aren't going to be dealt with in a tail-recursive way. The compiler generally tries to do these combinations as well. +## Stack Guards + +The `StackGuard` type is used to count synchronous recursive processing and move to a new thread if a limit is reached. Compilation globals are re-installed. Sample: + +```fsharp +let TcStackGuardDepth = StackGuard.GetDepthOption "Tc" + +... + stackGuard = StackGuard(TcMaxStackGuardDepth) + +let rec .... + +and TcExpr cenv ty (env: TcEnv) tpenv (expr: SynExpr) = + + // Guard the stack for deeply nested expressions + cenv.stackGuard.Guard <| fun () -> + + ... + +``` + +Note stack guarding doesn't result in a tailcall so will appear in recursive stack frames, because a counter must be decremented after the call. This is used systematically for recursive processing of: + +* SyntaxTree SynExpr +* TypedTree Expr + +We don't use it for other inputs. + diff --git a/src/fsharp/BuildGraph.fs b/src/fsharp/BuildGraph.fs index df797d0a3b3..36fe5e77ba6 100644 --- a/src/fsharp/BuildGraph.fs +++ b/src/fsharp/BuildGraph.fs @@ -10,22 +10,6 @@ open System.Globalization open FSharp.Compiler.ErrorLogger open Internal.Utilities.Library -/// This represents the thread-local state established as each task function runs as part of the build. -/// -/// Use to reset error and warning handlers. -type CompilationGlobalsScope(errorLogger: ErrorLogger, phase: BuildPhase) = - let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) - let unwindBP = PushThreadBuildPhaseUntilUnwind phase - - member _.ErrorLogger = errorLogger - member _.Phase = phase - - // Return the disposable object that cleans up - interface IDisposable with - member d.Dispose() = - unwindBP.Dispose() - unwindEL.Dispose() - [] type NodeCode<'T> = Node of Async<'T> @@ -89,7 +73,7 @@ type NodeCodeBuilder() = Node( async { CompileThreadStatic.ErrorLogger <- value.ErrorLogger - CompileThreadStatic.BuildPhase <- value.Phase + CompileThreadStatic.BuildPhase <- value.BuildPhase try return! binder value |> Async.AwaitNodeCode finally diff --git a/src/fsharp/BuildGraph.fsi b/src/fsharp/BuildGraph.fsi index cf1d750c3e0..39a5093a0fc 100644 --- a/src/fsharp/BuildGraph.fsi +++ b/src/fsharp/BuildGraph.fsi @@ -8,13 +8,6 @@ open System.Threading.Tasks open FSharp.Compiler.ErrorLogger open Internal.Utilities.Library -/// This represents the global state established as each task function runs as part of the build. -/// -/// Use to reset error and warning handlers. -type CompilationGlobalsScope = - new : ErrorLogger * BuildPhase -> CompilationGlobalsScope - interface IDisposable - /// Represents code that can be run as part of the build graph. /// /// This is essentially cancellable async code where the only asynchronous waits are on nodes. diff --git a/src/fsharp/CheckComputationExpressions.fs b/src/fsharp/CheckComputationExpressions.fs index 03816ca3aa0..2f23df7172c 100644 --- a/src/fsharp/CheckComputationExpressions.fs +++ b/src/fsharp/CheckComputationExpressions.fs @@ -760,6 +760,8 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter // translatedCtxt - represents the translation of the context in which the computation expression 'comp' occurs, up to a // hole to be filled by (part of) the results of translating 'comp'. let rec tryTrans firstTry q varSpace comp translatedCtxt = + // Guard the stack for deeply nested computation expressions + cenv.stackGuard.Guard <| fun () -> match comp with diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 623ae199e7b..ad0011b2ea7 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -42,6 +42,8 @@ open FSharp.Compiler.ExtensionTyping type cenv = TcFileState +let TcClassRewriteStackGuardDepth = StackGuard.GetDepthOption "TcClassRewrite" + //------------------------------------------------------------------------- // Mutually recursive shapes //------------------------------------------------------------------------- @@ -1144,8 +1146,8 @@ module IncrClassChecking = RewriteExpr { PreIntercept = Some FixupExprNode PostTransform = (fun _ -> None) PreInterceptBinding = None - IsUnderQuotations=true } expr - + RewriteQuotations = true + StackGuard = StackGuard(TcClassRewriteStackGuardDepth) } expr type IncrClassConstructionBindingsPhase2C = | Phase2CBindings of IncrClassBindingGroup list diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 1d6d30b1084..5c66fd46a4e 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -51,6 +51,12 @@ let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref, [ty], [], m) let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref, [ty], [ph;pt], unionRanges ph.Range pt.Range) +#if DEBUG +let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 40 +#else +let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 80 +#endif + //------------------------------------------------------------------------- // Errors. //------------------------------------------------------------------------- @@ -358,6 +364,9 @@ type TcFileState = /// we infer type parameters mutable recUses: ValMultiMap + /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached + stackGuard: StackGuard + /// Set to true if this file causes the creation of generated provided types. mutable createsGeneratedProvidedTypes: bool @@ -421,6 +430,7 @@ type TcFileState = { g = g amap = amap recUses = ValMultiMap<_>.Empty + stackGuard = StackGuard(TcStackGuardDepth) createsGeneratedProvidedTypes = false topCcu = topCcu isScript = isScript @@ -5359,7 +5369,11 @@ and TcExprFlex2 cenv desiredTy env isMethodArg tpenv synExpr = TcExpr cenv (MustConvertTo (isMethodArg, desiredTy)) env tpenv synExpr and TcExpr cenv ty (env: TcEnv) tpenv (expr: SynExpr) = - // Start an error recovery handler + + // Guard the stack for deeply nested expressions + cenv.stackGuard.Guard <| fun () -> + + // Start an error recovery handler, and check for stack recursion depth, moving to a new stack if necessary. // Note the try/with can lead to tail-recursion problems for iterated constructs, e.g. let... in... // So be careful! try diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index b64b1dfc853..146be1dde99 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -10,6 +10,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -180,6 +181,9 @@ type TcFileState = /// we infer type parameters mutable recUses: ValMultiMap + /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached + stackGuard: StackGuard + /// Set to true if this file causes the creation of generated provided types. mutable createsGeneratedProvidedTypes: bool diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index bda44aac036..54b36bef3d0 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -1656,7 +1656,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa os.Append(TargetInvocationExceptionWrapperE().Format e.Message) |> ignore #if DEBUG Printf.bprintf os "\nStack Trace\n%s\n" (e.ToString()) - if !showAssertForUnexpectedException then + if showAssertForUnexpectedException.Value then Debug.Assert(false, sprintf "Unknown exception seen in compiler: %s" (e.ToString())) #endif diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index af0b8c6233a..bbbf217c21d 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -5,13 +5,16 @@ module internal FSharp.Compiler.Detuple open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras -open FSharp.Compiler.TcGlobals +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text -open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.Xml + +let DetupleRewriteStackGuardDepth = StackGuard.GetDepthOption "DetupleRewrite" // This pass has one aim. // - to eliminate tuples allocated at call sites (due to uncurried style) @@ -174,16 +177,23 @@ module GlobalUsageAnalysis = /// where first accessor in list applies first to the v/app. /// (b) log it's binding site representation. type Results = - { /// v -> context / APP inst args + { + /// v -> context / APP inst args Uses : Zmap + /// v -> binding repr Defns : Zmap + /// bound in a decision tree? - DecisionTreeBindings : Zset + DecisionTreeBindings: Zset + /// v -> v list * recursive? -- the others in the mutual binding - RecursiveBindings : Zmap - TopLevelBindings : Zset - IterationIsAtTopLevel : bool } + RecursiveBindings: Zmap + + TopLevelBindings: Zset + + IterationIsAtTopLevel: bool + } let z0 = { Uses = Zmap.empty valOrder @@ -841,10 +851,13 @@ let postTransformExpr (penv: penv) expr = | _ -> None let passImplFile penv assembly = - assembly |> RewriteImplFile { PreIntercept =None - PreInterceptBinding=None - PostTransform= postTransformExpr penv - IsUnderQuotations=false } + let rwenv = + { PreIntercept = None + PreInterceptBinding = None + PostTransform = postTransformExpr penv + RewriteQuotations = false + StackGuard = StackGuard(DetupleRewriteStackGuardDepth) } + assembly |> RewriteImplFile rwenv //------------------------------------------------------------------------- // entry point diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index 6757b628cf9..24b7c98b424 100644 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -8,6 +8,9 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.Text open System open System.Diagnostics +open System.Threading +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras /// Represents the style being used to format errors [] @@ -433,33 +436,38 @@ module ErrorLoggerExtensions = /// NOTE: The change will be undone when the returned "unwind" object disposes let PushThreadBuildPhaseUntilUnwind (phase:BuildPhase) = let oldBuildPhase = CompileThreadStatic.BuildPhaseUnchecked - CompileThreadStatic.BuildPhase <- phase - { new IDisposable with - member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase (* maybe null *) } + member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase } /// NOTE: The change will be undone when the returned "unwind" object disposes -let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer : ErrorLogger -> #ErrorLogger) = +let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer: ErrorLogger -> #ErrorLogger) = let oldErrorLogger = CompileThreadStatic.ErrorLogger - let newErrorLogger = errorLoggerTransformer oldErrorLogger - let mutable newInstalled = true - let newIsInstalled() = if newInstalled then () else (assert false; (); (*failwith "error logger used after unwind"*)) // REVIEW: ok to throw? - let chkErrorLogger = { new ErrorLogger("PushErrorLoggerPhaseUntilUnwind") with - member _.DiagnosticSink(phasedError, isError) = newIsInstalled(); newErrorLogger.DiagnosticSink(phasedError, isError) - member _.ErrorCount = newIsInstalled(); newErrorLogger.ErrorCount } - - CompileThreadStatic.ErrorLogger <- chkErrorLogger - + CompileThreadStatic.ErrorLogger <- errorLoggerTransformer oldErrorLogger { new IDisposable with member _.Dispose() = - CompileThreadStatic.ErrorLogger <- oldErrorLogger - newInstalled <- false } + CompileThreadStatic.ErrorLogger <- oldErrorLogger } let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase let SetThreadErrorLoggerNoUnwind errorLogger = CompileThreadStatic.ErrorLogger <- errorLogger +/// This represents the thread-local state established as each task function runs as part of the build. +/// +/// Use to reset error and warning handlers. +type CompilationGlobalsScope(errorLogger: ErrorLogger, buildPhase: BuildPhase) = + let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) + let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase + + member _.ErrorLogger = errorLogger + member _.BuildPhase = buildPhase + + // Return the disposable object that cleans up + interface IDisposable with + member _.Dispose() = + unwindBP.Dispose() + unwindEL.Dispose() + // Global functions are still used by parser and TAST ops. /// Raises an exception with error recovery and returns unit. @@ -697,3 +705,36 @@ let internal languageFeatureNotSupportedInLibraryError (langVersion: LanguageVer let featureStr = langVersion.GetFeatureString langFeature let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary(featureStr, suggestedVersionStr), m)) + +/// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached +type StackGuard(maxDepth: int) = + + let mutable depth = 1 + + member _.Guard(f) = + depth <- depth + 1 + try + if depth % maxDepth = 0 then + let errorLogger = CompileThreadStatic.ErrorLogger + let buildPhase = CompileThreadStatic.BuildPhase + async { + do! Async.SwitchToNewThread() + Thread.CurrentThread.Name <- "F# Extra Compilation Thread" + use _scope = new CompilationGlobalsScope(errorLogger, buildPhase) + return f() + } |> Async.RunImmediate + else + f() + finally + depth <- depth - 1 + + static member val DefaultDepth = +#if DEBUG + GetEnvInteger "FSHARP_DefaultStackGuardDepth" 50 +#else + GetEnvInteger "FSHARP_DefaultStackGuardDepth" 100 +#endif + + static member GetDepthOption (name: string) = + GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth + diff --git a/src/fsharp/ErrorLogger.fsi b/src/fsharp/ErrorLogger.fsi index 97f4069ce84..06725175c1b 100644 --- a/src/fsharp/ErrorLogger.fsi +++ b/src/fsharp/ErrorLogger.fsi @@ -338,3 +338,24 @@ val checkLanguageFeatureErrorRecover: langVersion:LanguageVersion -> langFeature val tryLanguageFeatureErrorOption: langVersion:LanguageVersion -> langFeature:LanguageFeature -> m:range -> exn option val languageFeatureNotSupportedInLibraryError: langVersion:LanguageVersion -> langFeature:LanguageFeature -> m:range -> 'a + +type StackGuard = + new: maxDepth: int -> StackGuard + + /// Execute the new function, on a new thread if necessary + member Guard: f: (unit -> 'T) -> 'T + + static member GetDepthOption: string -> int + +/// This represents the global state established as each task function runs as part of the build. +/// +/// Use to reset error and warning handlers. +type CompilationGlobalsScope = + new: errorLogger: ErrorLogger * buildPhase: BuildPhase -> CompilationGlobalsScope + + interface IDisposable + + member ErrorLogger: ErrorLogger + + member BuildPhase: BuildPhase + diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 40618fb8139..fded9468d87 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -5,7 +5,9 @@ module internal FSharp.Compiler.FindUnsolved open Internal.Utilities.Collections open Internal.Utilities.Library +open Internal.Utilities.Library.Extras open FSharp.Compiler +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps @@ -14,12 +16,15 @@ open FSharp.Compiler.TypeRelations type env = Nix +let FindUnsolvedStackGuardDepth = StackGuard.GetDepthOption "FindUnsolved" + /// The environment and collector type cenv = { g: TcGlobals amap: Import.ImportMap denv: DisplayEnv - mutable unsolved: Typars } + mutable unsolved: Typars + stackGuard: StackGuard } override x.ToString() = "" @@ -34,7 +39,9 @@ let accTypeInst cenv env tyargs = tyargs |> List.iter (accTy cenv env) /// Walk expressions, collecting type variables -let rec accExpr (cenv:cenv) (env:env) expr = +let rec accExpr (cenv:cenv) (env:env) expr = + cenv.stackGuard.Guard <| fun () -> + let expr = stripExpr expr match expr with | Expr.Sequential (e1, e2, _, _, _) -> @@ -278,7 +285,8 @@ let UnsolvedTyparsOfModuleDef g amap denv (mdef, extraAttribs) = { g =g amap=amap denv=denv - unsolved = [] } + unsolved = [] + stackGuard = StackGuard(FindUnsolvedStackGuardDepth) } accModuleOrNamespaceDef cenv Nix mdef accAttribs cenv Nix extraAttribs List.rev cenv.unsolved diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index f30f7b7c2b8..22266e786e5 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -40,6 +40,8 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint open FSharp.Compiler.TypeRelations +let IlxGenStackGuardDepth = StackGuard.GetDepthOption "IlxGen" + let IsNonErasedTypar (tp: Typar) = not tp.IsErased @@ -255,14 +257,12 @@ type cenv = /// Used to apply forced inlining optimizations to witnesses generated late during codegen mutable optimizeDuringCodeGen: bool -> Expr -> Expr - /// What depth are we at when generating an expression? - mutable exprRecursionDepth: int + /// Guard the stack and move to a new one if necessary + mutable stackGuard: StackGuard - /// Delayed Method Generation - prevents stack overflows when we need to generate methods that are split into many methods by the optimizer. - delayedGenMethods: Queue unit> } - override x.ToString() = "" + override _.ToString() = "" let mkTypeOfExpr cenv m ilty = @@ -2479,32 +2479,9 @@ let ProcessDebugPointForExpr (cenv: cenv) (cgbuf: CodeGenBuffer) sp expr = //------------------------------------------------------------------------- let rec GenExpr cenv cgbuf eenv sp (expr: Expr) sequel = - cenv.exprRecursionDepth <- cenv.exprRecursionDepth + 1 - - if cenv.exprRecursionDepth > 1 then - StackGuard.EnsureSufficientExecutionStack cenv.exprRecursionDepth - GenExprAux cenv cgbuf eenv sp expr sequel - else - GenExprWithStackGuard cenv cgbuf eenv sp expr sequel - - cenv.exprRecursionDepth <- cenv.exprRecursionDepth - 1 - - if cenv.exprRecursionDepth = 0 then - ProcessDelayedGenMethods cenv + cenv.stackGuard.Guard <| fun () -> -and ProcessDelayedGenMethods cenv = - while cenv.delayedGenMethods.Count > 0 do - let gen = cenv.delayedGenMethods.Dequeue () - gen cenv - -and GenExprWithStackGuard cenv cgbuf eenv sp expr sequel = - assert (cenv.exprRecursionDepth = 1) - try - GenExprAux cenv cgbuf eenv sp expr sequel - assert (cenv.exprRecursionDepth = 1) - with - | :? System.InsufficientExecutionStackException -> - error(InternalError(sprintf "Expression is too large and/or complex to emit. Method name: '%s'. Recursive depth: %i." cgbuf.MethodName cenv.exprRecursionDepth, expr.Range)) + GenExprAux cenv cgbuf eenv sp expr sequel /// Process the debug point and check for alternative ways to generate this expression. /// Returns 'true' if the expression was processed by alternative means. @@ -5364,7 +5341,7 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN NestedTypeRefForCompLoc eenvouter.cloc cloName // Collect the free variables of the closure - let cloFreeVarResults = freeInExpr CollectTyparsAndLocals expr + let cloFreeVarResults = freeInExpr (CollectTyparsAndLocalsWithStackGuard()) expr // Partition the free variables when some can be accessed from places besides the immediate environment // Also filter out the current value being bound, if any, as it is available from the "this" @@ -6851,20 +6828,10 @@ and GenMethodForBinding | [h] -> Some h | _ -> None - let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, selfValOpt, bodyExpr, sequel) + let ilCodeLazy = CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, selfValOpt, bodyExpr, sequel) // This is the main code generation for most methods - false, MethodBody.IL(ilCodeLazy), false - - match ilMethodBody with - | MethodBody.IL(ilCodeLazy) -> - if cenv.exprRecursionDepth > 0 then - cenv.delayedGenMethods.Enqueue(fun _ -> ilCodeLazy.Force() |> ignore) - else - // Eagerly codegen if we are not in an expression depth. - ilCodeLazy.Force() |> ignore - | _ -> - () + false, MethodBody.IL(notlazy ilCodeLazy), false // Do not generate DllImport attributes into the code - they are implicit from the P/Invoke let attrs = @@ -8924,8 +8891,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai intraAssemblyInfo = intraAssemblyInfo opts = codeGenOpts optimizeDuringCodeGen = (fun _flag expr -> expr) - exprRecursionDepth = 0 - delayedGenMethods = Queue () } + stackGuard = StackGuard(IlxGenStackGuardDepth) } GenerateCode (cenv, anonTypeTable, ilxGenEnv, typedAssembly, assemAttribs, moduleAttribs) /// Invert the compilation of the given value and clear the storage of the value diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index 2388de90d9f..9536978c39a 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -22,6 +22,8 @@ open FSharp.Compiler.TcGlobals let verboseTLR = false +let InnerLambdasToTopLevelFunctionsStackGuardDepth = StackGuard.GetDepthOption "InnerLambdasToTopLevelFunctions" + //------------------------------------------------------------------------- // library helpers //------------------------------------------------------------------------- @@ -482,7 +484,9 @@ module Pass2_DetermineReqdItems = if verboseTLR then dprintf "shortCall: not-rec: %s\n" gv.LogicalName state - let FreeInBindings bs = List.fold (foldOn (freeInBindingRhs CollectTyparsAndLocals) unionFreeVars) emptyFreeVars bs + let FreeInBindings bs = + let opts = CollectTyparsAndLocalsWithStackGuard() + List.fold (foldOn (freeInBindingRhs opts) unionFreeVars) emptyFreeVars bs /// Intercepts selected exprs. /// "letrec f1, f2, ... = fBody1, fBody2, ... in rest" - @@ -877,6 +881,7 @@ module Pass4_RewriteAssembly = type RewriteContext = { ccu: CcuThunk g: TcGlobals + stackGuard: StackGuard tlrS: Zset topValS: Zset arityM: Zmap @@ -1098,6 +1103,7 @@ module Pass4_RewriteAssembly = /// At free vals, fixup 0-call if it is an arity-met constant. /// Other cases rewrite structurally. let rec TransExpr (penv: RewriteContext) (z: RewriteState) expr: Expr * RewriteState = + penv.stackGuard.Guard <| fun () -> match expr with // Use TransLinearExpr with a rebuild-continuation for some forms to avoid stack overflows on large terms @@ -1128,7 +1134,7 @@ module Pass4_RewriteAssembly = // reclink - suppress | Expr.Link r -> - TransExpr penv z (!r) + TransExpr penv z r.Value // ilobj - has implicit lambda exprs and recursive/base references | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> @@ -1177,7 +1183,7 @@ module Pass4_RewriteAssembly = (typeDefs,argTypes,argExprs,data), z let data, z = - match !dataCell with + match dataCell.Value with | Some (data1, data2) -> let data1, z = doData data1 z let data2, z = doData data2 z @@ -1374,7 +1380,16 @@ let MakeTopLevelRepresentationDecisions ccu g expr = if verboseTLR then dprintf "TransExpr(rw)------\n" let expr, _ = let penv: Pass4_RewriteAssembly.RewriteContext = - {ccu=ccu; g=g; tlrS=tlrS; topValS=topValS; arityM=arityM; fclassM=fclassM; recShortCallS=recShortCallS; envPackM=envPackM; fHatM=fHatM} + { ccu = ccu + g = g + tlrS = tlrS + topValS = topValS + arityM = arityM + fclassM = fclassM + recShortCallS = recShortCallS + envPackM = envPackM + fHatM = fHatM + stackGuard = StackGuard(InnerLambdasToTopLevelFunctionsStackGuardDepth) } let z = Pass4_RewriteAssembly.rewriteState0 Pass4_RewriteAssembly.TransImplFile penv z expr diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index ec6a327b6e3..c8c19cbe03e 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -18,6 +18,8 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +let LowerCallsAndSeqsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsAndSeqsRewrite" + //---------------------------------------------------------------------------- // Eta-expansion of calls to top-level-methods @@ -53,10 +55,13 @@ let InterceptExpr g cont expr = /// any known arguments. The results are later optimized by the peephole /// optimizer in opt.fs let LowerImplFile g assembly = - RewriteImplFile { PreIntercept = Some(InterceptExpr g) - PreInterceptBinding=None - PostTransform= (fun _ -> None) - IsUnderQuotations=false } assembly + let rwenv = + { PreIntercept = Some(InterceptExpr g) + PreInterceptBinding=None + PostTransform= (fun _ -> None) + RewriteQuotations=false + StackGuard = StackGuard(LowerCallsAndSeqsRewriteStackGuardDepth) } + assembly |> RewriteImplFile rwenv //---------------------------------------------------------------------------- // General helpers diff --git a/src/fsharp/LowerStateMachines.fs b/src/fsharp/LowerStateMachines.fs index c0d4986f168..332326f23ca 100644 --- a/src/fsharp/LowerStateMachines.fs +++ b/src/fsharp/LowerStateMachines.fs @@ -6,6 +6,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -13,6 +14,8 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +let LowerStateMachineStackGuardDepth = GetEnvInteger "FSHARP_LowerStateMachine" 50 + let mkLabelled m l e = mkCompGenSequential m (Expr.Op (TOp.Label l, [], [], m)) e type StateMachineConversionFirstPhaseResult = @@ -354,7 +357,8 @@ type LowerStateMachine(g: TcGlobals) = { PreIntercept = Some (fun cont e -> match TryReduceExpr env e [] id with Some e2 -> Some (cont e2) | None -> None) PostTransform = (fun _ -> None) PreInterceptBinding = None - IsUnderQuotations=true } + RewriteQuotations=true + StackGuard = StackGuard(LowerStateMachineStackGuardDepth) } let ConvertStateMachineLeafExpression (env: env) expr = if sm_verbose then printfn "ConvertStateMachineLeafExpression for %A..." expr diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 72266c6bf1f..0b88e9c2c3b 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -34,6 +34,8 @@ open FSharp.Compiler.TypeRelations open System.Collections.Generic open System.Collections.ObjectModel +let OptimizerStackGuardDepth = GetEnvInteger "FSHARP_Optimizer" 50 + #if DEBUG let verboseOptimizationInfo = try not (System.String.IsNullOrEmpty (System.Environment.GetEnvironmentVariable "FSHARP_verboseOptimizationInfo")) with _ -> false @@ -428,6 +430,8 @@ type cenv = /// cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType casApplied: Dictionary + stackGuard: StackGuard + } override x.ToString() = "" @@ -1198,7 +1202,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = // Check for escape in lambda | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when - (let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr + (let fvs = freeInExpr (if isNil boundTyVars then (CollectLocalsWithStackGuard()) else CollectTyparsAndLocals) expr (not (isNil boundVars) && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) || (not (isNil boundTyVars) && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) || fvs.UsesMethodLocalConstructs) -> @@ -1459,7 +1463,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = let IsUniqueUse vspec2 args = valEq vspec1 vspec2 // REVIEW: this looks slow. Look only for one variable instead - && (let fvs = accFreeInExprs CollectLocals args emptyFreeVars + && (let fvs = accFreeInExprs (CollectLocalsWithStackGuard()) args emptyFreeVars not (Zset.contains vspec1 fvs.FreeLocals)) // Immediate consumption of value as 2nd or subsequent argument to a construction or projection operation @@ -2009,6 +2013,7 @@ let IsILMethodRefSystemStringConcatArray (mref: ILMethodRef) = /// Optimize/analyze an expression let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = + cenv.stackGuard.Guard <| fun () -> // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need // complete inference types. @@ -2540,7 +2545,7 @@ and OptimizeLinearExpr cenv env expr contf = OptimizeLinearExpr cenv env body (contf << (fun (bodyR, bodyInfo) -> // PERF: This call to ValueIsUsedOrHasEffect/freeInExpr amounts to 9% of all optimization time. // Is it quadratic or quasi-quadratic? - if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr CollectLocals bodyR).FreeLocals) (bindR, bindingInfo) then + if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr (CollectLocalsWithStackGuard()) bodyR).FreeLocals) (bindR, bindingInfo) then // Eliminate let bindings on the way back up let exprR, adjust = TryEliminateLet cenv env bindR bodyR m exprR, @@ -3492,7 +3497,7 @@ and ComputeSplitToMethodCondition flag threshold cenv env (e: Expr, einfo) = // We can only split an expression out as a method if certain conditions are met. // It can't use any protected or base calls, rethrow(), byrefs etc. let m = e.Range - (let fvs = freeInExpr CollectLocals e + (let fvs = freeInExpr (CollectLocalsWithStackGuard()) e not fvs.UsesUnboundRethrow && not fvs.UsesMethodLocalConstructs && fvs.FreeLocals |> Zset.forall (fun v -> @@ -3761,7 +3766,7 @@ and OptimizeModuleExpr cenv env x = let def = if not cenv.settings.LocalOptimizationsEnabled then def else - let fvs = freeInModuleOrNamespace CollectLocals def + let fvs = freeInModuleOrNamespace (CollectLocalsWithStackGuard()) def let dead = bindInfosColl |> List.filter (fun (bind, binfo) -> @@ -3919,6 +3924,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncr localInternalVals=Dictionary(10000) emitTailcalls=emitTailcalls casApplied=Dictionary() + stackGuard = StackGuard(OptimizerStackGuardDepth) } let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index dd3bcb7fc65..21f98a518f4 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -60,7 +60,7 @@ open FSharp.Compiler.TypeRelations // b) a lambda expression - rejected. // c) none of the above - rejected as when checking outmost expressions. - +let PostInferenceChecksStackGuardDepth = GetEnvInteger "FSHARP_PostInferenceChecks" 50 //-------------------------------------------------------------------------- // check environment @@ -208,6 +208,8 @@ type cenv = mutable anonRecdTypes: StampMap + stackGuard: StackGuard + g: TcGlobals amap: Import.ImportMap @@ -453,7 +455,7 @@ let CheckEscapes cenv allowProtected m syntacticArgs body = (* m is a range suit (v.IsBaseVal || isByrefLikeTy cenv.g m v.Type) && not (ListSet.contains valEq v syntacticArgs) - let frees = freeInExpr CollectLocals body + let frees = freeInExpr (CollectLocalsWithStackGuard()) body let fvs = frees.FreeLocals if not allowProtected && frees.UsesMethodLocalConstructs then @@ -1091,6 +1093,10 @@ and TryCheckResumableCodeConstructs cenv env expr : bool = /// Check an expression, given information about the position of the expression and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limit = + + // Guard the stack for deeply nested expressions + cenv.stackGuard.Guard <| fun () -> + let g = cenv.g let origExpr = stripExpr origExpr @@ -2579,22 +2585,23 @@ and CheckModuleSpec cenv env x = let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, tcValF, denv, mexpr, extraAttribs, isLastCompiland: bool*bool, isInternalTestSpanStackReferring) = let cenv = - { g =g - reportErrors=reportErrors + { g = g + reportErrors = reportErrors boundVals = Dictionary<_, _>(100, HashIdentity.Structural) limitVals = Dictionary<_, _>(100, HashIdentity.Structural) - potentialUnboundUsesOfVals=Map.empty + stackGuard = StackGuard(PostInferenceChecksStackGuardDepth) + potentialUnboundUsesOfVals = Map.empty anonRecdTypes = StampMap.Empty - usesQuotations=false - infoReader=infoReader - internalsVisibleToPaths=internalsVisibleToPaths - amap=amap - denv=denv - viewCcu= viewCcu - isLastCompiland=isLastCompiland + usesQuotations = false + infoReader = infoReader + internalsVisibleToPaths = internalsVisibleToPaths + amap = amap + denv = denv + viewCcu = viewCcu + isLastCompiland = isLastCompiland isInternalTestSpanStackReferring = isInternalTestSpanStackReferring tcVal = tcValF - entryPointGiven=false} + entryPointGiven = false} // Certain type equality checks go faster if these TyconRefs are pre-resolved. // This is because pre-resolving allows tycon equality to be determined by pointer equality on the entities. diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 97171eecb17..1dedf910ac6 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -32,6 +32,10 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.ExtensionTyping #endif +let AccFreeVarsStackGuardDepth = GetEnvInteger "FSHARP_AccFreeVars" 100 +let RemapExprStackGuardDepth = GetEnvInteger "FSHARP_RemapExpr" 50 +let FoldExprStackGuardDepth = GetEnvInteger "FSHARP_FoldExpr" 50 + //--------------------------------------------------------------------------- // Basic data structures //--------------------------------------------------------------------------- @@ -365,9 +369,9 @@ let remapTypes tyenv x = remapTypesAux tyenv x /// Use this one for any type that may be a forall type where the type variables may contain attributes -/// Logically speaking this is mutually recursive with remapAttrib defined much later in this file, +/// Logically speaking this is mutually recursive with remapAttribImpl defined much later in this file, /// because types may contain forall types that contain attributes, which need to be remapped. -/// We currently break the recursion by passing in remapAttrib as a function parameter. +/// We currently break the recursion by passing in remapAttribImpl as a function parameter. /// Use this one for any type that may be a forall type where the type variables may contain attributes let remapTypeFull remapAttrib tyenv ty = if isRemapEmpty tyenv then ty else @@ -1999,7 +2003,8 @@ type FreeVarOptions = includeLocalTyconReprs: bool includeRecdFields: bool includeUnionCases: bool - includeLocals: bool } + includeLocals: bool + stackGuard: StackGuard option } let CollectAllNoCaching = { canCache = false @@ -2009,7 +2014,8 @@ let CollectAllNoCaching = includeRecdFields = true includeUnionCases = true includeTypars = true - includeLocals = true } + includeLocals = true + stackGuard = None} let CollectTyparsNoCaching = { canCache = false @@ -2019,7 +2025,8 @@ let CollectTyparsNoCaching = includeLocalTyconReprs = false includeRecdFields = false includeUnionCases = false - includeLocals = false } + includeLocals = false + stackGuard = None } let CollectLocalsNoCaching = { canCache = false @@ -2029,7 +2036,8 @@ let CollectLocalsNoCaching = includeLocalTyconReprs = false includeRecdFields = false includeUnionCases = false - includeLocals = true } + includeLocals = true + stackGuard = None } let CollectTyparsAndLocalsNoCaching = { canCache = false @@ -2039,7 +2047,8 @@ let CollectTyparsAndLocalsNoCaching = includeRecdFields = false includeUnionCases = false includeTypars = true - includeLocals = true } + includeLocals = true + stackGuard = None } let CollectAll = { canCache = false @@ -2049,9 +2058,10 @@ let CollectAll = includeRecdFields = true includeUnionCases = true includeTypars = true - includeLocals = true } + includeLocals = true + stackGuard = None } -let CollectTyparsAndLocals = // CollectAll +let CollectTyparsAndLocalsImpl stackGuardOpt = // CollectAll { canCache = true // only cache for this one collectInTypes = true includeTypars = true @@ -2059,13 +2069,21 @@ let CollectTyparsAndLocals = // CollectAll includeLocalTycons = false includeLocalTyconReprs = false includeRecdFields = false - includeUnionCases = false } + includeUnionCases = false + stackGuard = stackGuardOpt } +let CollectTyparsAndLocals = CollectTyparsAndLocalsImpl None + let CollectTypars = CollectTyparsAndLocals let CollectLocals = CollectTyparsAndLocals +let CollectTyparsAndLocalsWithStackGuard() = + let stackGuard = StackGuard(AccFreeVarsStackGuardDepth) + CollectTyparsAndLocalsImpl (Some stackGuard) + +let CollectLocalsWithStackGuard() = CollectTyparsAndLocalsWithStackGuard() let accFreeLocalTycon opts x acc = if not opts.includeLocalTycons then acc else @@ -4714,8 +4732,14 @@ and accFreeInExprLinear (opts: FreeVarOptions) x acc contf = contf (accFreeInExpr opts x acc) and accFreeInExprNonLinear opts x acc = - match x with + + match opts.stackGuard with + | None -> accFreeInExprNonLinearImpl opts x acc + | Some stackGuard -> stackGuard.Guard (fun () -> accFreeInExprNonLinearImpl opts x acc) +and accFreeInExprNonLinearImpl opts x acc = + + match x with // BINDING CONSTRUCTS | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, bodyExpr, _, rty) -> unionFreeVars @@ -5165,36 +5189,42 @@ let tmenvCopyRemapAndBindTypars remapAttrib tmenv tps = let tmenvinner = tyenvinner tps', tmenvinner -let rec remapAttrib g tmenv (Attrib (tcref, kind, args, props, isGetOrSetAttr, targets, m)) = +type RemapContext = + { g: TcGlobals + stackGuard: StackGuard } + +let rec remapAttribImpl ctxt tmenv (Attrib (tcref, kind, args, props, isGetOrSetAttr, targets, m)) = Attrib(remapTyconRef tmenv.tyconRefRemap tcref, remapAttribKind tmenv kind, - args |> List.map (remapAttribExpr g tmenv), - props |> List.map (fun (AttribNamedArg(nm, ty, flg, expr)) -> AttribNamedArg(nm, remapType tmenv ty, flg, remapAttribExpr g tmenv expr)), + args |> List.map (remapAttribExpr ctxt tmenv), + props |> List.map (fun (AttribNamedArg(nm, ty, flg, expr)) -> AttribNamedArg(nm, remapType tmenv ty, flg, remapAttribExpr ctxt tmenv expr)), isGetOrSetAttr, targets, m) -and remapAttribExpr g tmenv (AttribExpr(e1, e2)) = - AttribExpr(remapExpr g CloneAll tmenv e1, remapExpr g CloneAll tmenv e2) +and remapAttribExpr ctxt tmenv (AttribExpr(e1, e2)) = + AttribExpr(remapExprImpl ctxt CloneAll tmenv e1, remapExprImpl ctxt CloneAll tmenv e2) -and remapAttribs g tmenv xs = List.map (remapAttrib g tmenv) xs +and remapAttribs ctxt tmenv xs = + List.map (remapAttribImpl ctxt tmenv) xs -and remapPossibleForallTy g tmenv ty = remapTypeFull (remapAttribs g tmenv) tmenv ty +and remapPossibleForallTyImpl ctxt tmenv ty = + remapTypeFull (remapAttribs ctxt tmenv) tmenv ty -and remapArgData g tmenv (argInfo: ArgReprInfo) : ArgReprInfo = - { Attribs = remapAttribs g tmenv argInfo.Attribs; Name = argInfo.Name } +and remapArgData ctxt tmenv (argInfo: ArgReprInfo) : ArgReprInfo = + { Attribs = remapAttribs ctxt tmenv argInfo.Attribs; Name = argInfo.Name } -and remapValReprInfo g tmenv (ValReprInfo(tpNames, arginfosl, retInfo)) = - ValReprInfo(tpNames, List.mapSquared (remapArgData g tmenv) arginfosl, remapArgData g tmenv retInfo) +and remapValReprInfo ctxt tmenv (ValReprInfo(tpNames, arginfosl, retInfo)) = + ValReprInfo(tpNames, List.mapSquared (remapArgData ctxt tmenv) arginfosl, remapArgData ctxt tmenv retInfo) -and remapValData g tmenv (d: ValData) = +and remapValData ctxt tmenv (d: ValData) = let ty = d.val_type let topValInfo = d.ValReprInfo - let tyR = ty |> remapPossibleForallTy g tmenv + let tyR = ty |> remapPossibleForallTyImpl ctxt tmenv let declaringEntityR = d.DeclaringEntity |> remapParentRef tmenv - let reprInfoR = d.ValReprInfo |> Option.map (remapValReprInfo g tmenv) - let memberInfoR = d.MemberInfo |> Option.map (remapMemberInfo g d.val_range topValInfo ty tyR tmenv) - let attribsR = d.Attribs |> remapAttribs g tmenv + let reprInfoR = d.ValReprInfo |> Option.map (remapValReprInfo ctxt tmenv) + let memberInfoR = d.MemberInfo |> Option.map (remapMemberInfo ctxt d.val_range topValInfo ty tyR tmenv) + let attribsR = d.Attribs |> remapAttribs ctxt tmenv { d with val_type = tyR val_opt_data = @@ -5222,28 +5252,32 @@ and copyVal compgen (v: Val) = | OnlyCloneExprVals when v.IsMemberOrModuleBinding -> v | _ -> v |> Construct.NewModifiedVal id -and fixupValData g compgen tmenv (v2: Val) = +and fixupValData ctxt compgen tmenv (v2: Val) = // only fixup if we copy the value match compgen with | OnlyCloneExprVals when v2.IsMemberOrModuleBinding -> () | _ -> - let newData = remapValData g tmenv v2 |> markAsCompGen compgen + let newData = remapValData ctxt tmenv v2 |> markAsCompGen compgen // uses the same stamp v2.SetData newData -and copyAndRemapAndBindVals g compgen tmenv vs = +and copyAndRemapAndBindVals ctxt compgen tmenv vs = let vs2 = vs |> List.map (copyVal compgen) let tmenvinner = bindLocalVals vs vs2 tmenv - vs2 |> List.iter (fixupValData g compgen tmenvinner) + vs2 |> List.iter (fixupValData ctxt compgen tmenvinner) vs2, tmenvinner -and copyAndRemapAndBindVal g compgen tmenv v = +and copyAndRemapAndBindVal ctxt compgen tmenv v = let v2 = v |> copyVal compgen let tmenvinner = bindLocalVal v v2 tmenv - fixupValData g compgen tmenvinner v2 + fixupValData ctxt compgen tmenvinner v2 v2, tmenvinner -and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = +and remapExprImpl (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) expr = + + // Guard against stack overflow, moving to a whole new stack if necessary + ctxt.stackGuard.Guard <| fun () -> + match expr with // Handle the linear cases for arbitrary-sized inputs @@ -5251,27 +5285,27 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = | LinearMatchExpr _ | Expr.Sequential _ | Expr.Let _ -> - remapLinearExpr g compgen tmenv expr (fun x -> x) + remapLinearExpr ctxt compgen tmenv expr (fun x -> x) // Binding constructs - see also dtrees below | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, b, m, rty) -> - remapLambaExpr g compgen tmenv (ctorThisValOpt, baseValOpt, vs, b, m, rty) + remapLambaExpr ctxt compgen tmenv (ctorThisValOpt, baseValOpt, vs, b, m, rty) | Expr.TyLambda (_, tps, b, m, rty) -> - let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - mkTypeLambda m tps' (remapExpr g compgen tmenvinner b, remapType tmenvinner rty) + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv tps + mkTypeLambda m tps' (remapExprImpl ctxt compgen tmenvinner b, remapType tmenvinner rty) | Expr.TyChoose (tps, b, m) -> - let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - Expr.TyChoose (tps', remapExpr g compgen tmenvinner b, m) + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv tps + Expr.TyChoose (tps', remapExprImpl ctxt compgen tmenvinner b, m) | Expr.LetRec (binds, e, m, _) -> - let binds', tmenvinner = copyAndRemapAndBindBindings g compgen tmenv binds - Expr.LetRec (binds', remapExpr g compgen tmenvinner e, m, Construct.NewFreeVarsCache()) + let binds', tmenvinner = copyAndRemapAndBindBindings ctxt compgen tmenv binds + Expr.LetRec (binds', remapExprImpl ctxt compgen tmenvinner e, m, Construct.NewFreeVarsCache()) | Expr.Match (spBind, exprm, pt, targets, m, ty) -> - primMkMatch (spBind, exprm, remapDecisionTree g compgen tmenv pt, - targets |> Array.map (remapTarget g compgen tmenv), + primMkMatch (spBind, exprm, remapDecisionTree ctxt compgen tmenv pt, + targets |> Array.map (remapTarget ctxt compgen tmenv), m, remapType tmenv ty) | Expr.Val (vr, vf, m) -> @@ -5281,14 +5315,14 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = else Expr.Val (vr', vf', m) | Expr.Quote (a, dataCell, isFromQueryExpression, m, ty) -> - remapQuoteExpr g compgen tmenv (a, dataCell, isFromQueryExpression, m, ty) + remapQuoteExpr ctxt compgen tmenv (a, dataCell, isFromQueryExpression, m, ty) | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> - let basev', tmenvinner = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv basev + let basev', tmenvinner = Option.mapFold (copyAndRemapAndBindVal ctxt compgen) tmenv basev mkObjExpr (remapType tmenv ty, basev', - remapExpr g compgen tmenv basecall, - List.map (remapMethod g compgen tmenvinner) overrides, - List.map (remapInterfaceImpl g compgen tmenvinner) iimpls, m) + remapExprImpl ctxt compgen tmenv basecall, + List.map (remapMethod ctxt compgen tmenvinner) overrides, + List.map (remapInterfaceImpl ctxt compgen tmenvinner) iimpls, m) // Addresses of immutable field may "leak" across assembly boundaries - see CanTakeAddressOfRecdFieldRef below. // This is "ok", in the sense that it is always valid to fix these up to be uses @@ -5297,34 +5331,34 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = | Expr.Op (TOp.ValFieldGetAddr (rfref, readonly), tinst, [arg], m) when not rfref.RecdField.IsMutable && - not (entityRefInThisAssembly g.compilingFslib rfref.TyconRef) -> + not (entityRefInThisAssembly ctxt.g.compilingFslib rfref.TyconRef) -> let tinst = remapTypes tmenv tinst - let arg = remapExpr g compgen tmenv arg + let arg = remapExprImpl ctxt compgen tmenv arg let tmp, _ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfRecdFieldRef rfref tinst) mkCompGenLet m tmp (mkRecdFieldGetViaExprAddr (arg, rfref, tinst, m)) (mkValAddr m readonly (mkLocalValRef tmp)) | Expr.Op (TOp.UnionCaseFieldGetAddr (uref, cidx, readonly), tinst, [arg], m) when not (uref.FieldByIndex(cidx).IsMutable) && - not (entityRefInThisAssembly g.compilingFslib uref.TyconRef) -> + not (entityRefInThisAssembly ctxt.g.compilingFslib uref.TyconRef) -> let tinst = remapTypes tmenv tinst - let arg = remapExpr g compgen tmenv arg + let arg = remapExprImpl ctxt compgen tmenv arg let tmp, _ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfUnionFieldRef uref cidx tinst) mkCompGenLet m tmp (mkUnionCaseFieldGetProvenViaExprAddr (arg, uref, tinst, cidx, m)) (mkValAddr m readonly (mkLocalValRef tmp)) | Expr.Op (op, tinst, args, m) -> - remapOpExpr g compgen tmenv (op, tinst, args, m) expr + remapOpExpr ctxt compgen tmenv (op, tinst, args, m) expr | Expr.App (e1, e1ty, tyargs, args, m) -> - remapAppExpr g compgen tmenv (e1, e1ty, tyargs, args, m) expr + remapAppExpr ctxt compgen tmenv (e1, e1ty, tyargs, args, m) expr | Expr.Link eref -> - remapExpr g compgen tmenv eref.Value + remapExprImpl ctxt compgen tmenv eref.Value | Expr.StaticOptimization (cs, e2, e3, m) -> // note that type instantiation typically resolve the static constraints here - mkStaticOptimizationExpr g (List.map (remapConstraint tmenv) cs, remapExpr g compgen tmenv e2, remapExpr g compgen tmenv e3, m) + mkStaticOptimizationExpr ctxt.g (List.map (remapConstraint tmenv) cs, remapExprImpl ctxt compgen tmenv e2, remapExprImpl ctxt compgen tmenv e3, m) | Expr.Const (c, m, ty) -> let ty' = remapType tmenv ty @@ -5334,78 +5368,78 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = let traitInfoR = remapTraitInfo tmenv traitInfo Expr.WitnessArg (traitInfoR, m) -and remapLambaExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) (ctorThisValOpt, baseValOpt, vs, b, m, rty) = - let ctorThisValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv ctorThisValOpt - let baseValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv baseValOpt - let vs, tmenv = copyAndRemapAndBindVals g compgen tmenv vs - let b = remapExpr g compgen tmenv b +and remapLambaExpr (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) (ctorThisValOpt, baseValOpt, vs, b, m, rty) = + let ctorThisValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal ctxt compgen) tmenv ctorThisValOpt + let baseValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal ctxt compgen) tmenv baseValOpt + let vs, tmenv = copyAndRemapAndBindVals ctxt compgen tmenv vs + let b = remapExprImpl ctxt compgen tmenv b let rty = remapType tmenv rty Expr.Lambda (newUnique(), ctorThisValOpt, baseValOpt, vs, b, m, rty) -and remapQuoteExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) (a, dataCell, isFromQueryExpression, m, ty) = - let doData (typeDefs, argTypes, argExprs, res) = (typeDefs, remapTypesAux tmenv argTypes, remapExprs g compgen tmenv argExprs, res) +and remapQuoteExpr (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) (a, dataCell, isFromQueryExpression, m, ty) = + let doData (typeDefs, argTypes, argExprs, res) = (typeDefs, remapTypesAux tmenv argTypes, remapExprs ctxt compgen tmenv argExprs, res) let data' = match dataCell.Value with | None -> None | Some (data1, data2) -> Some (doData data1, doData data2) // fix value of compgen for both original expression and pickled AST let compgen = fixValCopyFlagForQuotations compgen - Expr.Quote (remapExpr g compgen tmenv a, ref data', isFromQueryExpression, m, remapType tmenv ty) + Expr.Quote (remapExprImpl ctxt compgen tmenv a, ref data', isFromQueryExpression, m, remapType tmenv ty) -and remapOpExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) (op, tinst, args, m) origExpr = +and remapOpExpr (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) (op, tinst, args, m) origExpr = let op' = remapOp tmenv op let tinst' = remapTypes tmenv tinst - let args' = remapExprs g compgen tmenv args + let args' = remapExprs ctxt compgen tmenv args if op === op' && tinst === tinst' && args === args' then origExpr else Expr.Op (op', tinst', args', m) -and remapAppExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) (e1, e1ty, tyargs, args, m) origExpr = - let e1' = remapExpr g compgen tmenv e1 - let e1ty' = remapPossibleForallTy g tmenv e1ty +and remapAppExpr (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) (e1, e1ty, tyargs, args, m) origExpr = + let e1' = remapExprImpl ctxt compgen tmenv e1 + let e1ty' = remapPossibleForallTyImpl ctxt tmenv e1ty let tyargs' = remapTypes tmenv tyargs - let args' = remapExprs g compgen tmenv args + let args' = remapExprs ctxt compgen tmenv args if e1 === e1' && e1ty === e1ty' && tyargs === tyargs' && args === args' then origExpr else Expr.App (e1', e1ty', tyargs', args', m) -and remapTarget g compgen tmenv (TTarget(vs, e, spTarget, flags)) = - let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv vs - TTarget(vs', remapExpr g compgen tmenvinner e, spTarget, flags) +and remapTarget ctxt compgen tmenv (TTarget(vs, e, spTarget, flags)) = + let vs', tmenvinner = copyAndRemapAndBindVals ctxt compgen tmenv vs + TTarget(vs', remapExprImpl ctxt compgen tmenvinner e, spTarget, flags) -and remapLinearExpr g compgen tmenv expr contf = +and remapLinearExpr ctxt compgen tmenv expr contf = match expr with | Expr.Let (bind, bodyExpr, m, _) -> - let bind', tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind + let bind', tmenvinner = copyAndRemapAndBindBinding ctxt compgen tmenv bind // tailcall for the linear position - remapLinearExpr g compgen tmenvinner bodyExpr (contf << mkLetBind m bind') + remapLinearExpr ctxt compgen tmenvinner bodyExpr (contf << mkLetBind m bind') | Expr.Sequential (expr1, expr2, dir, spSeq, m) -> - let expr1' = remapExpr g compgen tmenv expr1 + let expr1' = remapExprImpl ctxt compgen tmenv expr1 // tailcall for the linear position - remapLinearExpr g compgen tmenv expr2 (contf << (fun expr2' -> + remapLinearExpr ctxt compgen tmenv expr2 (contf << (fun expr2' -> if expr1 === expr1' && expr2 === expr2' then expr else Expr.Sequential (expr1', expr2', dir, spSeq, m))) | LinearMatchExpr (spBind, exprm, dtree, tg1, expr2, sp2, m2, ty) -> - let dtree' = remapDecisionTree g compgen tmenv dtree - let tg1' = remapTarget g compgen tmenv tg1 + let dtree' = remapDecisionTree ctxt compgen tmenv dtree + let tg1' = remapTarget ctxt compgen tmenv tg1 let ty' = remapType tmenv ty // tailcall for the linear position - remapLinearExpr g compgen tmenv expr2 (contf << (fun expr2' -> + remapLinearExpr ctxt compgen tmenv expr2 (contf << (fun expr2' -> rebuildLinearMatchExpr (spBind, exprm, dtree', tg1', expr2', sp2, m2, ty'))) | LinearOpExpr (op, tyargs, argsFront, argLast, m) -> let op' = remapOp tmenv op let tinst' = remapTypes tmenv tyargs - let argsFront' = remapExprs g compgen tmenv argsFront + let argsFront' = remapExprs ctxt compgen tmenv argsFront // tailcall for the linear position - remapLinearExpr g compgen tmenv argLast (contf << (fun argLast' -> + remapLinearExpr ctxt compgen tmenv argLast (contf << (fun argLast' -> if op === op' && tyargs === tinst' && argsFront === argsFront' && argLast === argLast' then expr else rebuildLinearOpExpr (op', tinst', argsFront', argLast', m))) | _ -> - contf (remapExpr g compgen tmenv expr) + contf (remapExprImpl ctxt compgen tmenv expr) and remapConstraint tyenv c = match c with @@ -5444,14 +5478,14 @@ and remapValFlags tmenv x = | PossibleConstrainedCall ty -> PossibleConstrainedCall (remapType tmenv ty) | _ -> x -and remapExprs g compgen tmenv es = List.mapq (remapExpr g compgen tmenv) es +and remapExprs ctxt compgen tmenv es = List.mapq (remapExprImpl ctxt compgen tmenv) es -and remapFlatExprs g compgen tmenv es = List.mapq (remapExpr g compgen tmenv) es +and remapFlatExprs ctxt compgen tmenv es = List.mapq (remapExprImpl ctxt compgen tmenv) es -and remapDecisionTree g compgen tmenv x = +and remapDecisionTree ctxt compgen tmenv x = match x with | TDSwitch(sp, e1, cases, dflt, m) -> - let e1R = remapExpr g compgen tmenv e1 + let e1R = remapExprImpl ctxt compgen tmenv e1 let casesR = cases |> List.map (fun (TCase(test, subTree)) -> let testR = @@ -5463,81 +5497,81 @@ and remapDecisionTree g compgen tmenv x = | DecisionTreeTest.IsNull -> DecisionTreeTest.IsNull | DecisionTreeTest.ActivePatternCase _ -> failwith "DecisionTreeTest.ActivePatternCase should only be used during pattern match compilation" | DecisionTreeTest.Error(m) -> DecisionTreeTest.Error(m) - let subTreeR = remapDecisionTree g compgen tmenv subTree + let subTreeR = remapDecisionTree ctxt compgen tmenv subTree TCase(testR, subTreeR)) - let dfltR = Option.map (remapDecisionTree g compgen tmenv) dflt + let dfltR = Option.map (remapDecisionTree ctxt compgen tmenv) dflt TDSwitch(sp, e1R, casesR, dfltR, m) | TDSuccess (es, n) -> - TDSuccess (remapFlatExprs g compgen tmenv es, n) + TDSuccess (remapFlatExprs ctxt compgen tmenv es, n) | TDBind (bind, rest) -> - let bind', tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind - TDBind (bind', remapDecisionTree g compgen tmenvinner rest) + let bind', tmenvinner = copyAndRemapAndBindBinding ctxt compgen tmenv bind + TDBind (bind', remapDecisionTree ctxt compgen tmenvinner rest) -and copyAndRemapAndBindBinding g compgen tmenv (bind: Binding) = +and copyAndRemapAndBindBinding ctxt compgen tmenv (bind: Binding) = let v = bind.Var - let v', tmenv = copyAndRemapAndBindVal g compgen tmenv v - remapAndRenameBind g compgen tmenv bind v', tmenv - -and copyAndRemapAndBindBindings g compgen tmenv binds = - let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv (valsOfBinds binds) - remapAndRenameBinds g compgen tmenvinner binds vs', tmenvinner - -and remapAndRenameBinds g compgen tmenvinner binds vs' = List.map2 (remapAndRenameBind g compgen tmenvinner) binds vs' -and remapAndRenameBind g compgen tmenvinner (TBind(_, repr, letSeqPtOpt)) v' = TBind(v', remapExpr g compgen tmenvinner repr, letSeqPtOpt) - -and remapMethod g compgen tmenv (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = - let attribs2 = attribs |> remapAttribs g tmenv - let slotsig2 = remapSlotSig (remapAttribs g tmenv) tmenv slotsig - let tps2, tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - let vs2, tmenvinner2 = List.mapFold (copyAndRemapAndBindVals g compgen) tmenvinner vs - let e2 = remapExpr g compgen tmenvinner2 e + let v', tmenv = copyAndRemapAndBindVal ctxt compgen tmenv v + remapAndRenameBind ctxt compgen tmenv bind v', tmenv + +and copyAndRemapAndBindBindings ctxt compgen tmenv binds = + let vs', tmenvinner = copyAndRemapAndBindVals ctxt compgen tmenv (valsOfBinds binds) + remapAndRenameBinds ctxt compgen tmenvinner binds vs', tmenvinner + +and remapAndRenameBinds ctxt compgen tmenvinner binds vs' = List.map2 (remapAndRenameBind ctxt compgen tmenvinner) binds vs' +and remapAndRenameBind ctxt compgen tmenvinner (TBind(_, repr, letSeqPtOpt)) v' = TBind(v', remapExprImpl ctxt compgen tmenvinner repr, letSeqPtOpt) + +and remapMethod ctxt compgen tmenv (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = + let attribs2 = attribs |> remapAttribs ctxt tmenv + let slotsig2 = remapSlotSig (remapAttribs ctxt tmenv) tmenv slotsig + let tps2, tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv tps + let vs2, tmenvinner2 = List.mapFold (copyAndRemapAndBindVals ctxt compgen) tmenvinner vs + let e2 = remapExprImpl ctxt compgen tmenvinner2 e TObjExprMethod(slotsig2, attribs2, tps2, vs2, e2, m) -and remapInterfaceImpl g compgen tmenv (ty, overrides) = - (remapType tmenv ty, List.map (remapMethod g compgen tmenv) overrides) +and remapInterfaceImpl ctxt compgen tmenv (ty, overrides) = + (remapType tmenv ty, List.map (remapMethod ctxt compgen tmenv) overrides) -and remapRecdField g tmenv x = +and remapRecdField ctxt tmenv x = { x with - rfield_type = x.rfield_type |> remapPossibleForallTy g tmenv - rfield_pattribs = x.rfield_pattribs |> remapAttribs g tmenv - rfield_fattribs = x.rfield_fattribs |> remapAttribs g tmenv } + rfield_type = x.rfield_type |> remapPossibleForallTyImpl ctxt tmenv + rfield_pattribs = x.rfield_pattribs |> remapAttribs ctxt tmenv + rfield_fattribs = x.rfield_fattribs |> remapAttribs ctxt tmenv } -and remapRecdFields g tmenv (x: TyconRecdFields) = - x.AllFieldsAsList |> List.map (remapRecdField g tmenv) |> Construct.MakeRecdFieldsTable +and remapRecdFields ctxt tmenv (x: TyconRecdFields) = + x.AllFieldsAsList |> List.map (remapRecdField ctxt tmenv) |> Construct.MakeRecdFieldsTable -and remapUnionCase g tmenv (x: UnionCase) = +and remapUnionCase ctxt tmenv (x: UnionCase) = { x with - FieldTable = x.FieldTable |> remapRecdFields g tmenv + FieldTable = x.FieldTable |> remapRecdFields ctxt tmenv ReturnType = x.ReturnType |> remapType tmenv - Attribs = x.Attribs |> remapAttribs g tmenv } + Attribs = x.Attribs |> remapAttribs ctxt tmenv } -and remapUnionCases g tmenv (x: TyconUnionData) = - x.UnionCasesAsList |> List.map (remapUnionCase g tmenv) |> Construct.MakeUnionCases +and remapUnionCases ctxt tmenv (x: TyconUnionData) = + x.UnionCasesAsList |> List.map (remapUnionCase ctxt tmenv) |> Construct.MakeUnionCases -and remapFsObjData g tmenv x = +and remapFsObjData ctxt tmenv x = { x with fsobjmodel_kind = (match x.fsobjmodel_kind with - | TFSharpDelegate slotsig -> TFSharpDelegate (remapSlotSig (remapAttribs g tmenv) tmenv slotsig) + | TFSharpDelegate slotsig -> TFSharpDelegate (remapSlotSig (remapAttribs ctxt tmenv) tmenv slotsig) | TFSharpClass | TFSharpInterface | TFSharpStruct | TFSharpEnum -> x.fsobjmodel_kind) fsobjmodel_vslots = x.fsobjmodel_vslots |> List.map (remapValRef tmenv) - fsobjmodel_rfields = x.fsobjmodel_rfields |> remapRecdFields g tmenv } + fsobjmodel_rfields = x.fsobjmodel_rfields |> remapRecdFields ctxt tmenv } -and remapTyconRepr g tmenv repr = +and remapTyconRepr ctxt tmenv repr = match repr with - | TFSharpObjectRepr x -> TFSharpObjectRepr (remapFsObjData g tmenv x) - | TFSharpRecdRepr x -> TFSharpRecdRepr (remapRecdFields g tmenv x) - | TFSharpUnionRepr x -> TFSharpUnionRepr (remapUnionCases g tmenv x) + | TFSharpObjectRepr x -> TFSharpObjectRepr (remapFsObjData ctxt tmenv x) + | TFSharpRecdRepr x -> TFSharpRecdRepr (remapRecdFields ctxt tmenv x) + | TFSharpUnionRepr x -> TFSharpUnionRepr (remapUnionCases ctxt tmenv x) | TILObjectRepr _ -> failwith "cannot remap IL type definitions" #if !NO_EXTENSIONTYPING | TProvidedNamespaceRepr _ -> repr | TProvidedTypeRepr info -> TProvidedTypeRepr { info with - LazyBaseType = info.LazyBaseType.Force (range0, g.obj_ty) |> remapType tmenv |> LazyWithContext.NotLazy + LazyBaseType = info.LazyBaseType.Force (range0, ctxt.g.obj_ty) |> remapType tmenv |> LazyWithContext.NotLazy // The load context for the provided type contains TyconRef objects. We must remap these. // This is actually done on-demand (see the implementation of ProvidedTypeContext) ProvidedType = @@ -5560,33 +5594,33 @@ and remapTyconAug tmenv (x: TyconAugmentation) = tcaug_super = x.tcaug_super |> Option.map (remapType tmenv) tcaug_interfaces = x.tcaug_interfaces |> List.map (map1Of3 (remapType tmenv)) } -and remapTyconExnInfo g tmenv inp = +and remapTyconExnInfo ctxt tmenv inp = match inp with | TExnAbbrevRepr x -> TExnAbbrevRepr (remapTyconRef tmenv.tyconRefRemap x) - | TExnFresh x -> TExnFresh (remapRecdFields g tmenv x) + | TExnFresh x -> TExnFresh (remapRecdFields ctxt tmenv x) | TExnAsmRepr _ | TExnNone -> inp -and remapMemberInfo g m topValInfo ty ty' tmenv x = +and remapMemberInfo ctxt m topValInfo ty ty' tmenv x = // The slotsig in the ImplementedSlotSigs is w.r.t. the type variables in the value's type. // REVIEW: this is a bit gross. It would be nice if the slotsig was standalone assert (Option.isSome topValInfo) - let tpsOrig, _, _, _ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty m - let tps, _, _, _ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty' m + let tpsOrig, _, _, _ = GetMemberTypeInFSharpForm ctxt.g x.MemberFlags (Option.get topValInfo) ty m + let tps, _, _, _ = GetMemberTypeInFSharpForm ctxt.g x.MemberFlags (Option.get topValInfo) ty' m let renaming, _ = mkTyparToTyparRenaming tpsOrig tps let tmenv = { tmenv with tpinst = tmenv.tpinst @ renaming } { x with ApparentEnclosingEntity = x.ApparentEnclosingEntity |> remapTyconRef tmenv.tyconRefRemap - ImplementedSlotSigs = x.ImplementedSlotSigs |> List.map (remapSlotSig (remapAttribs g tmenv) tmenv) + ImplementedSlotSigs = x.ImplementedSlotSigs |> List.map (remapSlotSig (remapAttribs ctxt tmenv) tmenv) } -and copyAndRemapAndBindModTy g compgen tmenv mty = +and copyAndRemapAndBindModTy ctxt compgen tmenv mty = let tycons = allEntitiesOfModuleOrNamespaceTy mty let vs = allValsOfModuleOrNamespaceTy mty - let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs - remapModTy g compgen tmenvinner mty, tmenvinner + let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals ctxt compgen tmenv tycons vs + remapModTy ctxt compgen tmenvinner mty, tmenvinner -and remapModTy g _compgen tmenv mty = - mapImmediateValsAndTycons (renameTycon g tmenv) (renameVal tmenv) mty +and remapModTy ctxt _compgen tmenv mty = + mapImmediateValsAndTycons (renameTycon ctxt.g tmenv) (renameVal tmenv) mty and renameTycon g tyenv x = let tcref = @@ -5609,13 +5643,13 @@ and copyTycon compgen (tycon: Tycon) = | _ -> Construct.NewClonedTycon tycon /// This operates over a whole nested collection of tycons and vals simultaneously *) -and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = +and copyAndRemapAndBindTyconsAndVals ctxt compgen tmenv tycons vs = let tycons' = tycons |> List.map (copyTycon compgen) let tmenvinner = bindTycons tycons tycons' tmenv // Values need to be copied and renamed. - let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenvinner vs + let vs', tmenvinner = copyAndRemapAndBindVals ctxt compgen tmenvinner vs // "if a type constructor is hidden then all its inner values and inner type constructors must also be hidden" // Hence we can just lookup the inner tycon/value mappings in the tables. @@ -5640,16 +5674,16 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = mkLocalTyconRef tycon tcref.Deref (tycons, tycons') ||> List.iter2 (fun tcd tcd' -> - let lookupTycon tycon = lookupTycon g tycon - let tps', tmenvinner2 = tmenvCopyRemapAndBindTypars (remapAttribs g tmenvinner) tmenvinner (tcd.entity_typars.Force(tcd.entity_range)) + let lookupTycon tycon = lookupTycon ctxt.g tycon + let tps', tmenvinner2 = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenvinner) tmenvinner (tcd.entity_typars.Force(tcd.entity_range)) tcd'.entity_typars <- LazyWithContext.NotLazy tps' - tcd'.entity_attribs <- tcd.entity_attribs |> remapAttribs g tmenvinner2 - tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr g tmenvinner2 + tcd'.entity_attribs <- tcd.entity_attribs |> remapAttribs ctxt tmenvinner2 + tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr ctxt tmenvinner2 let typeAbbrevR = tcd.TypeAbbrev |> Option.map (remapType tmenvinner2) tcd'.entity_tycon_tcaug <- tcd.entity_tycon_tcaug |> remapTyconAug tmenvinner2 tcd'.entity_modul_contents <- MaybeLazy.Strict (tcd.entity_modul_contents.Value |> mapImmediateValsAndTycons lookupTycon lookupVal) - let exnInfoR = tcd.ExceptionInfo |> remapTyconExnInfo g tmenvinner2 + let exnInfoR = tcd.ExceptionInfo |> remapTyconExnInfo ctxt tmenvinner2 match tcd'.entity_opt_data with | Some optData -> tcd'.entity_opt_data <- Some { optData with entity_tycon_abbrev = typeAbbrevR; entity_exn_info = exnInfoR } | _ -> @@ -5701,24 +5735,24 @@ and allValsOfModDef mdef = | TMAbstract(ModuleOrNamespaceExprWithSig(mty, _, _)) -> yield! allValsOfModuleOrNamespaceTy mty } -and remapAndBindModuleOrNamespaceExprWithSig g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = - let mdef = copyAndRemapModDef g compgen tmenv mdef - let mty, tmenv = copyAndRemapAndBindModTy g compgen tmenv mty +and remapAndBindModuleOrNamespaceExprWithSig ctxt compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = + let mdef = copyAndRemapModDef ctxt compgen tmenv mdef + let mty, tmenv = copyAndRemapAndBindModTy ctxt compgen tmenv mty ModuleOrNamespaceExprWithSig(mty, mdef, m), tmenv -and remapModuleOrNamespaceExprWithSig g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = - let mdef = copyAndRemapModDef g compgen tmenv mdef - let mty = remapModTy g compgen tmenv mty +and remapModuleOrNamespaceExprWithSig ctxt compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = + let mdef = copyAndRemapModDef ctxt compgen tmenv mdef + let mty = remapModTy ctxt compgen tmenv mty ModuleOrNamespaceExprWithSig(mty, mdef, m) -and copyAndRemapModDef g compgen tmenv mdef = +and copyAndRemapModDef ctxt compgen tmenv mdef = let tycons = allEntitiesOfModDef mdef |> List.ofSeq let vs = allValsOfModDef mdef |> List.ofSeq - let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs - remapAndRenameModDef g compgen tmenvinner mdef + let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals ctxt compgen tmenv tycons vs + remapAndRenameModDef ctxt compgen tmenvinner mdef -and remapAndRenameModDefs g compgen tmenv x = - List.map (remapAndRenameModDef g compgen tmenv) x +and remapAndRenameModDefs ctxt compgen tmenv x = + List.map (remapAndRenameModDef ctxt compgen tmenv) x and remapOpenDeclarations tmenv opens = opens |> List.map (fun od -> @@ -5727,52 +5761,74 @@ and remapOpenDeclarations tmenv opens = Types = od.Types |> List.map (remapType tmenv) }) -and remapAndRenameModDef g compgen tmenv mdef = +and remapAndRenameModDef ctxt compgen tmenv mdef = match mdef with | TMDefRec(isRec, opens, tycons, mbinds, m) -> // Abstract (virtual) vslots in the tycons at TMDefRec nodes are binders. They also need to be copied and renamed. let opensR = remapOpenDeclarations tmenv opens - let tyconsR = tycons |> List.map (renameTycon g tmenv) - let mbindsR = mbinds |> List.map (remapAndRenameModBind g compgen tmenv) + let tyconsR = tycons |> List.map (renameTycon ctxt.g tmenv) + let mbindsR = mbinds |> List.map (remapAndRenameModBind ctxt compgen tmenv) TMDefRec(isRec, opensR, tyconsR, mbindsR, m) | TMDefLet(bind, m) -> let v = bind.Var - let bind = remapAndRenameBind g compgen tmenv bind (renameVal tmenv v) + let bind = remapAndRenameBind ctxt compgen tmenv bind (renameVal tmenv v) TMDefLet(bind, m) | TMDefDo(e, m) -> - let e = remapExpr g compgen tmenv e + let e = remapExprImpl ctxt compgen tmenv e TMDefDo(e, m) | TMDefOpens opens -> let opens = remapOpenDeclarations tmenv opens TMDefOpens opens | TMDefs defs -> - let defs = remapAndRenameModDefs g compgen tmenv defs + let defs = remapAndRenameModDefs ctxt compgen tmenv defs TMDefs defs | TMAbstract mexpr -> - let mexpr = remapModuleOrNamespaceExprWithSig g compgen tmenv mexpr + let mexpr = remapModuleOrNamespaceExprWithSig ctxt compgen tmenv mexpr TMAbstract mexpr -and remapAndRenameModBind g compgen tmenv x = +and remapAndRenameModBind ctxt compgen tmenv x = match x with | ModuleOrNamespaceBinding.Binding bind -> let v2 = bind |> valOfBind |> renameVal tmenv - let bind2 = remapAndRenameBind g compgen tmenv bind v2 + let bind2 = remapAndRenameBind ctxt compgen tmenv bind v2 ModuleOrNamespaceBinding.Binding bind2 | ModuleOrNamespaceBinding.Module(mspec, def) -> - let mspec = renameTycon g tmenv mspec - let def = remapAndRenameModDef g compgen tmenv def + let mspec = renameTycon ctxt.g tmenv mspec + let def = remapAndRenameModDef ctxt compgen tmenv def ModuleOrNamespaceBinding.Module(mspec, def) -and remapImplFile g compgen tmenv mv = - mapAccImplFile (remapAndBindModuleOrNamespaceExprWithSig g compgen) tmenv mv +and remapImplFile ctxt compgen tmenv mv = + mapAccImplFile (remapAndBindModuleOrNamespaceExprWithSig ctxt compgen) tmenv mv + +// Entry points -let copyModuleOrNamespaceType g compgen mtyp = copyAndRemapAndBindModTy g compgen Remap.Empty mtyp |> fst +let remapAttrib g tmenv attrib = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapAttribImpl ctxt tmenv attrib -let copyExpr g compgen e = remapExpr g compgen Remap.Empty e +let remapExpr g (compgen: ValCopyFlag) (tmenv: Remap) expr = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapExprImpl ctxt compgen tmenv expr -let copyImplFile g compgen e = remapImplFile g compgen Remap.Empty e |> fst +let remapPossibleForallTy g tmenv ty = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapPossibleForallTyImpl ctxt tmenv ty -let instExpr g tpinst e = remapExpr g CloneAll (mkInstRemap tpinst) e +let copyModuleOrNamespaceType g compgen mtyp = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + copyAndRemapAndBindModTy ctxt compgen Remap.Empty mtyp |> fst + +let copyExpr g compgen e = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapExprImpl ctxt compgen Remap.Empty e + +let copyImplFile g compgen e = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapImplFile ctxt compgen Remap.Empty e |> fst + +let instExpr g tpinst e = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapExprImpl ctxt CloneAll (mkInstRemap tpinst) e //-------------------------------------------------------------------------- // Replace Marks - adjust debugging marks when a lambda gets @@ -6097,30 +6153,29 @@ let isExpansiveUnderInstantiation g fty0 tyargs pargs argsl = loop fty1 argsl) let rec mkExprAppAux g f fty argsl m = - match argsl with - | [] -> f - | _ -> - // Always combine the term application with a type application - // - // Combine the term application with a term application, but only when f' is an under-applied value of known arity - match f with - | Expr.App (f', fty', tyargs, pargs, m2) + match argsl with + | [] -> f + | _ -> + // Always combine the term application with a type application + // + // Combine the term application with a term application, but only when f' is an under-applied value of known arity + match f with + | Expr.App (f0, fty0, tyargs, pargs, m2) when (isNil pargs || - (match stripExpr f' with + (match stripExpr f0 with | Expr.Val (v, _, _) -> match v.ValReprInfo with | Some info -> info.NumCurriedArgs > pargs.Length | None -> false | _ -> false)) && - not (isExpansiveUnderInstantiation g fty' tyargs pargs argsl) -> - primMkApp (f', fty') tyargs (pargs@argsl) (unionRanges m2 m) - - | _ -> - // Don't combine. 'f' is not an application - if not (isFunTy g fty) then error(InternalError("expected a function type", m)) - primMkApp (f, fty) [] argsl m + not (isExpansiveUnderInstantiation g fty0 tyargs pargs argsl) -> + primMkApp (f0, fty0) tyargs (pargs@argsl) (unionRanges m2 m) + | _ -> + // Don't combine. 'f' is not an application + if not (isFunTy g fty) then error(InternalError("expected a function type", m)) + primMkApp (f, fty) [] argsl m let rec mkAppsAux g f fty tyargsl argsl m = match tyargsl with @@ -6692,11 +6747,13 @@ let ExprFolder0 = type ExprFolders<'State> (folders: ExprFolder<'State>) = let mutable exprFClosure = Unchecked.defaultof<'State -> Expr -> 'State> // prevent reallocation of closure let mutable exprNoInterceptFClosure = Unchecked.defaultof<'State -> Expr -> 'State> // prevent reallocation of closure + let stackGuard = StackGuard(FoldExprStackGuardDepth) let rec exprsF z xs = List.fold exprFClosure z xs and exprF (z: 'State) (x: Expr) = + stackGuard.Guard <| fun () -> folders.exprIntercept exprFClosure exprNoInterceptFClosure z x and exprNoInterceptF (z: 'State) (x: Expr) = @@ -8732,7 +8789,8 @@ type ExprRewritingEnv = { PreIntercept: ((Expr -> Expr) -> Expr -> Expr option) option PostTransform: Expr -> Expr option PreInterceptBinding: ((Expr -> Expr) -> Binding -> Binding option) option - IsUnderQuotations: bool } + RewriteQuotations: bool + StackGuard: StackGuard } let rec rewriteBind env bind = match env.PreInterceptBinding with @@ -8748,18 +8806,19 @@ and rewriteBindStructure env (TBind(v, e, letSeqPtOpt)) = and rewriteBinds env binds = List.map (rewriteBind env) binds and RewriteExpr env expr = - match expr with - | LinearOpExpr _ - | LinearMatchExpr _ - | Expr.Let _ - | Expr.Sequential _ -> - rewriteLinearExpr env expr (fun e -> e) - | _ -> - let expr = - match preRewriteExpr env expr with - | Some expr -> expr - | None -> rewriteExprStructure env expr - postRewriteExpr env expr + env.StackGuard.Guard <| fun () -> + match expr with + | LinearOpExpr _ + | LinearMatchExpr _ + | Expr.Let _ + | Expr.Sequential _ -> + rewriteLinearExpr env expr (fun e -> e) + | _ -> + let expr = + match preRewriteExpr env expr with + | Some expr -> expr + | None -> rewriteExprStructure env expr + postRewriteExpr env expr and preRewriteExpr env expr = match env.PreIntercept with @@ -8787,7 +8846,7 @@ and rewriteExprStructure env expr = match dataCell.Value with | None -> None | Some (data1, data2) -> Some(map3Of4 (rewriteExprs env) data1, map3Of4 (rewriteExprs env) data2) - Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), ref data, isFromQueryExpression, m, ty) + Expr.Quote ((if env.RewriteQuotations then RewriteExpr env ast else ast), ref data, isFromQueryExpression, m, ty) | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> mkObjExpr(ty, basev, RewriteExpr env basecall, List.map (rewriteObjExprOverride env) overrides, @@ -8974,17 +9033,17 @@ let MakeExportRemapping viewedCcu (mspec: ModuleOrNamespace) = //------------------------------------------------------------------------ -let rec remapEntityDataToNonLocal g tmenv (d: Entity) = - let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv (d.entity_typars.Force(d.entity_range)) +let rec remapEntityDataToNonLocal ctxt tmenv (d: Entity) = + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv (d.entity_typars.Force(d.entity_range)) let typarsR = LazyWithContext.NotLazy tps' - let attribsR = d.entity_attribs |> remapAttribs g tmenvinner - let tyconReprR = d.entity_tycon_repr |> remapTyconRepr g tmenvinner + let attribsR = d.entity_attribs |> remapAttribs ctxt tmenvinner + let tyconReprR = d.entity_tycon_repr |> remapTyconRepr ctxt tmenvinner let tyconAbbrevR = d.TypeAbbrev |> Option.map (remapType tmenvinner) let tyconTcaugR = d.entity_tycon_tcaug |> remapTyconAug tmenvinner let modulContentsR = MaybeLazy.Strict (d.entity_modul_contents.Value - |> mapImmediateValsAndTycons (remapTyconToNonLocal g tmenv) (remapValToNonLocal g tmenv)) - let exnInfoR = d.ExceptionInfo |> remapTyconExnInfo g tmenvinner + |> mapImmediateValsAndTycons (remapTyconToNonLocal ctxt tmenv) (remapValToNonLocal ctxt tmenv)) + let exnInfoR = d.ExceptionInfo |> remapTyconExnInfo ctxt tmenvinner { d with entity_typars = typarsR entity_attribs = attribsR @@ -8997,14 +9056,16 @@ let rec remapEntityDataToNonLocal g tmenv (d: Entity) = Some { dd with entity_tycon_abbrev = tyconAbbrevR; entity_exn_info = exnInfoR } | _ -> None } -and remapTyconToNonLocal g tmenv x = - x |> Construct.NewModifiedTycon (remapEntityDataToNonLocal g tmenv) +and remapTyconToNonLocal ctxt tmenv x = + x |> Construct.NewModifiedTycon (remapEntityDataToNonLocal ctxt tmenv) -and remapValToNonLocal g tmenv inp = +and remapValToNonLocal ctxt tmenv inp = // creates a new stamp - inp |> Construct.NewModifiedVal (remapValData g tmenv) + inp |> Construct.NewModifiedVal (remapValData ctxt tmenv) -let ApplyExportRemappingToEntity g tmenv x = remapTyconToNonLocal g tmenv x +let ApplyExportRemappingToEntity g tmenv x = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapTyconToNonLocal ctxt tmenv x (* Which constraints actually get compiled to .NET constraints? *) let isCompiledOrWitnessPassingConstraint (g: TcGlobals) cx = diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index b0c3c2a83b3..2b9fbb8c049 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -8,6 +8,7 @@ open System.Collections.Immutable open Internal.Utilities.Collections open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.Syntax open FSharp.Compiler.Text @@ -771,6 +772,10 @@ val CollectTyparsAndLocals: FreeVarOptions val CollectLocals: FreeVarOptions +val CollectLocalsWithStackGuard: unit -> FreeVarOptions + +val CollectTyparsAndLocalsWithStackGuard: unit -> FreeVarOptions + val CollectTypars: FreeVarOptions val CollectAllNoCaching: FreeVarOptions @@ -2328,7 +2333,8 @@ type ExprRewritingEnv = { PreIntercept: ((Expr -> Expr) -> Expr -> Expr option) option PostTransform: Expr -> Expr option PreInterceptBinding: ((Expr -> Expr) -> Binding -> Binding option) option - IsUnderQuotations: bool } + RewriteQuotations: bool + StackGuard: StackGuard } val RewriteDecisionTree: ExprRewritingEnv -> DecisionTree -> DecisionTree diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 0a41f5294e4..92b658375dc 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -1527,7 +1527,7 @@ let p_trait_sln sln st = let p_trait (TTrait(a, b, c, d, e, f)) st = - p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a, b, c, d, e, !f) st + p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a, b, c, d, e, f.Value) st let u_anonInfo_data st = let ccu, info, nms = u_tup3 u_ccuref u_bool (u_array u_ident) st @@ -2561,7 +2561,7 @@ and u_op st = and p_expr expr st = match expr with - | Expr.Link e -> p_expr !e st + | Expr.Link e -> p_expr e.Value st | Expr.Const (x, m, ty) -> p_byte 0 st; p_tup3 p_const p_dummy_range p_ty (x, m, ty) st | Expr.Val (a, b, m) -> p_byte 1 st; p_tup3 (p_vref "val") p_vrefFlags p_dummy_range (a, b, m) st | Expr.Op (a, b, c, d) -> p_byte 2 st; p_tup4 p_op p_tys p_Exprs p_dummy_range (a, b, c, d) st diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index e0a644e2697..dcc7d133ff4 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -70,7 +70,7 @@ module internal PervasiveAutoOpens = x.EndsWith(value, StringComparison.Ordinal) /// Get an initialization hole - let getHole r = match !r with None -> failwith "getHole" | Some x -> x + let getHole (r: _ ref) = match r.Value with None -> failwith "getHole" | Some x -> x let reportTime = let mutable tFirst =None @@ -1146,19 +1146,18 @@ type LayeredMultiMap<'Key, 'Value when 'Key : equality and 'Key : comparison>(co member x.Add (k, v) = LayeredMultiMap(contents.Add(k, v :: x.[k])) - member x.Item with get k = match contents.TryGetValue k with true, l -> l | _ -> [] + member _.Item with get k = match contents.TryGetValue k with true, l -> l | _ -> [] member x.AddAndMarkAsCollapsible (kvs: _[]) = let x = (x, kvs) ||> Array.fold (fun x (KeyValue(k, v)) -> x.Add(k, v)) x.MarkAsCollapsible() - member x.MarkAsCollapsible() = LayeredMultiMap(contents.MarkAsCollapsible()) + member _.MarkAsCollapsible() = LayeredMultiMap(contents.MarkAsCollapsible()) - member x.TryFind k = contents.TryFind k + member _.TryFind k = contents.TryFind k - member x.TryGetValue k = contents.TryGetValue k + member _.TryGetValue k = contents.TryGetValue k - member x.Values = contents.Values |> List.concat + member _.Values = contents.Values |> List.concat static member Empty : LayeredMultiMap<'Key, 'Value> = LayeredMultiMap LayeredMap.Empty - diff --git a/src/fsharp/absil/ilprint.fs b/src/fsharp/absil/ilprint.fs index 3a831bc1b5b..0a1a58c753b 100644 --- a/src/fsharp/absil/ilprint.fs +++ b/src/fsharp/absil/ilprint.fs @@ -20,9 +20,10 @@ let pretty () = true // -------------------------------------------------------------------- let tyvar_generator = - let i = ref 0 + let mutable i = 0 fun n -> - incr i; n + string !i + i <- i + 1 + n + string i // Carry an environment because the way we print method variables // depends on the gparams of the current scope. diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index dcfed598615..75cfd3dcacf 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -820,8 +820,11 @@ let writePdbInfo showTimes f fpdb info cvChunk = if sps.Length < 5000 then pdbDefineSequencePoints pdbw (getDocument spset.[0].Document) sps) + // Avoid stack overflow when writing linearly nested scopes + let stackGuard = StackGuard(100) // Write the scopes let rec writePdbScope parent sco = + stackGuard.Guard <| fun () -> if parent = None || sco.Locals.Length <> 0 || sco.Children.Length <> 0 then // Only nest scopes if the child scope is a different size from let nested = @@ -1009,7 +1012,8 @@ let rec allNamesOfScope acc (scope: PdbMethodScope) = and allNamesOfScopes acc (scopes: PdbMethodScope[]) = (acc, scopes) ||> Array.fold allNamesOfScope -let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) = +let rec pushShadowedLocals (stackGuard: StackGuard) (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) = + stackGuard.Guard <| fun () -> // Check if child scopes are properly nested if scope.Children |> Array.forall (fun child -> child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) then @@ -1024,7 +1028,7 @@ let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) let renamed = [| for l in rename -> { l with Name = l.Name + " (shadowed)" } |] let localsToPush2 = [| yield! renamed; yield! unprocessed; yield! scope.Locals |] - let newChildren, splits = children |> Array.map (pushShadowedLocals localsToPush2) |> Array.unzip + let newChildren, splits = children |> Array.map (pushShadowedLocals stackGuard localsToPush2) |> Array.unzip // Check if a rename in any of the children forces a split if splits |> Array.exists id then @@ -1058,5 +1062,7 @@ let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) // 2. Adjust each child scope to also contain the locals from 'scope', // adding the text " (shadowed)" to the names of those with name conflicts. let unshadowScopes rootScope = - let result, _ = pushShadowedLocals [| |] rootScope - result + // Avoid stack overflow when writing linearly nested scopes + let stackGuard = StackGuard(100) + let result, _ = pushShadowedLocals stackGuard [| |] rootScope + result diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index 31c555e7a9c..4c3fd769ccd 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -15,6 +15,8 @@ open FSharp.Compiler.TypeRelations //---------------------------------------------------------------------------- // Decide the set of mutable locals to promote to heap-allocated reference cells +let AutoboxRewriteStackGuardDepth = StackGuard.GetDepthOption "AutoboxRewrite" + type cenv = { g: TcGlobals amap: Import.ImportMap } @@ -30,7 +32,7 @@ let DecideEscapes syntacticArgs body = v.ValReprInfo.IsNone && not (Optimizer.IsKnownOnlyMutableBeforeUse (mkLocalValRef v)) - let frees = freeInExpr CollectLocals body + let frees = freeInExpr (CollectLocalsWithStackGuard()) body frees.FreeLocals |> Zset.filter isMutableEscape /// Find all the mutable locals that escape a lambda expression, ignoring the arguments to the lambda @@ -190,6 +192,7 @@ let TransformImplFile g amap implFile = { PreIntercept = Some(TransformExpr g nvs) PreInterceptBinding = Some(TransformBinding g nvs) PostTransform = (fun _ -> None) - IsUnderQuotations = false } + RewriteQuotations = false + StackGuard = StackGuard(AutoboxRewriteStackGuardDepth) } diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index 69eb07e0810..d461f607afd 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -4,7 +4,9 @@ module internal FSharp.Compiler.CommandLineMain open System open System.Reflection +open System.Runtime open System.Runtime.CompilerServices +open System.Threading open Internal.Utilities.Library open Internal.Utilities.Library.Extras @@ -30,7 +32,8 @@ let main(argv) = "fsc.exe" // Set the garbage collector to batch mode, which improves overall performance. - System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch + GCSettings.LatencyMode <- GCLatencyMode.Batch + Thread.CurrentThread.Name <- "F# Main Thread" // Set the initial phase to garbage collector to batch mode, which improves overall performance. use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 0a0352a7e2b..b45e059d8be 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -544,18 +544,6 @@ module UnmanagedProcessExecutionOptions = "HeapSetInformation() returned FALSE; LastError = 0x" + GetLastError().ToString("X").PadLeft(8, '0') + ".")) -[] -module StackGuard = - - open System.Runtime.CompilerServices - - [] - let private MaxUncheckedRecursionDepth = 20 - - let EnsureSufficientExecutionStack recursionDepth = - if recursionDepth > MaxUncheckedRecursionDepth then - RuntimeHelpers.EnsureSufficientExecutionStack () - [] type MaybeLazy<'T> = | Strict of 'T diff --git a/src/fsharp/lib.fsi b/src/fsharp/lib.fsi index bfa6f20296e..28d9f10b380 100644 --- a/src/fsharp/lib.fsi +++ b/src/fsharp/lib.fsi @@ -277,9 +277,6 @@ module AsyncUtil = module UnmanagedProcessExecutionOptions = val EnableHeapTerminationOnCorruption: unit -> unit -module StackGuard = - val EnsureSufficientExecutionStack: recursionDepth:int -> unit - [] type MaybeLazy<'T> = | Strict of 'T diff --git a/src/fsharp/tainted.fs b/src/fsharp/tainted.fs index 347db945c93..57bb550d972 100644 --- a/src/fsharp/tainted.fs +++ b/src/fsharp/tainted.fs @@ -144,7 +144,9 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = | Some x -> Some (Tainted(context,x)) member this.PUntaint(f,range:range) = this.Protect f range + member this.PUntaintNoFailure f = this.PUntaint(f, range0) + /// Access the target object directly. Use with extreme caution. member this.AccessObjectDirectly = value diff --git a/tests/FSharp.Test.Utilities/TestFramework.fs b/tests/FSharp.Test.Utilities/TestFramework.fs index 07b9c557ea1..df5e55708dc 100644 --- a/tests/FSharp.Test.Utilities/TestFramework.fs +++ b/tests/FSharp.Test.Utilities/TestFramework.fs @@ -216,6 +216,7 @@ type TestConfig = FSI : string #if !NETCOREAPP FSIANYCPU : string + FSCANYCPU : string #endif FSI_FOR_SCRIPTS : string FSharpBuild : string @@ -335,8 +336,9 @@ let config configurationName envVars = let FSI_FOR_SCRIPTS = requireArtifact FSI_PATH let FSI = requireArtifact FSI_PATH #if !NETCOREAPP - let FSIANYCPU = requireArtifact ("fsiAnyCpu" ++ configurationName ++ "net472" ++ "fsiAnyCpu.exe") let FSC = requireArtifact ("fsc" ++ configurationName ++ fscArchitecture ++ "fsc.exe") + let FSIANYCPU = requireArtifact ("fsiAnyCpu" ++ configurationName ++ "net472" ++ "fsiAnyCpu.exe") + let FSCANYCPU = requireArtifact ("fscAnyCpu" ++ configurationName ++ fscArchitecture ++ "fscAnyCpu.exe") #else let FSC = requireArtifact ("fsc" ++ configurationName ++ fscArchitecture ++ "fsc.dll") #endif @@ -360,6 +362,7 @@ let config configurationName envVars = FSC = FSC FSI = FSI #if !NETCOREAPP + FSCANYCPU = FSCANYCPU FSIANYCPU = FSIANYCPU #endif FSI_FOR_SCRIPTS = FSI_FOR_SCRIPTS @@ -392,6 +395,7 @@ let logConfig (cfg: TestConfig) = log "DOTNET_ROOT = %s" cfg.DotNetRoot #else log "FSIANYCPU = %s" cfg.FSIANYCPU + log "FSCANYCPU = %s" cfg.FSCANYCPU #endif log "FSI_FOR_SCRIPTS = %s" cfg.FSI_FOR_SCRIPTS log "fsi_flags = %s" cfg.fsi_flags diff --git a/tests/fsharp/TypeProviderTests.fs b/tests/fsharp/TypeProviderTests.fs index e689c2775a1..3a2ca54fef1 100644 --- a/tests/fsharp/TypeProviderTests.fs +++ b/tests/fsharp/TypeProviderTests.fs @@ -26,11 +26,11 @@ open FSharp.Compiler.IO #if NETCOREAPP // Use these lines if you want to test CoreCLR -let FSC_BASIC = FSC_CORECLR -let FSI_BASIC = FSI_CORECLR +let FSC_OPTIMIZED = FSC_NETCORE (true, false) +let FSI = FSI_NETCORE #else -let FSC_BASIC = FSC_OPT_PLUS_DEBUG -let FSI_BASIC = FSI_FILE +let FSC_OPTIMIZED = FSC_NETFX (true, false) +let FSI = FSI_NETFX #endif let inline getTestsDirectory dir = getTestsDirectory __SOURCE_DIRECTORY__ dir @@ -147,11 +147,11 @@ let helloWorld p = peverify cfg (bincompat2 ++ "testlib_client.exe") [] -let ``helloWorld fsc`` () = helloWorld FSC_BASIC +let ``helloWorld fsc`` () = helloWorld FSC_OPTIMIZED #if !NETCOREAPP [] -let ``helloWorld fsi`` () = helloWorld FSI_STDIN +let ``helloWorld fsi`` () = helloWorld FSI_NETFX_STDIN #endif [] diff --git a/tests/fsharp/core/innerpoly/test.fsx b/tests/fsharp/core/innerpoly/test.fsx index 012df22100f..4dd3e65f7cb 100644 --- a/tests/fsharp/core/innerpoly/test.fsx +++ b/tests/fsharp/core/innerpoly/test.fsx @@ -448,7 +448,7 @@ module Bug11620A = (fun () -> getService) // The generated signature for this bug repro has mistakes, we are not enabling it yet -#if !GENERATED_SIGNATURE +#if !FSC_NETFX_TEST_GENERATED_SIGNATURE module Bug11620B = type Data = interface end diff --git a/tests/fsharp/readme.md b/tests/fsharp/readme.md index 42960c28c31..43ba0b0ad0f 100644 --- a/tests/fsharp/readme.md +++ b/tests/fsharp/readme.md @@ -11,7 +11,7 @@ The framework and utilities can be found in test-framework.fs, single-test.fs, c test cases look similar to: ```` [] - let ``array-FSI_BASIC`` () = singleTestBuildAndRun "core/array" FSI_BASIC + let ``array-FSI`` () = singleTestBuildAndRun "core/array" FSI ```` This test case builds and runs the test case in the folder core/array diff --git a/tests/fsharp/regression/12322/test.fsx b/tests/fsharp/regression/12322/test.fsx new file mode 100644 index 00000000000..755937aedd4 --- /dev/null +++ b/tests/fsharp/regression/12322/test.fsx @@ -0,0 +1,1494 @@ +#r "nuget: FsCheck, 3.0.0-alpha4" + +// See https://github.com/dotnet/fsharp/pull/12420 and https://github.com/dotnet/fsharp/issues/12322 + +type ReproBuilder () = + member _.Delay x = printfn "Delay"; x () + member _.Yield (x) = printfn "Yield"; x + member _.Combine (x, y) = printfn "Combine"; x + y + +let repro = ReproBuilder () + +// The de-sugaring of this is a mass of nested function calls +let reallyBigComputationExpression () = + repro { + // Commenting out some of the below is enough to avoid StackOverflow on my machine. + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + } + +let f x = printfn "call"; printfn "call"; printfn "call"; printfn "call"; x + +let manyPipes () = + 1 |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + + +let deepCalls () = + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + 1 + )))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + )))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +open FsCheck + +/// This was another repro for computation expressions +let g = + gen { + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + return () + } + +/// This was failing when writing debug scopes +module LotsOfLets = + //let a1 = "foo" + let a2 = "foo" + let a3 = "foo" + let a4 = "foo" + let a5 = "foo" + let a6 = "foo" + let a7 = "foo" + let a8 = "foo" + let a9 = "foo" + let a10 = "foo" + let a11 = "foo" + let a12 = "foo" + let a13 = "foo" + let a14 = "foo" + let a15 = "foo" + let a16 = "foo" + let a17 = "foo" + let a18 = "foo" + let a19 = "foo" + let a20 = "foo" + let a21 = "foo" + let a22 = "foo" + let a23 = "foo" + let a24 = "foo" + let a25 = "foo" + let a26 = "foo" + let a27 = "foo" + let a28 = "foo" + let a29 = "foo" + let a30 = "foo" + let a31 = "foo" + let a32 = "foo" + let a33 = "foo" + let a34 = "foo" + let a35 = "foo" + let a36 = "foo" + let a37 = "foo" + let a38 = "foo" + let a39 = "foo" + let a40 = "foo" + let a41 = "foo" + let a42 = "foo" + let a43 = "foo" + let a44 = "foo" + let a45 = "foo" + let a46 = "foo" + let a47 = "foo" + let a48 = "foo" + let a49 = "foo" + let a50 = "foo" + let a51 = "foo" + let a52 = "foo" + let a53 = "foo" + let a54 = "foo" + let a55 = "foo" + let a56 = "foo" + let a57 = "foo" + let a58 = "foo" + let a59 = "foo" + let a60 = "foo" + let a61 = "foo" + let a62 = "foo" + let a63 = "foo" + let a64 = "foo" + let a65 = "foo" + let a66 = "foo" + let a67 = "foo" + let a68 = "foo" + let a69 = "foo" + let a70 = "foo" + let a71 = "foo" + let a72 = "foo" + let a73 = "foo" + let a74 = "foo" + let a75 = "foo" + let a76 = "foo" + let a77 = "foo" + let a78 = "foo" + let a79 = "foo" + let a80 = "foo" + let a81 = "foo" + let a82 = "foo" + let a83 = "foo" + let a84 = "foo" + let a85 = "foo" + let a86 = "foo" + let a87 = "foo" + let a88 = "foo" + let a89 = "foo" + let a90 = "foo" + let a91 = "foo" + let a92 = "foo" + let a93 = "foo" + let a94 = "foo" + let a95 = "foo" + let a96 = "foo" + let a97 = "foo" + let a98 = "foo" + let a99 = "foo" + let a100 = "foo" + let a101 = "foo" + let a102 = "foo" + let a103 = "foo" + let a104 = "foo" + let a105 = "foo" + let a106 = "foo" + let a107 = "foo" + let a108 = "foo" + let a109 = "foo" + let a110 = "foo" + let a111 = "foo" + let a112 = "foo" + let a113 = "foo" + let a114 = "foo" + let a115 = "foo" + let a116 = "foo" + let a117 = "foo" + let a118 = "foo" + let a119 = "foo" + let a120 = "foo" + let a121 = "foo" + let a122 = "foo" + let a123 = "foo" + let a124 = "foo" + let a125 = "foo" + let a126 = "foo" + let a127 = "foo" + let a128 = "foo" + let a129 = "foo" + let a130 = "foo" + let a131 = "foo" + let a132 = "foo" + let a133 = "foo" + let a134 = "foo" + let a135 = "foo" + let a136 = "foo" + let a137 = "foo" + let a138 = "foo" + let a139 = "foo" + let a140 = "foo" + let a141 = "foo" + let a142 = "foo" + let a143 = "foo" + let a144 = "foo" + let a145 = "foo" + let a146 = "foo" + let a147 = "foo" + let a148 = "foo" + let a149 = "foo" + let a150 = "foo" + let a151 = "foo" + let a152 = "foo" + let a153 = "foo" + let a154 = "foo" + let a155 = "foo" + let a156 = "foo" + let a157 = "foo" + let a158 = "foo" + let a159 = "foo" + let a160 = "foo" + let a161 = "foo" + let a162 = "foo" + let a163 = "foo" + let a164 = "foo" + let a165 = "foo" + let a166 = "foo" + let a167 = "foo" + let a168 = "foo" + let a169 = "foo" + let a170 = "foo" + let a171 = "foo" + let a172 = "foo" + let a173 = "foo" + let a174 = "foo" + let a175 = "foo" + let a176 = "foo" + let a177 = "foo" + let a178 = "foo" + let a179 = "foo" + let a180 = "foo" + let a181 = "foo" + let a182 = "foo" + let a183 = "foo" + let a184 = "foo" + let a185 = "foo" + let a186 = "foo" + let a187 = "foo" + let a188 = "foo" + let a189 = "foo" + let a190 = "foo" + let a191 = "foo" + let a192 = "foo" + let a193 = "foo" + let a194 = "foo" + let a195 = "foo" + let a196 = "foo" + let a197 = "foo" + let a198 = "foo" + let a199 = "foo" + let a200 = "foo" + let a201 = "foo" + let a202 = "foo" + let a203 = "foo" + let a204 = "foo" + let a205 = "foo" + let a206 = "foo" + let a207 = "foo" + let a208 = "foo" + let a209 = "foo" + let a210 = "foo" + let a211 = "foo" + let a212 = "foo" + let a213 = "foo" + let a214 = "foo" + let a215 = "foo" + let a216 = "foo" + let a217 = "foo" + let a218 = "foo" + let a219 = "foo" + let a220 = "foo" + let a221 = "foo" + let a222 = "foo" + let a223 = "foo" + let a224 = "foo" + let a225 = "foo" + let a226 = "foo" + let a227 = "foo" + let a228 = "foo" + let a229 = "foo" + let a230 = "foo" + let a231 = "foo" + let a232 = "foo" + let a233 = "foo" + let a234 = "foo" + let a235 = "foo" + let a236 = "foo" + let a237 = "foo" + let a238 = "foo" + let a239 = "foo" + let a240 = "foo" + let a241 = "foo" + let a242 = "foo" + let a243 = "foo" + let a244 = "foo" + let a245 = "foo" + let a246 = "foo" + let a247 = "foo" + let a248 = "foo" + let a249 = "foo" + let a250 = "foo" + let a251 = "foo" + let a252 = "foo" + let a253 = "foo" + let a254 = "foo" + let a255 = "foo" + let a256 = "foo" + let a257 = "foo" + let a258 = "foo" + let a259 = "foo" + let a260 = "foo" + let a261 = "foo" + let a262 = "foo" + let a263 = "foo" + let a264 = "foo" + let a265 = "foo" + let a266 = "foo" + let a267 = "foo" + let a268 = "foo" + let a269 = "foo" + let a270 = "foo" + let a271 = "foo" + let a272 = "foo" + let a273 = "foo" + let a274 = "foo" + let a275 = "foo" + let a276 = "foo" + let a277 = "foo" + let a278 = "foo" + let a279 = "foo" + let a280 = "foo" + let a281 = "foo" + let a282 = "foo" + let a283 = "foo" + let a284 = "foo" + let a285 = "foo" + let a286 = "foo" + let a287 = "foo" + let a288 = "foo" + let a289 = "foo" + let a290 = "foo" + let a291 = "foo" + let a292 = "foo" + let a293 = "foo" + let a294 = "foo" + let a295 = "foo" + let a296 = "foo" + let a297 = "foo" + let a298 = "foo" + let a299 = "foo" + let a300 = "foo" + let a301 = "foo" + let a302 = "foo" + let a303 = "foo" + let a304 = "foo" + let a305 = "foo" + let a306 = "foo" + let a307 = "foo" + let a308 = "foo" + let a309 = "foo" + let a310 = "foo" + let a311 = "foo" + let a312 = "foo" + let a313 = "foo" + let a314 = "foo" + let a315 = "foo" + let a316 = "foo" + let a317 = "foo" + let a318 = "foo" + let a319 = "foo" + let a320 = "foo" + let a321 = "foo" + let a322 = "foo" + let a323 = "foo" + let a324 = "foo" + let a325 = "foo" + let a326 = "foo" + let a327 = "foo" + let a328 = "foo" + let a329 = "foo" + let a330 = "foo" + let a331 = "foo" + let a332 = "foo" + let a333 = "foo" + let a334 = "foo" + let a335 = "foo" + let a336 = "foo" + let a337 = "foo" + let a338 = "foo" + let a339 = "foo" + let a340 = "foo" + let a341 = "foo" + let a342 = "foo" + let a343 = "foo" + let a344 = "foo" + let a345 = "foo" + let a346 = "foo" + let a347 = "foo" + let a348 = "foo" + let a349 = "foo" + let a350 = "foo" + let a351 = "foo" + let a352 = "foo" + let a353 = "foo" + let a354 = "foo" + let a355 = "foo" + let a356 = "foo" + let a357 = "foo" + let a358 = "foo" + let a359 = "foo" + let a360 = "foo" + let a361 = "foo" + let a362 = "foo" + let a363 = "foo" + let a364 = "foo" + let a365 = "foo" + let a366 = "foo" + let a367 = "foo" + let a368 = "foo" + let a369 = "foo" + let a370 = "foo" + let a371 = "foo" + let a372 = "foo" + let a373 = "foo" + let a374 = "foo" + let a375 = "foo" + let a376 = "foo" + let a377 = "foo" + let a378 = "foo" + let a379 = "foo" + let a380 = "foo" + let a381 = "foo" + let a382 = "foo" + let a383 = "foo" + let a384 = "foo" + let a385 = "foo" + let a386 = "foo" + let a387 = "foo" + let a388 = "foo" + let a389 = "foo" + let a390 = "foo" + let a391 = "foo" + let a392 = "foo" + let a393 = "foo" + let a394 = "foo" + let a395 = "foo" + let a396 = "foo" + let a397 = "foo" + let a398 = "foo" + let a399 = "foo" + let a400 = "foo" + let a401 = "foo" + let a402 = "foo" + let a403 = "foo" + let a404 = "foo" + let a405 = "foo" + let a406 = "foo" + let a407 = "foo" + let a408 = "foo" + let a409 = "foo" + let a410 = "foo" + let a411 = "foo" + let a412 = "foo" + let a413 = "foo" + let a414 = "foo" + let a415 = "foo" + let a416 = "foo" + let a417 = "foo" + let a418 = "foo" + let a419 = "foo" + let a420 = "foo" + let a421 = "foo" + let a422 = "foo" + let a423 = "foo" + let a424 = "foo" + let a425 = "foo" + let a426 = "foo" + let a427 = "foo" + let a428 = "foo" + let a429 = "foo" + let a430 = "foo" + let a431 = "foo" + let a432 = "foo" + let a433 = "foo" + let a434 = "foo" + let a435 = "foo" + let a436 = "foo" + let a437 = "foo" + let a438 = "foo" + let a439 = "foo" + let a440 = "foo" + let a441 = "foo" + let a442 = "foo" + let a443 = "foo" + let a444 = "foo" + let a445 = "foo" + let a446 = "foo" + let a447 = "foo" + let a448 = "foo" + let a449 = "foo" + let a450 = "foo" + let a451 = "foo" + let a452 = "foo" + let a453 = "foo" + let a454 = "foo" + let a455 = "foo" + let a456 = "foo" + let a457 = "foo" + let a458 = "foo" + let a459 = "foo" + let a460 = "foo" + let a461 = "foo" + let a462 = "foo" + let a463 = "foo" + let a464 = "foo" + let a465 = "foo" + let a466 = "foo" + let a467 = "foo" + let a468 = "foo" + let a469 = "foo" + let a470 = "foo" + let a471 = "foo" + let a472 = "foo" + let a473 = "foo" + let a474 = "foo" + let a475 = "foo" + let a476 = "foo" + let a477 = "foo" + let a478 = "foo" + let a479 = "foo" + let a480 = "foo" + let a481 = "foo" + let a482 = "foo" + let a483 = "foo" +#if PORTABLE_PDB // 32-bit fsc.exe --debug:full fails in C++ code for the scope emit for any more than this. + let a484 = "foo" + let a485 = "foo" + let a486 = "foo" + let b2 = "foo" + let b3 = "foo" + let b4 = "foo" + let b5 = "foo" + let b6 = "foo" + let b7 = "foo" + let b8 = "foo" + let b9 = "foo" + let b10 = "foo" + let b11 = "foo" + let b12 = "foo" + let b13 = "foo" + let b14 = "foo" + let b15 = "foo" + let b16 = "foo" + let b17 = "foo" + let b18 = "foo" + let b19 = "foo" + let b20 = "foo" + let b21 = "foo" + let b22 = "foo" + let b23 = "foo" + let b24 = "foo" + let b25 = "foo" + let b26 = "foo" + let b27 = "foo" + let b28 = "foo" + let b29 = "foo" + let b30 = "foo" + let b31 = "foo" + let b32 = "foo" + let b33 = "foo" + let b34 = "foo" + let b35 = "foo" + let b36 = "foo" + let b37 = "foo" + let b38 = "foo" + let b39 = "foo" + let b40 = "foo" + let b41 = "foo" + let b42 = "foo" + let b43 = "foo" + let b44 = "foo" + let b45 = "foo" + let b46 = "foo" + let b47 = "foo" + let b48 = "foo" + let b49 = "foo" + let b50 = "foo" + let b51 = "foo" + let b52 = "foo" + let b53 = "foo" + let b54 = "foo" + let b55 = "foo" + let b56 = "foo" + let b57 = "foo" + let b58 = "foo" + let b59 = "foo" + let b60 = "foo" + let b61 = "foo" + let b62 = "foo" + let b63 = "foo" + let b64 = "foo" + let b65 = "foo" + let b66 = "foo" + let b67 = "foo" + let b68 = "foo" + let b69 = "foo" + let b70 = "foo" + let b71 = "foo" + let b72 = "foo" + let b73 = "foo" + let b74 = "foo" + let b75 = "foo" + let b76 = "foo" + let b77 = "foo" + let b78 = "foo" + let b79 = "foo" + let b80 = "foo" + let b81 = "foo" + let b82 = "foo" + let b83 = "foo" + let b84 = "foo" + let b85 = "foo" + let b86 = "foo" + let b87 = "foo" + let b88 = "foo" + let b89 = "foo" + let b90 = "foo" + let b91 = "foo" + let b92 = "foo" + let b93 = "foo" + let b94 = "foo" + let b95 = "foo" + let b96 = "foo" + let b97 = "foo" + let b98 = "foo" + let b99 = "foo" + let b100 = "foo" + let b101 = "foo" + let b102 = "foo" + let b103 = "foo" + let b104 = "foo" + let b105 = "foo" + let b106 = "foo" + let b107 = "foo" + let b108 = "foo" + let b109 = "foo" + let b110 = "foo" + let b111 = "foo" + let b112 = "foo" + let b113 = "foo" + let b114 = "foo" + let b115 = "foo" + let b116 = "foo" + let b117 = "foo" + let b118 = "foo" + let b119 = "foo" + let b120 = "foo" + let b121 = "foo" + let b122 = "foo" + let b123 = "foo" + let b124 = "foo" + let b125 = "foo" + let b126 = "foo" + let b127 = "foo" + let b128 = "foo" + let b129 = "foo" + let b130 = "foo" + let b131 = "foo" + let b132 = "foo" + let b133 = "foo" + let b134 = "foo" + let b135 = "foo" + let b136 = "foo" + let b137 = "foo" + let b138 = "foo" + let b139 = "foo" + let b140 = "foo" + let b141 = "foo" + let b142 = "foo" + let b143 = "foo" + let b144 = "foo" + let b145 = "foo" + let b146 = "foo" + let b147 = "foo" + let b148 = "foo" + let b149 = "foo" + let b150 = "foo" + let b151 = "foo" + let b152 = "foo" + let b153 = "foo" + let b154 = "foo" + let b155 = "foo" + let b156 = "foo" + let b157 = "foo" + let b158 = "foo" + let b159 = "foo" + let b160 = "foo" + let b161 = "foo" + let b162 = "foo" + let b163 = "foo" + let b164 = "foo" + let b165 = "foo" + let b166 = "foo" + let b167 = "foo" + let b168 = "foo" + let b169 = "foo" + let b170 = "foo" + let b171 = "foo" + let b172 = "foo" + let b173 = "foo" + let b174 = "foo" + let b175 = "foo" + let b176 = "foo" + let b177 = "foo" + let b178 = "foo" + let b179 = "foo" + let b180 = "foo" + let b181 = "foo" + let b182 = "foo" + let b183 = "foo" + let b184 = "foo" + let b185 = "foo" + let b186 = "foo" + let b187 = "foo" + let b188 = "foo" + let b189 = "foo" + let b190 = "foo" + let b191 = "foo" + let b192 = "foo" + let b193 = "foo" + let b194 = "foo" + let b195 = "foo" + let b196 = "foo" + let b197 = "foo" + let b198 = "foo" + let b199 = "foo" + let b200 = "foo" + let b201 = "foo" + let b202 = "foo" + let b203 = "foo" + let b204 = "foo" + let b205 = "foo" + let b206 = "foo" + let b207 = "foo" + let b208 = "foo" + let b209 = "foo" + let b210 = "foo" + let b211 = "foo" + let b212 = "foo" + let b213 = "foo" + let b214 = "foo" + let b215 = "foo" + let b216 = "foo" + let b217 = "foo" + let b218 = "foo" + let b219 = "foo" + let b220 = "foo" + let b221 = "foo" + let b222 = "foo" + let b223 = "foo" + let b224 = "foo" + let b225 = "foo" + let b226 = "foo" + let b227 = "foo" + let b228 = "foo" + let b229 = "foo" + let b230 = "foo" + let b231 = "foo" + let b232 = "foo" + let b233 = "foo" + let b234 = "foo" + let b235 = "foo" + let b236 = "foo" + let b237 = "foo" + let b238 = "foo" + let b239 = "foo" + let b240 = "foo" + let b241 = "foo" + let b242 = "foo" + let b243 = "foo" + let b244 = "foo" + let b245 = "foo" + let b246 = "foo" + let b247 = "foo" + let b248 = "foo" + let b249 = "foo" + let b250 = "foo" + let b251 = "foo" + let b252 = "foo" + let b253 = "foo" + let b254 = "foo" + let b255 = "foo" + let b256 = "foo" + let b257 = "foo" + let b258 = "foo" + let b259 = "foo" + let b260 = "foo" + let b261 = "foo" + let b262 = "foo" + let b263 = "foo" + let b264 = "foo" + let b265 = "foo" + let b266 = "foo" + let b267 = "foo" + let b268 = "foo" + let b269 = "foo" + let b270 = "foo" + let b271 = "foo" + let b272 = "foo" + let b273 = "foo" + let b274 = "foo" + let b275 = "foo" + let b276 = "foo" + let b277 = "foo" + let b278 = "foo" + let b279 = "foo" + let b280 = "foo" + let b281 = "foo" + let b282 = "foo" + let b283 = "foo" + let b284 = "foo" + let b285 = "foo" + let b286 = "foo" + let b287 = "foo" + let b288 = "foo" + let b289 = "foo" + let b290 = "foo" + let b291 = "foo" + let b292 = "foo" + let b293 = "foo" + let b294 = "foo" + let b295 = "foo" + let b296 = "foo" + let b297 = "foo" + let b298 = "foo" + let b299 = "foo" + let b300 = "foo" + let b301 = "foo" + let b302 = "foo" + let b303 = "foo" + let b304 = "foo" + let b305 = "foo" + let b306 = "foo" + let b307 = "foo" + let b308 = "foo" + let b309 = "foo" + let b310 = "foo" + let b311 = "foo" + let b312 = "foo" + let b313 = "foo" + let b314 = "foo" + let b315 = "foo" + let b316 = "foo" + let b317 = "foo" + let b318 = "foo" + let b319 = "foo" + let b320 = "foo" + let b321 = "foo" + let b322 = "foo" + let b323 = "foo" + let b324 = "foo" + let b325 = "foo" + let b326 = "foo" + let b327 = "foo" + let b328 = "foo" + let b329 = "foo" + let b330 = "foo" + let b331 = "foo" + let b332 = "foo" + let b333 = "foo" + let b334 = "foo" + let b335 = "foo" + let b336 = "foo" + let b337 = "foo" + let b338 = "foo" + let b339 = "foo" + let b340 = "foo" + let b341 = "foo" + let b342 = "foo" + let b343 = "foo" + let b344 = "foo" + let b345 = "foo" + let b346 = "foo" + let b347 = "foo" + let b348 = "foo" + let b349 = "foo" + let b350 = "foo" + let b351 = "foo" + let b352 = "foo" + let b353 = "foo" + let b354 = "foo" + let b355 = "foo" + let b356 = "foo" + let b357 = "foo" + let b358 = "foo" + let b359 = "foo" + let b360 = "foo" + let b361 = "foo" + let b362 = "foo" + let b363 = "foo" + let b364 = "foo" + let b365 = "foo" + let b366 = "foo" + let b367 = "foo" + let b368 = "foo" + let b369 = "foo" + let b370 = "foo" + let b371 = "foo" + let b372 = "foo" + let b373 = "foo" + let b374 = "foo" + let b375 = "foo" + let b376 = "foo" + let b377 = "foo" + let b378 = "foo" + let b379 = "foo" + let b380 = "foo" + let b381 = "foo" + let b382 = "foo" + let b383 = "foo" + let b384 = "foo" + let b385 = "foo" + let b386 = "foo" + let b387 = "foo" + let b388 = "foo" + let b389 = "foo" + let b390 = "foo" + let b391 = "foo" + let b392 = "foo" + let b393 = "foo" + let b394 = "foo" + let b395 = "foo" + let b396 = "foo" + let b397 = "foo" + let b398 = "foo" + let b399 = "foo" + let b400 = "foo" + let b401 = "foo" + let b402 = "foo" + let b403 = "foo" + let b404 = "foo" + let b405 = "foo" + let b406 = "foo" + let b407 = "foo" + let b408 = "foo" + let b409 = "foo" + let b410 = "foo" + let b411 = "foo" + let b412 = "foo" + let b413 = "foo" + let b414 = "foo" + let b415 = "foo" + let b416 = "foo" + let b417 = "foo" + let b418 = "foo" + let b419 = "foo" + let b420 = "foo" + let b421 = "foo" + let b422 = "foo" + let b423 = "foo" + let b424 = "foo" + let b425 = "foo" + let b426 = "foo" + let b427 = "foo" + let b428 = "foo" + let b429 = "foo" + let b430 = "foo" + let b431 = "foo" + let b432 = "foo" + let b433 = "foo" + let b434 = "foo" + let b435 = "foo" + let b436 = "foo" + let b437 = "foo" + let b438 = "foo" + let b439 = "foo" + let b440 = "foo" + let b441 = "foo" + let b442 = "foo" + let b443 = "foo" + let b444 = "foo" + let b445 = "foo" + let b446 = "foo" + let b447 = "foo" + let b448 = "foo" + let b449 = "foo" + let b450 = "foo" + let b451 = "foo" + let b452 = "foo" + let b453 = "foo" + let b454 = "foo" + let b455 = "foo" + let b456 = "foo" + let b457 = "foo" + let b458 = "foo" + let b459 = "foo" + let b460 = "foo" + let b461 = "foo" + let b462 = "foo" + let b463 = "foo" + let b464 = "foo" + let b465 = "foo" + let b466 = "foo" + let b467 = "foo" + let b468 = "foo" + let b469 = "foo" + let b470 = "foo" + let b471 = "foo" + let b472 = "foo" + let b473 = "foo" + let b474 = "foo" + let b475 = "foo" + let b476 = "foo" + let b477 = "foo" + let b478 = "foo" + let b479 = "foo" + let b480 = "foo" + let b481 = "foo" + let b482 = "foo" + let b483 = "foo" + let b484 = "foo" + let b485 = "foo" + let b486 = "foo" +#endif + +// This is a compilation test, not a lot actually happens in the test +do (System.Console.Out.WriteLine "Test Passed"; + System.IO.File.WriteAllText("test.ok", "ok"); + exit 0) + diff --git a/tests/fsharp/single-test.fs b/tests/fsharp/single-test.fs index 68cb5c0f3d6..a80a6d3f96f 100644 --- a/tests/fsharp/single-test.fs +++ b/tests/fsharp/single-test.fs @@ -8,18 +8,15 @@ open HandleExpects open FSharp.Compiler.IO type Permutation = - | FSC_CORECLR - | FSC_CORECLR_OPT_MINUS - | FSC_CORECLR_BUILDONLY - | FSI_CORECLR -#if !NETCOREAPP - | FSI_FILE - | FSI_STDIN - | GENERATED_SIGNATURE - | FSC_BUILDONLY - | FSC_OPT_MINUS_DEBUG - | FSC_OPT_PLUS_DEBUG - | AS_DLL +#if NETCOREAPP + | FSC_NETCORE of optimized: bool * buildOnly: bool + | FSI_NETCORE +#else + | FSC_NETFX of optimized: bool * buildOnly: bool + | FSI_NETFX + | FSI_NETFX_STDIN + | FSC_NETFX_TEST_GENERATED_SIGNATURE + | FSC_NETFX_TEST_ROUNDTRIP_AS_DLL #endif // Because we build programs ad dlls the compiler will copy an fsharp.core.dll into the build directory @@ -306,18 +303,14 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = printfn "Filename: %s" projectFileName match p with - | FSC_CORECLR -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" true false - | FSC_CORECLR_OPT_MINUS -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" false false - | FSC_CORECLR_BUILDONLY -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" true true - | FSI_CORECLR -> executeSingleTestBuildAndRun OutputType.Script "coreclr" "net5.0" true false - -#if !NETCOREAPP - | FSC_BUILDONLY -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" false true - | FSC_OPT_PLUS_DEBUG -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" true false - | FSC_OPT_MINUS_DEBUG -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" false false - | FSI_FILE -> executeSingleTestBuildAndRun OutputType.Script "net40" "net472" true false - - | FSI_STDIN -> +#if NETCOREAPP + | FSC_NETCORE (optimized, buildOnly) -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" optimized buildOnly + | FSI_NETCORE -> executeSingleTestBuildAndRun OutputType.Script "coreclr" "net5.0" true false +#else + | FSC_NETFX (optimized, buildOnly) -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" optimized buildOnly + | FSI_NETFX -> executeSingleTestBuildAndRun OutputType.Script "net40" "net472" true false + + | FSI_NETFX_STDIN -> use _cleanup = (cleanUpFSharpCore cfg) use testOkFile = new FileGuard (getfullpath cfg "test.ok") let sources = extraSources |> List.filter (fileExists cfg) @@ -326,7 +319,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = testOkFile.CheckExists() - | GENERATED_SIGNATURE -> + | FSC_NETFX_TEST_GENERATED_SIGNATURE -> use _cleanup = (cleanUpFSharpCore cfg) let source1 = @@ -337,7 +330,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = source1 |> Option.iter (fun from -> copy_y cfg from "tmptest.fs") log "Generated signature file..." - fsc cfg "%s --sig:tmptest.fsi --define:GENERATED_SIGNATURE" cfg.fsc_flags ["tmptest.fs"] + fsc cfg "%s --sig:tmptest.fsi --define:FSC_NETFX_TEST_GENERATED_SIGNATURE" cfg.fsc_flags ["tmptest.fs"] log "Compiling against generated signature file..." fsc cfg "%s -o:tmptest1.exe" cfg.fsc_flags ["tmptest.fsi";"tmptest.fs"] @@ -345,7 +338,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = log "Verifying built .exe..." peverify cfg "tmptest1.exe" - | AS_DLL -> + | FSC_NETFX_TEST_ROUNDTRIP_AS_DLL -> // Compile as a DLL to exercise pickling of interface data, then recompile the original source file referencing this DLL // THe second compilation will not utilize the information from the first in any meaningful way, but the // compiler will unpickle the interface and optimization data, so we test unpickling as well. diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 0ca1911eeea..a849aa0d571 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -21,14 +21,15 @@ open FSharp.Test #if NETCOREAPP // Use these lines if you want to test CoreCLR -let FSC_BASIC = FSC_CORECLR -let FSC_BASIC_OPT_MINUS = FSC_CORECLR_OPT_MINUS -let FSC_BUILDONLY = FSC_CORECLR_BUILDONLY -let FSI_BASIC = FSI_CORECLR +let FSC_OPTIMIZED = FSC_NETCORE (true, false) +let FSC_DEBUG = FSC_NETCORE (false, false) +let FSC_BUILDONLY optimized = FSC_NETCORE (optimized, true) +let FSI = FSI_NETCORE #else -let FSC_BASIC = FSC_OPT_PLUS_DEBUG -let FSC_BASIC_OPT_MINUS = FSC_OPT_MINUS_DEBUG -let FSI_BASIC = FSI_FILE +let FSC_OPTIMIZED = FSC_NETFX (true, false) +let FSC_DEBUG = FSC_NETFX (false, false) +let FSC_BUILDONLY optimized = FSC_NETFX (optimized, true) +let FSI = FSI_NETFX #endif // ^^^^^^^^^^^^ To run these tests in F# Interactive , 'build net40', then send this chunk, then evaluate body of a test ^^^^^^^^^^^^ @@ -41,43 +42,43 @@ let testConfig = getTestsDirectory >> testConfig module CoreTests = // These tests are enabled for .NET Framework and .NET Core [] - let ``access-FSC_BASIC_OPT_MINUS``() = singleTestBuildAndRun "core/access" FSC_BASIC_OPT_MINUS + let ``access-FSC_DEBUG``() = singleTestBuildAndRun "core/access" FSC_DEBUG [] - let ``access-FSC_BASIC``() = singleTestBuildAndRun "core/access" FSC_BASIC + let ``access-FSC_OPTIMIZED``() = singleTestBuildAndRun "core/access" FSC_OPTIMIZED [] - let ``access-FSI_BASIC``() = singleTestBuildAndRun "core/access" FSI_BASIC + let ``access-FSI``() = singleTestBuildAndRun "core/access" FSI [] - let ``apporder-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/apporder" FSC_BASIC_OPT_MINUS + let ``apporder-FSC_DEBUG`` () = singleTestBuildAndRun "core/apporder" FSC_DEBUG [] - let ``apporder-FSC_BASIC`` () = singleTestBuildAndRun "core/apporder" FSC_BASIC + let ``apporder-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/apporder" FSC_OPTIMIZED [] - let ``apporder-FSI_BASIC`` () = singleTestBuildAndRun "core/apporder" FSI_BASIC + let ``apporder-FSI`` () = singleTestBuildAndRun "core/apporder" FSI [] - let ``array-FSC_BASIC_OPT_MINUS-5.0`` () = singleTestBuildAndRunVersion "core/array" FSC_BASIC_OPT_MINUS "5.0" + let ``array-FSC_DEBUG-5.0`` () = singleTestBuildAndRunVersion "core/array" FSC_DEBUG "5.0" [] - let ``array-FSC_BASIC-5.0`` () = singleTestBuildAndRunVersion "core/array" FSC_BASIC "5.0" + let ``array-FSC_OPTIMIZED-5.0`` () = singleTestBuildAndRunVersion "core/array" FSC_OPTIMIZED "5.0" [] - let ``array-FSI_BASIC-5.0`` () = singleTestBuildAndRunVersion "core/array" FSI_BASIC "5.0" + let ``array-FSI-5.0`` () = singleTestBuildAndRunVersion "core/array" FSI "5.0" [] - let ``array-FSC_BASIC-preview`` () = singleTestBuildAndRunVersion "core/array" FSC_BASIC "preview" + let ``array-FSC_OPTIMIZED-preview`` () = singleTestBuildAndRunVersion "core/array" FSC_OPTIMIZED "preview" [] - let ``array-no-dot-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_BASIC_OPT_MINUS "preview" + let ``array-no-dot-FSC_DEBUG`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_DEBUG "preview" [] - let ``array-no-dot-FSC_BASIC`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_BASIC "preview" + let ``array-no-dot-FSC_OPTIMIZED`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_OPTIMIZED "preview" [] - let ``array-no-dot-FSI_BASIC`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSI_BASIC "preview" + let ``array-no-dot-FSI`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSI "preview" [] let ``array-no-dot-warnings-langversion-default`` () = @@ -100,12 +101,12 @@ module CoreTests = singleVersionedNegTest cfg "5.0" "test" [] - let ``auto-widen-version-FSC_BASIC_OPT_MINUS-preview``() = - singleTestBuildAndRunVersion "core/auto-widen/preview" FSC_BASIC_OPT_MINUS "preview" + let ``auto-widen-version-FSC_DEBUG-preview``() = + singleTestBuildAndRunVersion "core/auto-widen/preview" FSC_DEBUG "preview" [] - let ``auto-widen-version-FSC_BASIC-preview``() = - singleTestBuildAndRunVersion "core/auto-widen/preview" FSC_BASIC "preview" + let ``auto-widen-version-FSC_OPTIMIZED-preview``() = + singleTestBuildAndRunVersion "core/auto-widen/preview" FSC_OPTIMIZED "preview" [] let ``auto-widen-version-preview-warns-on``() = @@ -120,283 +121,283 @@ module CoreTests = singleVersionedNegTest cfg "preview" "test" [] - let ``comprehensions-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/comprehensions" FSC_BASIC_OPT_MINUS + let ``comprehensions-FSC_DEBUG`` () = singleTestBuildAndRun "core/comprehensions" FSC_DEBUG [] - let ``comprehensions-FSC_BASIC`` () = singleTestBuildAndRun "core/comprehensions" FSC_BASIC + let ``comprehensions-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/comprehensions" FSC_OPTIMIZED [] - let ``comprehensions-FSI_BASIC`` () = singleTestBuildAndRun "core/comprehensions" FSI_BASIC + let ``comprehensions-FSI`` () = singleTestBuildAndRun "core/comprehensions" FSI [] - let ``comprehensionshw-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_BASIC_OPT_MINUS + let ``comprehensionshw-FSC_DEBUG`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_DEBUG [] - let ``comprehensionshw-FSC_BASIC`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_BASIC + let ``comprehensionshw-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_OPTIMIZED [] - let ``comprehensionshw-FSI_BASIC`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI_BASIC + let ``comprehensionshw-FSI`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI [] - let ``genericmeasures-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/genericmeasures" FSC_BASIC_OPT_MINUS + let ``genericmeasures-FSC_DEBUG`` () = singleTestBuildAndRun "core/genericmeasures" FSC_DEBUG [] - let ``genericmeasures-FSC_BASIC`` () = singleTestBuildAndRun "core/genericmeasures" FSC_BASIC + let ``genericmeasures-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/genericmeasures" FSC_OPTIMIZED [] - let ``genericmeasures-FSI_BASIC`` () = singleTestBuildAndRun "core/genericmeasures" FSI_BASIC + let ``genericmeasures-FSI`` () = singleTestBuildAndRun "core/genericmeasures" FSI [] - let ``innerpoly-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/innerpoly" FSC_BASIC_OPT_MINUS + let ``innerpoly-FSC_DEBUG`` () = singleTestBuildAndRun "core/innerpoly" FSC_DEBUG [] - let ``innerpoly-FSC_BASIC`` () = singleTestBuildAndRun "core/innerpoly" FSC_BASIC + let ``innerpoly-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/innerpoly" FSC_OPTIMIZED [] - let ``innerpoly-FSI_BASIC`` () = singleTestBuildAndRun "core/innerpoly" FSI_BASIC + let ``innerpoly-FSI`` () = singleTestBuildAndRun "core/innerpoly" FSI [] - let ``namespaceAttributes-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/namespaces" FSC_BASIC_OPT_MINUS + let ``namespaceAttributes-FSC_DEBUG`` () = singleTestBuildAndRun "core/namespaces" FSC_DEBUG [] - let ``namespaceAttributes-FSC_BASIC`` () = singleTestBuildAndRun "core/namespaces" FSC_BASIC + let ``namespaceAttributes-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/namespaces" FSC_OPTIMIZED [] - let ``unicode2-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/unicode" FSC_BASIC_OPT_MINUS // TODO: fails on coreclr + let ``unicode2-FSC_DEBUG`` () = singleTestBuildAndRun "core/unicode" FSC_DEBUG // TODO: fails on coreclr [] - let ``unicode2-FSC_BASIC`` () = singleTestBuildAndRun "core/unicode" FSC_BASIC // TODO: fails on coreclr + let ``unicode2-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/unicode" FSC_OPTIMIZED // TODO: fails on coreclr [] - let ``unicode2-FSI_BASIC`` () = singleTestBuildAndRun "core/unicode" FSI_BASIC + let ``unicode2-FSI`` () = singleTestBuildAndRun "core/unicode" FSI [] - let ``lazy test-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/lazy" FSC_BASIC_OPT_MINUS + let ``lazy test-FSC_DEBUG`` () = singleTestBuildAndRun "core/lazy" FSC_DEBUG [] - let ``lazy test-FSC_BASIC`` () = singleTestBuildAndRun "core/lazy" FSC_BASIC + let ``lazy test-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/lazy" FSC_OPTIMIZED [] - let ``lazy test-FSI_BASIC`` () = singleTestBuildAndRun "core/lazy" FSI_BASIC + let ``lazy test-FSI`` () = singleTestBuildAndRun "core/lazy" FSI [] - let ``letrec-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/letrec" FSC_BASIC_OPT_MINUS + let ``letrec-FSC_DEBUG`` () = singleTestBuildAndRun "core/letrec" FSC_DEBUG [] - let ``letrec-FSC_BASIC`` () = singleTestBuildAndRun "core/letrec" FSC_BASIC + let ``letrec-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/letrec" FSC_OPTIMIZED [] - let ``letrec-FSI_BASIC`` () = singleTestBuildAndRun "core/letrec" FSI_BASIC + let ``letrec-FSI`` () = singleTestBuildAndRun "core/letrec" FSI [] - let ``letrec (mutrec variations part one) FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_BASIC_OPT_MINUS + let ``letrec (mutrec variations part one) FSC_DEBUG`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_DEBUG [] - let ``letrec (mutrec variations part one) FSC_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_BASIC + let ``letrec (mutrec variations part one) FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_OPTIMIZED [] - let ``letrec (mutrec variations part one) FSI_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec" FSI_BASIC + let ``letrec (mutrec variations part one) FSI`` () = singleTestBuildAndRun "core/letrec-mutrec" FSI [] - let ``libtest-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/libtest" FSC_BASIC_OPT_MINUS + let ``libtest-FSC_DEBUG`` () = singleTestBuildAndRun "core/libtest" FSC_DEBUG [] - let ``libtest-FSC_BASIC`` () = singleTestBuildAndRun "core/libtest" FSC_BASIC + let ``libtest-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/libtest" FSC_OPTIMIZED [] - let ``libtest-FSI_BASIC`` () = singleTestBuildAndRun "core/libtest" FSI_BASIC + let ``libtest-FSI`` () = singleTestBuildAndRun "core/libtest" FSI [] - let ``lift-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/lift" FSC_BASIC_OPT_MINUS + let ``lift-FSC_DEBUG`` () = singleTestBuildAndRun "core/lift" FSC_DEBUG [] - let ``lift-FSC_BASIC`` () = singleTestBuildAndRun "core/lift" FSC_BASIC + let ``lift-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/lift" FSC_OPTIMIZED [] - let ``lift-FSI_BASIC`` () = singleTestBuildAndRun "core/lift" FSI_BASIC + let ``lift-FSI`` () = singleTestBuildAndRun "core/lift" FSI [] - let ``map-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/map" FSC_BASIC_OPT_MINUS + let ``map-FSC_DEBUG`` () = singleTestBuildAndRun "core/map" FSC_DEBUG [] - let ``map-FSC_BASIC`` () = singleTestBuildAndRun "core/map" FSC_BASIC + let ``map-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/map" FSC_OPTIMIZED [] - let ``map-FSI_BASIC`` () = singleTestBuildAndRun "core/map" FSI_BASIC + let ``map-FSI`` () = singleTestBuildAndRun "core/map" FSI [] - let ``measures-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/measures" FSC_BASIC_OPT_MINUS + let ``measures-FSC_DEBUG`` () = singleTestBuildAndRun "core/measures" FSC_DEBUG [] - let ``measures-FSC_BASIC`` () = singleTestBuildAndRun "core/measures" FSC_BASIC + let ``measures-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/measures" FSC_OPTIMIZED [] - let ``measures-FSI_BASIC`` () = singleTestBuildAndRun "core/measures" FSI_BASIC + let ``measures-FSI`` () = singleTestBuildAndRun "core/measures" FSI [] - let ``nested-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/nested" FSC_BASIC_OPT_MINUS + let ``nested-FSC_DEBUG`` () = singleTestBuildAndRun "core/nested" FSC_DEBUG [] - let ``nested-FSC_BASIC`` () = singleTestBuildAndRun "core/nested" FSC_BASIC + let ``nested-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/nested" FSC_OPTIMIZED [] - let ``nested-FSI_BASIC`` () = singleTestBuildAndRun "core/nested" FSI_BASIC + let ``nested-FSI`` () = singleTestBuildAndRun "core/nested" FSI [] - let ``members-ops-FSC_BASIC`` () = singleTestBuildAndRun "core/members/ops" FSC_BASIC + let ``members-ops-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/ops" FSC_OPTIMIZED [] - let ``members-ops-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/ops" FSC_BASIC_OPT_MINUS + let ``members-ops-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/ops" FSC_DEBUG [] - let ``members-ops-FSI_BASIC`` () = singleTestBuildAndRun "core/members/ops" FSI_BASIC + let ``members-ops-FSI`` () = singleTestBuildAndRun "core/members/ops" FSI [] - let ``members-ops-mutrec-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_BASIC_OPT_MINUS + let ``members-ops-mutrec-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_DEBUG [] - let ``members-ops-mutrec-FSC_BASIC`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_BASIC + let ``members-ops-mutrec-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_OPTIMIZED [] - let ``members-ops-mutrec-FSI_BASIC`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSI_BASIC + let ``members-ops-mutrec-FSI`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSI [] - let ``seq-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/seq" FSC_BASIC_OPT_MINUS + let ``seq-FSC_DEBUG`` () = singleTestBuildAndRun "core/seq" FSC_DEBUG [] - let ``seq-FSC_BASIC`` () = singleTestBuildAndRun "core/seq" FSC_BASIC + let ``seq-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/seq" FSC_OPTIMIZED [] - let ``seq-FSI_BASIC`` () = singleTestBuildAndRun "core/seq" FSI_BASIC + let ``seq-FSI`` () = singleTestBuildAndRun "core/seq" FSI [] - let ``math-numbers-FSC_BASIC`` () = singleTestBuildAndRun "core/math/numbers" FSC_BASIC + let ``math-numbers-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/math/numbers" FSC_OPTIMIZED [] - let ``math-numbers-FSI_BASIC`` () = singleTestBuildAndRun "core/math/numbers" FSI_BASIC + let ``math-numbers-FSI`` () = singleTestBuildAndRun "core/math/numbers" FSI [] - let ``members-ctree-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/ctree" FSC_BASIC_OPT_MINUS + let ``members-ctree-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/ctree" FSC_DEBUG [] - let ``members-ctree-FSC_BASIC`` () = singleTestBuildAndRun "core/members/ctree" FSC_BASIC + let ``members-ctree-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/ctree" FSC_OPTIMIZED [] - let ``members-ctree-FSI_BASIC`` () = singleTestBuildAndRun "core/members/ctree" FSI_BASIC + let ``members-ctree-FSI`` () = singleTestBuildAndRun "core/members/ctree" FSI [] - let ``members-factors-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/factors" FSC_BASIC_OPT_MINUS + let ``members-factors-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/factors" FSC_DEBUG [] - let ``members-factors-FSC_BASIC`` () = singleTestBuildAndRun "core/members/factors" FSC_BASIC + let ``members-factors-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/factors" FSC_OPTIMIZED [] - let ``members-factors-FSI_BASIC`` () = singleTestBuildAndRun "core/members/factors" FSI_BASIC + let ``members-factors-FSI`` () = singleTestBuildAndRun "core/members/factors" FSI [] - let ``members-factors-mutrec-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_BASIC_OPT_MINUS + let ``members-factors-mutrec-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_DEBUG [] - let ``members-factors-mutrec-FSC_BASIC`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_BASIC + let ``members-factors-mutrec-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_OPTIMIZED [] - let ``members-factors-mutrec-FSI_BASIC`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSI_BASIC + let ``members-factors-mutrec-FSI`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSI [] - let ``graph-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "perf/graph" FSC_BASIC_OPT_MINUS + let ``graph-FSC_DEBUG`` () = singleTestBuildAndRun "perf/graph" FSC_DEBUG [] - let ``graph-FSC_BASIC`` () = singleTestBuildAndRun "perf/graph" FSC_BASIC + let ``graph-FSC_OPTIMIZED`` () = singleTestBuildAndRun "perf/graph" FSC_OPTIMIZED [] - let ``graph-FSI_BASIC`` () = singleTestBuildAndRun "perf/graph" FSI_BASIC + let ``graph-FSI`` () = singleTestBuildAndRun "perf/graph" FSI [] - let ``nbody-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "perf/nbody" FSC_BASIC_OPT_MINUS + let ``nbody-FSC_DEBUG`` () = singleTestBuildAndRun "perf/nbody" FSC_DEBUG [] - let ``nbody-FSC_BASIC`` () = singleTestBuildAndRun "perf/nbody" FSC_BASIC + let ``nbody-FSC_OPTIMIZED`` () = singleTestBuildAndRun "perf/nbody" FSC_OPTIMIZED [] - let ``nbody-FSI_BASIC`` () = singleTestBuildAndRun "perf/nbody" FSI_BASIC + let ``nbody-FSI`` () = singleTestBuildAndRun "perf/nbody" FSI [] - let ``forexpression-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/forexpression" FSC_BASIC_OPT_MINUS + let ``forexpression-FSC_DEBUG`` () = singleTestBuildAndRun "core/forexpression" FSC_DEBUG [] - let ``forexpression-FSC_BASIC`` () = singleTestBuildAndRun "core/forexpression" FSC_BASIC + let ``forexpression-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/forexpression" FSC_OPTIMIZED [] - let ``forexpression-FSI_BASIC`` () = singleTestBuildAndRun "core/forexpression" FSI_BASIC + let ``forexpression-FSI`` () = singleTestBuildAndRun "core/forexpression" FSI [] - let ``letrec (mutrec variations part two) FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_BASIC_OPT_MINUS + let ``letrec (mutrec variations part two) FSC_DEBUG`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_DEBUG [] - let ``letrec (mutrec variations part two) FSC_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_BASIC + let ``letrec (mutrec variations part two) FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_OPTIMIZED [] - let ``letrec (mutrec variations part two) FSI_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSI_BASIC + let ``letrec (mutrec variations part two) FSI`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSI [] - let ``printf`` () = singleTestBuildAndRunVersion "core/printf" FSC_BASIC "preview" + let ``printf`` () = singleTestBuildAndRunVersion "core/printf" FSC_OPTIMIZED "preview" [] - let ``printf-interpolated`` () = singleTestBuildAndRunVersion "core/printf-interpolated" FSC_BASIC "preview" + let ``printf-interpolated`` () = singleTestBuildAndRunVersion "core/printf-interpolated" FSC_OPTIMIZED "preview" [] - let ``tlr-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/tlr" FSC_BASIC_OPT_MINUS + let ``tlr-FSC_DEBUG`` () = singleTestBuildAndRun "core/tlr" FSC_DEBUG [] - let ``tlr-FSC_BASIC`` () = singleTestBuildAndRun "core/tlr" FSC_BASIC + let ``tlr-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/tlr" FSC_OPTIMIZED [] - let ``tlr-FSI_BASIC`` () = singleTestBuildAndRun "core/tlr" FSI_BASIC + let ``tlr-FSI`` () = singleTestBuildAndRun "core/tlr" FSI [] - let ``subtype-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/subtype" FSC_BASIC_OPT_MINUS + let ``subtype-FSC_DEBUG`` () = singleTestBuildAndRun "core/subtype" FSC_DEBUG [] - let ``subtype-FSC_BASIC`` () = singleTestBuildAndRun "core/subtype" FSC_BASIC + let ``subtype-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/subtype" FSC_OPTIMIZED [] - let ``subtype-FSI_BASIC`` () = singleTestBuildAndRun "core/subtype" FSI_BASIC + let ``subtype-FSI`` () = singleTestBuildAndRun "core/subtype" FSI [] - let ``syntax-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/syntax" FSC_BASIC_OPT_MINUS + let ``syntax-FSC_DEBUG`` () = singleTestBuildAndRun "core/syntax" FSC_DEBUG [] - let ``syntax-FSC_BASIC`` () = singleTestBuildAndRun "core/syntax" FSC_BASIC + let ``syntax-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/syntax" FSC_OPTIMIZED [] - let ``syntax-FSI_BASIC`` () = singleTestBuildAndRun "core/syntax" FSI_BASIC + let ``syntax-FSI`` () = singleTestBuildAndRun "core/syntax" FSI [] - let ``test int32-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/int32" FSC_BASIC_OPT_MINUS + let ``test int32-FSC_DEBUG`` () = singleTestBuildAndRun "core/int32" FSC_DEBUG [] - let ``test int32-FSC_BASIC`` () = singleTestBuildAndRun "core/int32" FSC_BASIC + let ``test int32-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/int32" FSC_OPTIMIZED [] - let ``test int32-FSI_BASIC`` () = singleTestBuildAndRun "core/int32" FSI_BASIC + let ``test int32-FSI`` () = singleTestBuildAndRun "core/int32" FSI [] - let ``quotes-FSC-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/quotes" FSC_BASIC_OPT_MINUS + let ``quotes-FSC-FSC_DEBUG`` () = singleTestBuildAndRun "core/quotes" FSC_DEBUG [] - let ``quotes-FSC-BASIC`` () = singleTestBuildAndRun "core/quotes" FSC_BASIC + let ``quotes-FSC-BASIC`` () = singleTestBuildAndRun "core/quotes" FSC_OPTIMIZED [] - let ``quotes-FSI-BASIC`` () = singleTestBuildAndRun "core/quotes" FSI_BASIC + let ``quotes-FSI-BASIC`` () = singleTestBuildAndRun "core/quotes" FSI [] - let ``recordResolution-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/recordResolution" FSC_BASIC_OPT_MINUS + let ``recordResolution-FSC_DEBUG`` () = singleTestBuildAndRun "core/recordResolution" FSC_DEBUG [] - let ``recordResolution-FSC_BASIC`` () = singleTestBuildAndRun "core/recordResolution" FSC_BASIC + let ``recordResolution-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/recordResolution" FSC_OPTIMIZED [] - let ``recordResolution-FSI_BASIC`` () = singleTestBuildAndRun "core/recordResolution" FSI_BASIC + let ``recordResolution-FSI`` () = singleTestBuildAndRun "core/recordResolution" FSI [] let ``SDKTests`` () = @@ -405,10 +406,10 @@ module CoreTests = #if !NETCOREAPP [] - let ``attributes-FSC_BASIC`` () = singleTestBuildAndRun "core/attributes" FSC_BASIC + let ``attributes-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/attributes" FSC_OPTIMIZED [] - let ``attributes-FSI_BASIC`` () = singleTestBuildAndRun "core/attributes" FSI_BASIC + let ``attributes-FSI`` () = singleTestBuildAndRun "core/attributes" FSI [] let byrefs () = @@ -652,58 +653,58 @@ module CoreTests = #endif [] - let ``control-FSC_BASIC`` () = singleTestBuildAndRun "core/control" FSC_BASIC + let ``control-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/control" FSC_OPTIMIZED [] - let ``control-FSI_BASIC`` () = singleTestBuildAndRun "core/control" FSI_BASIC + let ``control-FSI`` () = singleTestBuildAndRun "core/control" FSI [] let ``control --tailcalls`` () = let cfg = testConfig "core/control" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPTIMIZED [] - let ``controlChamenos-FSC_BASIC`` () = + let ``controlChamenos-FSC_OPTIMIZED`` () = let cfg = testConfig "core/controlChamenos" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPTIMIZED [] - let ``controlChamenos-FSI_BASIC`` () = + let ``controlChamenos-FSI`` () = let cfg = testConfig "core/controlChamenos" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSI_BASIC + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSI [] - let ``controlMailbox-FSC_BASIC`` () = singleTestBuildAndRun "core/controlMailbox" FSC_BASIC + let ``controlMailbox-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/controlMailbox" FSC_OPTIMIZED [] - let ``controlMailbox-FSI_BASIC`` () = singleTestBuildAndRun "core/controlMailbox" FSI_BASIC + let ``controlMailbox-FSI`` () = singleTestBuildAndRun "core/controlMailbox" FSI [] let ``controlMailbox --tailcalls`` () = let cfg = testConfig "core/controlMailbox" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPTIMIZED [] - let ``csext-FSC_BASIC`` () = singleTestBuildAndRun "core/csext" FSC_BASIC + let ``csext-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/csext" FSC_OPTIMIZED [] - let ``csext-FSI_BASIC`` () = singleTestBuildAndRun "core/csext" FSI_BASIC + let ``csext-FSI`` () = singleTestBuildAndRun "core/csext" FSI [] - let ``enum-FSC_BASIC`` () = singleTestBuildAndRun "core/enum" FSC_BASIC + let ``enum-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/enum" FSC_OPTIMIZED [] - let ``enum-FSI_BASIC`` () = singleTestBuildAndRun "core/enum" FSI_BASIC + let ``enum-FSI`` () = singleTestBuildAndRun "core/enum" FSI #if !NETCOREAPP // Requires winforms will not run on coreclr [] - let controlWpf () = singleTestBuildAndRun "core/controlwpf" FSC_BASIC + let controlWpf () = singleTestBuildAndRun "core/controlwpf" FSC_OPTIMIZED // These tests are enabled for .NET Framework [] - let ``anon-FSC_BASIC``() = + let ``anon-FSC_OPTIMIZED``() = let cfg = testConfig "core/anon" fsc cfg "%s -a -o:lib.dll" cfg.fsc_flags ["lib.fs"] @@ -962,7 +963,7 @@ module CoreTests = testOkFile.CheckExists() [] - let ``genericmeasures-AS_DLL`` () = singleTestBuildAndRun "core/genericmeasures" AS_DLL + let ``genericmeasures-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/genericmeasures" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] @@ -982,7 +983,7 @@ module CoreTests = peverify cfg "client.exe" [] - let ``innerpoly-AS_DLL`` () = singleTestBuildAndRun "core/innerpoly" AS_DLL + let ``innerpoly-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/innerpoly" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] let queriesCustomQueryOps () = @@ -1355,13 +1356,13 @@ module CoreTests = exec cfg ("." ++ "test.exe") "" [] - let ``libtest-FSI_STDIN`` () = singleTestBuildAndRun "core/libtest" FSI_STDIN + let ``libtest-FSI_NETFX_STDIN`` () = singleTestBuildAndRun "core/libtest" FSI_NETFX_STDIN [] - let ``libtest-FSC_OPT_MINUS_DEBUG`` () = singleTestBuildAndRun "core/libtest" FSC_OPT_MINUS_DEBUG + let ``libtest-unoptimized codegen`` () = singleTestBuildAndRun "core/libtest" FSC_DEBUG [] - let ``libtest-AS_DLL`` () = singleTestBuildAndRun "core/libtest" AS_DLL + let ``libtest-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/libtest" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] let ``no-warn-2003-tests`` () = @@ -1554,64 +1555,64 @@ module CoreTests = #endif [] - let ``longnames-FSC_BASIC`` () = singleTestBuildAndRun "core/longnames" FSC_BASIC + let ``longnames-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/longnames" FSC_OPTIMIZED [] - let ``longnames-FSI_BASIC`` () = singleTestBuildAndRun "core/longnames" FSI_BASIC + let ``longnames-FSI`` () = singleTestBuildAndRun "core/longnames" FSI [] - let ``math-numbersVS2008-FSC_BASIC`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSC_BASIC + let ``math-numbersVS2008-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSC_OPTIMIZED [] - let ``math-numbersVS2008-FSI_BASIC`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSI_BASIC + let ``math-numbersVS2008-FSI`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSI [] - let ``patterns-FSC_BASIC`` () = singleTestBuildAndRunVersion "core/patterns" FSC_BASIC "preview" + let ``patterns-FSC_OPTIMIZED`` () = singleTestBuildAndRunVersion "core/patterns" FSC_OPTIMIZED "preview" //BUGBUG: https://github.com/Microsoft/visualfsharp/issues/6601 // [] -// let ``patterns-FSI_BASIC`` () = singleTestBuildAndRun' "core/patterns" FSI_BASIC +// let ``patterns-FSI`` () = singleTestBuildAndRun' "core/patterns" FSI [] - let ``pinvoke-FSC_BASIC`` () = singleTestBuildAndRun "core/pinvoke" FSC_BASIC + let ``pinvoke-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/pinvoke" FSC_OPTIMIZED [] - let ``pinvoke-FSI_BASIC`` () = - singleTestBuildAndRun "core/pinvoke" FSI_BASIC + let ``pinvoke-FSI`` () = + singleTestBuildAndRun "core/pinvoke" FSI [] - let ``fsi_load-FSC_BASIC`` () = singleTestBuildAndRun "core/fsi-load" FSC_BASIC + let ``fsi_load-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/fsi-load" FSC_OPTIMIZED [] - let ``fsi_load-FSI_BASIC`` () = singleTestBuildAndRun "core/fsi-load" FSI_BASIC + let ``fsi_load-FSI`` () = singleTestBuildAndRun "core/fsi-load" FSI #if !NETCOREAPP [] - let ``measures-AS_DLL`` () = singleTestBuildAndRun "core/measures" AS_DLL + let ``measures-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/measures" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] - let ``members-basics-AS_DLL`` () = singleTestBuildAndRun "core/members/basics" AS_DLL + let ``members-basics-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/members/basics" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] - let ``members-basics-hw`` () = singleTestBuildAndRun "core/members/basics-hw" FSC_BASIC + let ``members-basics-hw`` () = singleTestBuildAndRun "core/members/basics-hw" FSC_OPTIMIZED [] - let ``members-basics-hw-mutrec`` () = singleTestBuildAndRun "core/members/basics-hw-mutrec" FSC_BASIC + let ``members-basics-hw-mutrec`` () = singleTestBuildAndRun "core/members/basics-hw-mutrec" FSC_OPTIMIZED [] - let ``members-incremental-FSC_BASIC`` () = singleTestBuildAndRun "core/members/incremental" FSC_BASIC + let ``members-incremental-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/incremental" FSC_OPTIMIZED [] - let ``members-incremental-FSI_BASIC`` () = singleTestBuildAndRun "core/members/incremental" FSI_BASIC + let ``members-incremental-FSI`` () = singleTestBuildAndRun "core/members/incremental" FSI [] - let ``members-incremental-hw-FSC_BASIC`` () = singleTestBuildAndRun "core/members/incremental-hw" FSC_BASIC + let ``members-incremental-hw-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/incremental-hw" FSC_OPTIMIZED [] - let ``members-incremental-hw-FSI_BASIC`` () = singleTestBuildAndRun "core/members/incremental-hw" FSI_BASIC + let ``members-incremental-hw-FSI`` () = singleTestBuildAndRun "core/members/incremental-hw" FSI [] - let ``members-incremental-hw-mutrec-FSC_BASIC`` () = singleTestBuildAndRun "core/members/incremental-hw-mutrec" FSC_BASIC + let ``members-incremental-hw-mutrec-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/incremental-hw-mutrec" FSC_OPTIMIZED [] let queriesLeafExpressionConvert () = @@ -1811,10 +1812,10 @@ module CoreTests = #endif [] - let ``reflect-FSC_BASIC`` () = singleTestBuildAndRun "core/reflect" FSC_BASIC + let ``reflect-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/reflect" FSC_OPTIMIZED [] - let ``reflect-FSI_BASIC`` () = singleTestBuildAndRun "core/reflect" FSI_BASIC + let ``reflect-FSI`` () = singleTestBuildAndRun "core/reflect" FSI #if !NETCOREAPP [] @@ -2053,28 +2054,28 @@ module CoreTests = [] module VersionTests = [] - let ``member-selfidentifier-version4_6``() = singleTestBuildAndRunVersion "core/members/self-identifier/version46" FSC_BUILDONLY "4.6" + let ``member-selfidentifier-version4_6``() = singleTestBuildAndRunVersion "core/members/self-identifier/version46" (FSC_BUILDONLY true) "4.6" [] - let ``member-selfidentifier-version4_7``() = singleTestBuildAndRun "core/members/self-identifier/version47" FSC_BUILDONLY + let ``member-selfidentifier-version4_7``() = singleTestBuildAndRun "core/members/self-identifier/version47" (FSC_BUILDONLY true) [] - let ``indent-version4_6``() = singleTestBuildAndRunVersion "core/indent/version46" FSC_BUILDONLY "4.6" + let ``indent-version4_6``() = singleTestBuildAndRunVersion "core/indent/version46" (FSC_BUILDONLY true) "4.6" [] - let ``indent-version4_7``() = singleTestBuildAndRun "core/indent/version47" FSC_BUILDONLY + let ``indent-version4_7``() = singleTestBuildAndRun "core/indent/version47" (FSC_BUILDONLY true) [] - let ``nameof-version4_6``() = singleTestBuildAndRunVersion "core/nameof/version46" FSC_BUILDONLY "4.6" + let ``nameof-version4_6``() = singleTestBuildAndRunVersion "core/nameof/version46" (FSC_BUILDONLY true) "4.6" [] - let ``nameof-versionpreview``() = singleTestBuildAndRunVersion "core/nameof/preview" FSC_BUILDONLY "preview" + let ``nameof-versionpreview``() = singleTestBuildAndRunVersion "core/nameof/preview" (FSC_BUILDONLY true) "preview" [] - let ``nameof-execute``() = singleTestBuildAndRunVersion "core/nameof/preview" FSC_BASIC "preview" + let ``nameof-execute``() = singleTestBuildAndRunVersion "core/nameof/preview" FSC_OPTIMIZED "preview" [] - let ``nameof-fsi``() = singleTestBuildAndRunVersion "core/nameof/preview" FSI_BASIC "preview" + let ``nameof-fsi``() = singleTestBuildAndRunVersion "core/nameof/preview" FSI "preview" #if !NETCOREAPP [] @@ -2103,35 +2104,103 @@ module ToolsTests = #endif [] - let ``eval-FSC_BASIC`` () = singleTestBuildAndRun "tools/eval" FSC_BASIC + let ``eval-FSC_OPTIMIZED`` () = singleTestBuildAndRun "tools/eval" FSC_OPTIMIZED [] - let ``eval-FSI_BASIC`` () = singleTestBuildAndRun "tools/eval" FSI_BASIC + let ``eval-FSI`` () = singleTestBuildAndRun "tools/eval" FSI [] module RegressionTests = [] - let ``literal-value-bug-2-FSC_BASIC`` () = singleTestBuildAndRun "regression/literal-value-bug-2" FSC_BASIC + let ``literal-value-bug-2-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/literal-value-bug-2" FSC_OPTIMIZED [] - let ``literal-value-bug-2-FSI_BASIC`` () = singleTestBuildAndRun "regression/literal-value-bug-2" FSI_BASIC + let ``literal-value-bug-2-FSI`` () = singleTestBuildAndRun "regression/literal-value-bug-2" FSI [] - let ``OverloadResolution-bug-FSC_BASIC`` () = singleTestBuildAndRun "regression/OverloadResolution-bug" FSC_BASIC + let ``OverloadResolution-bug-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/OverloadResolution-bug" FSC_OPTIMIZED [] - let ``OverloadResolution-bug-FSI_BASIC`` () = singleTestBuildAndRun "regression/OverloadResolution-bug" FSI_BASIC + let ``OverloadResolution-bug-FSI`` () = singleTestBuildAndRun "regression/OverloadResolution-bug" FSI [] - let ``struct-tuple-bug-1-FSC_BASIC`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSC_BASIC + let ``struct-tuple-bug-1-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSC_OPTIMIZED [] - let ``tuple-bug-1-FSC_BASIC`` () = singleTestBuildAndRun "regression/tuple-bug-1" FSC_BASIC + let ``tuple-bug-1-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/tuple-bug-1" FSC_OPTIMIZED [] - let ``12383-FSC_BASIC`` () = singleTestBuildAndRun "regression/12383" FSC_BASIC + let ``12383-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/12383" FSC_OPTIMIZED + +#if NETCOREAPP + [] + let ``Large inputs 12322 fsc.dll 64-bit fsc.dll .NET SDK generating optimized code`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``Large inputs 12322 fsc.dll 64-bit .NET SDK generating debug code`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) + +#else + [] + let ``Large inputs 12322 fsc.exe 32-bit .NET Framework generating optimized code, portable PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``Large inputs 12322 fsc.exe 32-bit .NET Framework generating optimized code, full PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:full" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``Large inputs 12322 fsc.exe 32-bit .NET Framework generating debug code portable PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) + + [] + let ``Large inputs 12322 fsc.exe 32-bit .NET Framework generating debug code, full PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:full" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) + + [] + let ``Large inputs 12322 fscAnyCpu.exe 64-bit .NET Framework generating optimized code, portable PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with FSC = cfg.FSCANYCPU } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``Large inputs 12322 fscAnyCpu.exe 64-bit .NET Framework generating optimized code, full PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with FSC = cfg.FSCANYCPU } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:full " } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``12322 fscAnyCpu.exe 64-bit .NET Framework generating debug code, portable PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with FSC = cfg.FSCANYCPU } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) + + [] + let ``12322 fscAnyCpu.exe 64-bit .NET Framework generating debug code, full PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with FSC = cfg.FSCANYCPU } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:full" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) +#endif #if !NETCOREAPP + [] let ``SRTP doesn't handle calling member hiding hinherited members`` () = let cfg = testConfig "regression/5531" @@ -2161,10 +2230,10 @@ module RegressionTests = #endif [] - let ``26`` () = singleTestBuildAndRun "regression/26" FSC_BASIC + let ``26`` () = singleTestBuildAndRun "regression/26" FSC_OPTIMIZED [] - let ``321`` () = singleTestBuildAndRun "regression/321" FSC_BASIC + let ``321`` () = singleTestBuildAndRun "regression/321" FSC_OPTIMIZED #if !NETCOREAPP // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 @@ -2199,10 +2268,10 @@ module RegressionTests = #if !NETCOREAPP // Requires WinForms [] - let ``83`` () = singleTestBuildAndRun "regression/83" FSC_BASIC + let ``83`` () = singleTestBuildAndRun "regression/83" FSC_OPTIMIZED [] - let ``84`` () = singleTestBuildAndRun "regression/84" FSC_BASIC + let ``84`` () = singleTestBuildAndRun "regression/84" FSC_OPTIMIZED [] let ``85`` () = @@ -2214,10 +2283,10 @@ module RegressionTests = #endif [] - let ``86`` () = singleTestBuildAndRun "regression/86" FSC_BASIC + let ``86`` () = singleTestBuildAndRun "regression/86" FSC_OPTIMIZED [] - let ``struct-tuple-bug-1-FSI_BASIC`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSI_BASIC + let ``struct-tuple-bug-1-FSI`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSI #if !NETCOREAPP // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 @@ -2368,10 +2437,10 @@ module TypecheckTests = [] let ``full-rank-arrays`` () = let cfg = testConfig "typecheck/full-rank-arrays" - SingleTest.singleTestBuildAndRunWithCopyDlls cfg "full-rank-arrays.dll" FSC_BASIC + SingleTest.singleTestBuildAndRunWithCopyDlls cfg "full-rank-arrays.dll" FSC_OPTIMIZED [] - let misc () = singleTestBuildAndRun "typecheck/misc" FSC_BASIC + let misc () = singleTestBuildAndRun "typecheck/misc" FSC_OPTIMIZED #if !NETCOREAPP @@ -3241,25 +3310,25 @@ namespace CST.RI.Anshun module GeneratedSignatureTests = [] - let ``libtest-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/libtest" GENERATED_SIGNATURE + let ``libtest-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/libtest" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``members-basics-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/members/basics" GENERATED_SIGNATURE + let ``members-basics-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/members/basics" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``access-GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/access" GENERATED_SIGNATURE + let ``access-FSC_NETFX_TEST_GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/access" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``array-GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/array" GENERATED_SIGNATURE + let ``array-FSC_NETFX_TEST_GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/array" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``genericmeasures-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/genericmeasures" GENERATED_SIGNATURE + let ``genericmeasures-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/genericmeasures" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``innerpoly-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/innerpoly" GENERATED_SIGNATURE + let ``innerpoly-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/innerpoly" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``measures-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/measures" GENERATED_SIGNATURE + let ``measures-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/measures" FSC_NETFX_TEST_GENERATED_SIGNATURE #endif #if !NETCOREAPP From ee93e0505d3a4b5d13be9bcc7596b6e6abf2d2fe Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Tue, 23 Nov 2021 18:57:30 +0800 Subject: [PATCH 21/26] UnmanagedCallersOnlyAttribute is unsupported (#12350) --- src/fsharp/TcGlobals.fs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 33f19c1861a..e6b819f448e 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -933,6 +933,12 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d | true, builder -> builder tinst | _ -> TType_app (tcref, tinst) + // Adding an unnecessary "let" instead of inlining into a muiti-line pipelined compute-once "member val" that is too complex for @dsyme + let v_attribs_Unsupported = [ + tryFindSysAttrib "System.Runtime.CompilerServices.ModuleInitializerAttribute" + tryFindSysAttrib "System.Runtime.CompilerServices.CallerArgumentExpressionAttribute" + tryFindSysAttrib "System.Runtime.InteropServices.UnmanagedCallersOnlyAttribute" + ] |> List.choose (Option.map (fun x -> x.TyconRef)) override x.ToString() = "" member _.ilg=ilg @@ -1224,10 +1230,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member val attrib_CallerFilePathAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" member val attrib_CallerMemberNameAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" member val attrib_SkipLocalsInitAttribute = findSysAttrib "System.Runtime.CompilerServices.SkipLocalsInitAttribute" - member val attribs_Unsupported = [ - tryFindSysAttrib "System.Runtime.CompilerServices.ModuleInitializerAttribute" - tryFindSysAttrib "System.Runtime.CompilerServices.CallerArgumentExpressionAttribute" - ] |> List.choose (Option.map (fun x -> x.TyconRef)) + member val attribs_Unsupported = v_attribs_Unsupported member val attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" member val attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" From a847a717b8509b65f853cf67a39b8b5e6f2256f2 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 23 Nov 2021 10:35:04 -0800 Subject: [PATCH 22/26] Added CI job for deterministic builds (#12335) * Added CI job for deterministic builds * Attempt to fix deterministic checks * Turn off rebuild * Update test-determinism.ps1 Co-authored-by: Vlad Zarytovskii --- azure-pipelines.yml | 25 +++ eng/test-determinism.cmd | 2 + eng/test-determinism.ps1 | 390 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 417 insertions(+) create mode 100644 eng/test-determinism.cmd create mode 100644 eng/test-determinism.ps1 diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 324707c2328..118e6891389 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -353,6 +353,31 @@ stages: - script: .\tests\EndToEndBuildTests\EndToEndBuildTests.cmd -c Release displayName: End to end build tests + # Determinism + - job: Determinism_Debug + pool: + name: NetCore1ESPool-Public + demands: ImageOverride -equals Build.Windows.Amd64.VS2022.Pre.Open + timeoutInMinutes: 90 + steps: + - checkout: none + - script: | + @echo on + git init + git remote add origin "$(Build.Repository.Uri)" + git fetch --progress --no-tags --depth=1 origin "$(Build.SourceVersion)" + git checkout "$(Build.SourceVersion)" + displayName: Shallow checkout + - script: .\eng\test-determinism.cmd -configuration Debug + displayName: Determinism tests with Debug configuration + - task: PublishPipelineArtifact@1 + displayName: Publish Determinism Logs + inputs: + targetPath: '$(Build.SourcesDirectory)/artifacts/log/Debug' + artifactName: 'Determinism_Debug Attempt $(System.JobAttempt) Logs' + continueOnError: true + condition: not(succeeded()) + # Up-to-date - disabled due to it being flaky #- job: UpToDate_Windows # pool: diff --git a/eng/test-determinism.cmd b/eng/test-determinism.cmd new file mode 100644 index 00000000000..863e8bd5ca3 --- /dev/null +++ b/eng/test-determinism.cmd @@ -0,0 +1,2 @@ +@echo off +powershell -noprofile -executionPolicy RemoteSigned -file "%~dp0\test-determinism.ps1" %* \ No newline at end of file diff --git a/eng/test-determinism.ps1 b/eng/test-determinism.ps1 new file mode 100644 index 00000000000..45b0cc396fb --- /dev/null +++ b/eng/test-determinism.ps1 @@ -0,0 +1,390 @@ +[CmdletBinding(PositionalBinding = $false)] +param([string]$configuration = "Debug", + [string]$msbuildEngine = "vs", + [string]$altRootDrive = "q:", + [switch]$help, + [switch]$norestore, + [switch]$rebuild) + +Set-StrictMode -version 2.0 +$ErrorActionPreference = "Stop" + +function Print-Usage() { + Write-Host "Usage: test-determinism.ps1" + Write-Host " -configuration Build configuration ('Debug' or 'Release')" + Write-Host " -msbuildEngine Msbuild engine to use to run build ('dotnet', 'vs', or unspecified)." + Write-Host " -bootstrapDir Directory containing the bootstrap compiler" + Write-Host " -altRootDrive The drive we build on (via subst) for verifying pathmap implementation" +} + +if ($help) { + Print-Usage + exit 0 +} + +# List of binary names that should be skipped because they have a known issue that +# makes them non-deterministic. +$script:skipList = @() +function Run-Build([string]$rootDir, [string]$logFileName) { + + # Clean out the previous run + Write-Host "Cleaning binaries in $rootDir" + $binDir = Get-BinDir $rootDir + $objDir = Get-ObjDir $rootDir + $stopWatch = [System.Diagnostics.StopWatch]::StartNew() + Write-Host "Cleaning binaries in $binDir" + Remove-Item -Recurse $binDir -ErrorAction SilentlyContinue + Write-Host "Cleaning binaries in $objDir" + Remove-Item -Recurse $objDir -ErrorAction SilentlyContinue + $stopWatch.Stop() + Write-Host "Cleaning took $($stopWatch.Elapsed)" + + $solution = Join-Path $rootDir "FSharp.sln" + + if ($logFileName -eq "") { + $logFileName = [IO.Path]::GetFileNameWithoutExtension($projectFilePath) + } + $logFileName = [IO.Path]::ChangeExtension($logFileName, ".binlog") + $logFilePath = Join-Path $LogDir $logFileName + + Stop-Processes + + Write-Host "Building $solution using $bootstrapDir" + MSBuild $toolsetBuildProj ` + /p:Configuration=$configuration ` + /p:Projects=$solution ` + /p:RepoRoot=$rootDir ` + /p:Restore=true ` + /p:Build=true ` + /p:Rebuild=false ` + /p:Pack=false ` + /p:Sign=false ` + /p:Publish=false ` + /p:ContinuousIntegrationBuild=false ` + /p:OfficialBuildId="" ` + /p:QuietRestore=false ` + /p:DotNetBuildFromSource=false ` + /p:Deterministic=true ` + /p:DebugDeterminism=true ` + /p:Features="debug-determinism" ` + /p:DeployExtension=false ` + /p:BootstrapBuildPath=$bootstrapDir ` + /p:RunAnalyzers=false ` + /p:RunAnalyzersDuringBuild=false ` + /bl:$logFilePath + + Stop-Processes +} + +function Get-ObjDir([string]$rootDir) { + return Join-Path $rootDir "artifacts\obj" +} + +function Get-BinDir([string]$rootDir) { + return Join-Path $rootDir "artifacts\bin" +} + +# Return all of the files that need to be processed for determinism under the given +# directory. +function Get-FilesToProcess([string]$rootDir) { + $objDir = Get-ObjDir $rootDir + foreach ($item in Get-ChildItem -re -in *.dll, *.exe, *.pdb, *.sourcelink.json $objDir) { + $filePath = $item.FullName + $fileName = Split-Path -leaf $filePath + $relativeDirectory = Split-Path -parent $filePath + $relativeDirectory = $relativeDirectory.Substring($objDir.Length) + $relativeDirectory = $relativeDirectory.TrimStart("\") + + if ($skipList.Contains($fileName)) { + continue; + } + + $fileId = $filePath.Substring($objDir.Length).Replace("\", ".").TrimStart(".") + $fileHash = (Get-FileHash $filePath -algorithm MD5).Hash + + $data = @{} + $data.Hash = $fileHash + $data.Content = [IO.File]::ReadAllBytes($filePath) + $data.FileId = $fileId + $data.FileName = $fileName + $data.FilePath = $filePath + $data.RelativeDirectory = $relativeDirectory + + $keyFilePath = $filePath + ".key" + $keyFileName = Split-Path -leaf $keyFilePath + if (Test-Path $keyFilePath) { + $data.KeyFileName = $keyFileName + $data.KeyFilePath = $keyFilePath + $data.KeyFileContent = [IO.File]::ReadAllBytes($keyFilePath) + } + else { + $data.KeyFileName = "" + $data.KeyFilePath = "" + $data.KeyFileContent = $null + } + + Write-Output $data + } +} + +# This will build up the map of all of the binaries and their respective hashes. +function Record-Binaries([string]$rootDir) { + $stopWatch = [System.Diagnostics.StopWatch]::StartNew() + Write-Host "Recording file hashes" + + $map = @{ } + foreach ($fileData in Get-FilesToProcess $rootDir) { + Write-Host "`t$($fileData.FileId) = $($fileData.Hash)" + $map[$fileData.FileId] = $fileData + } + $stopWatch.Stop() + Write-Host "Recording took $($stopWatch.Elapsed)" + return $map +} + +# This is a sanity check to ensure that we're actually putting the right entries into +# the core data map. Essentially to ensure things like if we change our directory layout +# that this test fails beacuse we didn't record the binaries we intended to record. +function Test-MapContents($dataMap) { + + # Sanity check to ensure we didn't return a false positive because we failed + # to examine any binaries. + if ($dataMap.Count -lt 40) { + throw "Didn't find the expected count of binaries" + } + + # Test for some well known binaries + $list = @( + "FSharp.Core.dll", + "FSharp.Compiler.Service.dll") + + foreach ($fileName in $list) { + $found = $false + foreach ($value in $dataMap.Values) { + if ($value.FileName -eq $fileName) { + $found = $true + break; + } + } + + if (-not $found) { + throw "Did not find the expected binary $fileName" + } + } +} + +function Test-Build([string]$rootDir, $dataMap, [string]$logFileName) { + Run-Build $rootDir -logFile $logFileName + + $errorList = @() + $allGood = $true + + Write-Host "Testing the binaries" + $stopWatch = [System.Diagnostics.StopWatch]::StartNew() + foreach ($fileData in Get-FilesToProcess $rootDir) { + $fileId = $fileData.FileId + $fileName = $fileData.FileName + $filePath = $fileData.FilePath + $relativeDir = $fileData.RelativeDirectory + + if (-not $dataMap.Contains($fileId)) { + Write-Host "ERROR! Missing entry in map $fileId->$filePath" + $allGood = $false + continue + } + + $oldfileData = $datamap[$fileId] + if ($fileData.Hash -ne $oldFileData.Hash) { + Write-Host "`tERROR! $relativeDir\$fileName contents don't match" + $allGood = $false + $errorList += $fileName + + $errorCurrentDirLeft = Join-Path $errorDirLeft $relativeDir + Create-Directory $errorCurrentDirLeft + $errorCurrentDirRight = Join-Path $errorDirRight $relativeDir + Create-Directory $errorCurrentDirRight + + # Save out the original and baseline for investigation + [IO.File]::WriteAllBytes((Join-Path $errorCurrentDirLeft $fileName), $oldFileData.Content) + Copy-Item $filePath (Join-Path $errorCurrentDirRight $fileName) + + # Copy the key files if available too + $keyFileName = $oldFileData.KeyFileName + if ($keyFileName -ne "") { + [IO.File]::WriteAllBytes((Join-Path $errorCurrentDirLeft $keyFileName), $oldFileData.KeyFileContent) + Copy-Item $fileData.KeyFilePath (Join-Path $errorCurrentDirRight $keyFileName) + } + + continue + } + + Write-Host "`tVerified $relativeDir\$fileName" + } + + if (-not $allGood) { + Write-Host "Determinism failed for the following binaries:" + foreach ($name in $errorList) { + Write-Host "`t$name" + } + + Write-Host "Archiving failure information" + $zipFile = Join-Path $LogDir "determinism.zip" + Add-Type -Assembly "System.IO.Compression.FileSystem"; + [System.IO.Compression.ZipFile]::CreateFromDirectory($script:errorDir, $zipFile, "Fastest", $true); + + Write-Host "Please send $zipFile to compiler team for analysis" + exit 1 + } + + $stopWatch.Stop() + Write-Host "Testing took $($stopWatch.Elapsed)" +} + +function Run-Test() { + # Run the initial build so that we can populate the maps + Run-Build $RepoRoot -logFileName "Initial" -useBootstrap + $dataMap = Record-Binaries $RepoRoot + Test-MapContents $dataMap + + # Run a test against the source in the same directory location + Test-Build -rootDir $RepoRoot -dataMap $dataMap -logFileName "test1" + + # Run another build in a different source location and verify that path mapping + # allows the build to be identical. To do this we'll copy the entire source + # tree under the artifacts\q directory and run a build from there. + # Write-Host "Building in a different directory" + # Exec-Command "subst" "$altRootDrive $(Split-Path -parent $RepoRoot)" + # try { + # $altRootDir = Join-Path "$($altRootDrive)\" (Split-Path -leaf $RepoRoot) + # Test-Build -rootDir $altRootDir -dataMap $dataMap -logFileName "test2" + # } + # finally { + # Exec-Command "subst" "$altRootDrive /d" + # } +} + +function Test-IsAdmin { + ([Security.Principal.WindowsPrincipal] [Security.Principal.WindowsIdentity]::GetCurrent()).IsInRole([Security.Principal.WindowsBuiltInRole] "Administrator") +} + +function TryDownloadDotnetFrameworkSdk() { + # If we are not running as admin user, don't bother grabbing ndp sdk -- since we don't need sn.exe + $isAdmin = Test-IsAdmin + Write-Host "TryDownloadDotnetFrameworkSdk -- Test-IsAdmin = '$isAdmin'" + if ($isAdmin -eq $true) { + # Get program files(x86) location + if ($null -eq ${env:ProgramFiles(x86)}) { + $programFiles = $env:ProgramFiles + } + else { + $programFiles = ${env:ProgramFiles(x86)} + } + + # Get windowsSDK location for x86 + $windowsSDK_ExecutablePath_x86 = $env:WindowsSDK_ExecutablePath_x86 + $newWindowsSDK_ExecutablePath_x86 = Join-Path "$programFiles" "Microsoft SDKs\Windows\v10.0A\bin\NETFX 4.8 Tools" + + if ($null -eq $windowsSDK_ExecutablePath_x86) { + $snPathX86 = Join-Path $newWindowsSDK_ExecutablePath_x86 "sn.exe" + } + else { + $snPathX86 = Join-Path $windowsSDK_ExecutablePath_x86 "sn.exe" + $snPathX86Exists = Test-Path $snPathX86 -PathType Leaf + if ($snPathX86Exists -ne $true) { + $windowsSDK_ExecutablePath_x86 = null + $snPathX86 = Join-Path $newWindowsSDK_ExecutablePath_x86 "sn.exe" + } + } + + $windowsSDK_ExecutablePath_x64 = $env:WindowsSDK_ExecutablePath_x64 + $newWindowsSDK_ExecutablePath_x64 = Join-Path "$programFiles" "Microsoft SDKs\Windows\v10.0A\bin\NETFX 4.8 Tools\x64" + + if ($null -eq $windowsSDK_ExecutablePath_x64) { + $snPathX64 = Join-Path $newWindowsSDK_ExecutablePath_x64 "sn.exe" + } + else { + $snPathX64 = Join-Path $windowsSDK_ExecutablePath_x64 "sn.exe" + $snPathX64Exists = Test-Path $snPathX64 -PathType Leaf + if ($snPathX64Exists -ne $true) { + $windowsSDK_ExecutablePath_x86 = null + $snPathX64 = Join-Path $newWindowsSDK_ExecutablePath_x64 "sn.exe" + } + } + + $snPathX86Exists = Test-Path $snPathX86 -PathType Leaf + Write-Host "pre-dl snPathX86Exists : $snPathX86Exists - '$snPathX86'" + if ($snPathX86Exists -ne $true) { + DownloadDotnetFrameworkSdk + } + + $snPathX86Exists = Test-Path $snPathX86 -PathType Leaf + if ($snPathX86Exists -eq $true) { + if ($windowsSDK_ExecutablePath_x86 -ne $newWindowsSDK_ExecutablePath_x86) { + $windowsSDK_ExecutablePath_x86 = $newWindowsSDK_ExecutablePath_x86 + # x86 environment variable + Write-Host "set WindowsSDK_ExecutablePath_x86=$WindowsSDK_ExecutablePath_x86" + [System.Environment]::SetEnvironmentVariable("WindowsSDK_ExecutablePath_x86", "$newWindowsSDK_ExecutablePath_x86", [System.EnvironmentVariableTarget]::Machine) + $env:WindowsSDK_ExecutablePath_x86 = $newWindowsSDK_ExecutablePath_x86 + } + } + + # Also update environment variable for x64 + $snPathX64Exists = Test-Path $snPathX64 -PathType Leaf + if ($snPathX64Exists -eq $true) { + if ($windowsSDK_ExecutablePath_x64 -ne $newWindowsSDK_ExecutablePath_x64) { + $windowsSDK_ExecutablePath_x64 = $newWindowsSDK_ExecutablePath_x64 + # x64 environment variable + Write-Host "set WindowsSDK_ExecutablePath_x64=$WindowsSDK_ExecutablePath_x64" + [System.Environment]::SetEnvironmentVariable("WindowsSDK_ExecutablePath_x64", "$newWindowsSDK_ExecutablePath_x64", [System.EnvironmentVariableTarget]::Machine) + $env:WindowsSDK_ExecutablePath_x64 = $newWindowsSDK_ExecutablePath_x64 + } + } + } +} + +try { + . (Join-Path $PSScriptRoot "build-utils.ps1") + + # Create all of the logging directories + $errorDir = Join-Path $LogDir "DeterminismFailures" + $errorDirLeft = Join-Path $errorDir "Left" + $errorDirRight = Join-Path $errorDir "Right" + + Create-Directory $LogDir + Create-Directory $errorDirLeft + Create-Directory $errorDirRight + + $ci = $true + $runAnalyzers = $false + $binaryLog = $true + $officialBuildId = "" + $nodeReuse = $false + $properties = @() + + $buildTool = InitializeBuildTool + $toolsetBuildProj = InitializeToolset + TryDownloadDotnetFrameworkSdk + + $dotnetPath = InitializeDotNetCli + $env:DOTNET_ROOT = "$dotnetPath" + Get-Item -Path Env: + + $script:bootstrap = $true + $script:bootstrapConfiguration = "Proto" + $script:bootstrapTfm = "net472" + + if ($script:msbuildEngine -eq "dotnet") { + $script.bootstrapTfm = "net5.0" + } + + $bootstrapDir = Make-BootstrapBuild + + Run-Test + exit 0 +} +catch { + Write-Host $_ + Write-Host $_.Exception + Write-Host $_.ScriptStackTrace + exit 1 +} From cd7847dd74afc0df77367f4e15bd4ddeb3026bf7 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 15 Nov 2021 13:55:57 -0800 Subject: [PATCH 23/26] Added service_slim --- .vscode/launch.json | 18 ++ fcs/build.sh | 4 + fcs/fcs-test/NuGet.config | 10 + fcs/fcs-test/Program.fs | 124 +++++++ fcs/fcs-test/ast_print.fs | 101 ++++++ fcs/fcs-test/fcs-test.fsproj | 26 ++ fcs/fcs-test/test_script.fsx | 8 + src/buildtools/buildtools.targets | 4 +- .../FSharp.Compiler.Service.fsproj | 1 + .../FSharp.Compiler.Service/service_slim.fs | 303 ++++++++++++++++++ src/fsharp/QuotationTranslator.fs | 2 + src/fsharp/service/FSharpCheckerResults.fsi | 36 +++ src/fsharp/symbols/Exprs.fs | 1 + 13 files changed, 636 insertions(+), 2 deletions(-) create mode 100644 .vscode/launch.json create mode 100644 fcs/build.sh create mode 100644 fcs/fcs-test/NuGet.config create mode 100644 fcs/fcs-test/Program.fs create mode 100644 fcs/fcs-test/ast_print.fs create mode 100644 fcs/fcs-test/fcs-test.fsproj create mode 100644 fcs/fcs-test/test_script.fsx create mode 100644 src/fsharp/FSharp.Compiler.Service/service_slim.fs diff --git a/.vscode/launch.json b/.vscode/launch.json new file mode 100644 index 00000000000..07809bfbc91 --- /dev/null +++ b/.vscode/launch.json @@ -0,0 +1,18 @@ +{ + // Use IntelliSense to learn about possible attributes. + // Hover to view descriptions of existing attributes. + // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 + "version": "0.2.0", + "configurations": [ + { + "name": ".NET Core Launch (console)", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-test/Debug/net6.0/fcs-test.dll", + "args": [], + "cwd": "${workspaceFolder}/fcs/fcs-test", + "console": "internalConsole", + "stopAtEntry": false + } + ] +} \ No newline at end of file diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 00000000000..d027a7f7acb --- /dev/null +++ b/fcs/build.sh @@ -0,0 +1,4 @@ +#!/usr/bin/env bash + +dotnet build -c Release src/buildtools/buildtools.proj +dotnet build -c Release src/fsharp/FSharp.Compiler.Service diff --git a/fcs/fcs-test/NuGet.config b/fcs/fcs-test/NuGet.config new file mode 100644 index 00000000000..273c7d2db75 --- /dev/null +++ b/fcs/fcs-test/NuGet.config @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/fcs/fcs-test/Program.fs b/fcs/fcs-test/Program.fs new file mode 100644 index 00000000000..83c6ab67ee2 --- /dev/null +++ b/fcs/fcs-test/Program.fs @@ -0,0 +1,124 @@ +open System.IO +open FSharp.Compiler +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.EditorServices + +let getProjectOptions (folder: string) (projectFile: string) = + let runProcess (workingDir: string) (exePath: string) (args: string) = + let psi = System.Diagnostics.ProcessStartInfo() + psi.FileName <- exePath + psi.WorkingDirectory <- workingDir + psi.RedirectStandardOutput <- false + psi.RedirectStandardError <- false + psi.Arguments <- args + psi.CreateNoWindow <- true + psi.UseShellExecute <- false + + use p = new System.Diagnostics.Process() + p.StartInfo <- psi + p.Start() |> ignore + p.WaitForExit() + + let exitCode = p.ExitCode + exitCode, () + + let runCmd exePath args = runProcess folder exePath (args |> String.concat " ") + let msbuildExec = Dotnet.ProjInfo.Inspect.dotnetMsbuild runCmd + let result = Dotnet.ProjInfo.Inspect.getProjectInfo ignore msbuildExec Dotnet.ProjInfo.Inspect.getFscArgs projectFile + match result with + | Ok (Dotnet.ProjInfo.Inspect.GetResult.FscArgs x) -> x + | _ -> [] + +let mkStandardProjectReferences () = + let projFile = "fcs-test.fsproj" + let projDir = __SOURCE_DIRECTORY__ + getProjectOptions projDir projFile + |> List.filter (fun s -> s.StartsWith("-r:")) + |> List.map (fun s -> s.Replace("-r:", "")) + +let mkProjectCommandLineArgsForScript (dllName, fileNames) = + [| yield "--simpleresolution" + yield "--noframework" + yield "--debug:full" + yield "--define:DEBUG" + yield "--optimize-" + yield "--out:" + dllName + yield "--doc:test.xml" + yield "--warn:3" + yield "--fullpaths" + yield "--flaterrors" + yield "--target:library" + for x in fileNames do + yield x + let references = mkStandardProjectReferences () + for r in references do + yield "-r:" + r + |] + +let getProjectOptionsFromCommandLineArgs(projName, argv): FSharpProjectOptions = + { ProjectFileName = projName + ProjectId = None + SourceFiles = [| |] + OtherOptions = argv + ReferencedProjects = [| |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = System.DateTime.MaxValue + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } + +let printAst title (projectResults: FSharpCheckProjectResults) = + let implFiles = projectResults.AssemblyContents.ImplementationFiles + let decls = implFiles + |> Seq.collect (fun file -> AstPrint.printFSharpDecls "" file.Declarations) + |> String.concat "\n" + printfn "%s Typed AST:" title + decls |> printfn "%s" + +[] +let main argv = + let projName = "Project.fsproj" + let fileName = "test_script.fsx" + let fileNames = [| fileName |] + let source = File.ReadAllText (fileName, System.Text.Encoding.UTF8) + let sources = [| source |] + + let dllName = Path.ChangeExtension(fileName, ".dll") + let args = mkProjectCommandLineArgsForScript (dllName, fileNames) + // for arg in args do printfn "%s" arg + + let projectOptions = getProjectOptionsFromCommandLineArgs (projName, args) + let checker = InteractiveChecker.Create(projectOptions) + + // parse and typecheck a project + let sourceReader _key = (1, lazy source) + let projectResults = checker.ParseAndCheckProject(projName, fileNames, sourceReader) + projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + printAst "ParseAndCheckProject" projectResults + + // or just parse and typecheck a file in project + let parseResults, typeCheckResults, projectResults = + checker.ParseAndCheckFileInProject(fileName, projName, fileNames, sources) + projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + + printAst "ParseAndCheckFileInProject" projectResults + + let inputLines = source.Split('\n') + + // Get tool tip at the specified location + let tip = typeCheckResults.GetToolTip(4, 7, inputLines.[3], ["foo"], Tokenization.FSharpTokenTag.IDENT) + (sprintf "%A" tip).Replace("\n","") |> printfn "\n---> ToolTip Text = %A" // should print "FSharpToolTipText [...]" + + // Get declarations (autocomplete) for msg + let partialName = { QualifyingIdents = []; PartialIdent = "msg"; EndColumn = 17; LastDotPos = None } + let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 6, inputLines.[5], partialName, (fun _ -> [])) + [ for item in decls.Items -> item.Name ] |> printfn "\n---> msg AutoComplete = %A" // should print string methods + + // Get declarations (autocomplete) for canvas + let partialName = { QualifyingIdents = []; PartialIdent = "canvas"; EndColumn = 10; LastDotPos = None } + let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 8, inputLines.[7], partialName, (fun _ -> [])) + [ for item in decls.Items -> item.Name ] |> printfn "\n---> canvas AutoComplete = %A" + + 0 diff --git a/fcs/fcs-test/ast_print.fs b/fcs/fcs-test/ast_print.fs new file mode 100644 index 00000000000..747860e55b3 --- /dev/null +++ b/fcs/fcs-test/ast_print.fs @@ -0,0 +1,101 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +module AstPrint + +open FSharp.Compiler.Symbols + +//------------------------------------------------------------------------- +// AstPrint +//------------------------------------------------------------------------- + +let attribsOfSymbol (s: FSharpSymbol) = + [ match s with + | :? FSharpField as v -> + yield "field" + if v.IsCompilerGenerated then yield "compgen" + if v.IsDefaultValue then yield "default" + if v.IsMutable then yield "mutable" + if v.IsVolatile then yield "volatile" + if v.IsStatic then yield "static" + if v.IsLiteral then yield sprintf "%A" v.LiteralValue.Value + + | :? FSharpEntity as v -> + v.TryFullName |> ignore // check there is no failure here + match v.BaseType with + | Some t when t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome -> + yield sprintf "inherits %s" t.TypeDefinition.FullName + | _ -> () + if v.IsNamespace then yield "namespace" + if v.IsFSharpModule then yield "module" + if v.IsByRef then yield "byref" + if v.IsClass then yield "class" + if v.IsDelegate then yield "delegate" + if v.IsEnum then yield "enum" + if v.IsFSharpAbbreviation then yield "abbrev" + if v.IsFSharpExceptionDeclaration then yield "exception" + if v.IsFSharpRecord then yield "record" + if v.IsFSharpUnion then yield "union" + if v.IsInterface then yield "interface" + if v.IsMeasure then yield "measure" +#if !NO_EXTENSIONTYPING + if v.IsProvided then yield "provided" + if v.IsStaticInstantiation then yield "static_inst" + if v.IsProvidedAndErased then yield "erased" + if v.IsProvidedAndGenerated then yield "generated" +#endif + if v.IsUnresolved then yield "unresolved" + if v.IsValueType then yield "valuetype" + + | :? FSharpMemberOrFunctionOrValue as v -> + yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "" + if v.IsActivePattern then yield "active_pattern" + if v.IsDispatchSlot then yield "dispatch_slot" + if v.IsModuleValueOrMember && not v.IsMember then yield "val" + if v.IsMember then yield "member" + if v.IsProperty then yield "property" + if v.IsExtensionMember then yield "extension_member" + if v.IsPropertyGetterMethod then yield "property_getter" + if v.IsPropertySetterMethod then yield "property_setter" + if v.IsEvent then yield "event" + if v.EventForFSharpProperty.IsSome then yield "property_event" + if v.IsEventAddMethod then yield "event_add" + if v.IsEventRemoveMethod then yield "event_remove" + if v.IsTypeFunction then yield "type_func" + if v.IsCompilerGenerated then yield "compiler_gen" + if v.IsImplicitConstructor then yield "implicit_ctor" + if v.IsMutable then yield "mutable" + if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl" + if not v.IsInstanceMember then yield "static" + if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky" + if v.IsExplicitInterfaceImplementation then yield "interface_impl" + yield sprintf "%A" v.InlineAnnotation + // if v.IsConstructorThisValue then yield "ctorthis" + // if v.IsMemberThisValue then yield "this" + // if v.LiteralValue.IsSome then yield "literal" + | _ -> () ] + +let rec printFSharpDecls prefix decls = seq { + let mutable i = 0 + for decl in decls do + i <- i + 1 + match decl with + | FSharpImplementationFileDeclaration.Entity (e, sub) -> + yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e) + if not (Seq.isEmpty e.Attributes) then + yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes) + if not (Seq.isEmpty e.DeclaredInterfaces) then + yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces) + yield "" + yield! printFSharpDecls (prefix + "\t") sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) -> + yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth) + yield sprintf "%stype: %A" prefix meth.FullType + yield sprintf "%sargs: %A" prefix args + // if not meth.IsCompilerGenerated then + yield sprintf "%sbody: %A" prefix body + yield "" + | FSharpImplementationFileDeclaration.InitAction (expr) -> + yield sprintf "%s%i) ACTION" prefix i + yield sprintf "%s%A" prefix expr + yield "" +} diff --git a/fcs/fcs-test/fcs-test.fsproj b/fcs/fcs-test/fcs-test.fsproj new file mode 100644 index 00000000000..72ab6dba64e --- /dev/null +++ b/fcs/fcs-test/fcs-test.fsproj @@ -0,0 +1,26 @@ + + + + Exe + net6.0 + true + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-test/test_script.fsx b/fcs/fcs-test/test_script.fsx new file mode 100644 index 00000000000..1bbe729ab75 --- /dev/null +++ b/fcs/fcs-test/test_script.fsx @@ -0,0 +1,8 @@ +open System +open Fable.Import + +let foo() = + let msg = String.Concat("Hello"," ","world") + let len = msg.Length + let canvas = Browser.document.createElement_canvas () + canvas.width <- 1000. diff --git a/src/buildtools/buildtools.targets b/src/buildtools/buildtools.targets index 86346fc2a15..4cc7fe7a3a4 100644 --- a/src/buildtools/buildtools.targets +++ b/src/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net5.0\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net5.0\fsyacc.dll diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index ae388ec4d33..8519c4cd24e 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -978,6 +978,7 @@ Misc/LegacyHostedCompilerForTesting.fs + diff --git a/src/fsharp/FSharp.Compiler.Service/service_slim.fs b/src/fsharp/FSharp.Compiler.Service/service_slim.fs new file mode 100644 index 00000000000..ef29396dbe5 --- /dev/null +++ b/src/fsharp/FSharp.Compiler.Service/service_slim.fs @@ -0,0 +1,303 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +open System +open System.Collections.Concurrent +open System.IO +open System.Threading + +open Internal.Utilities.Collections +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras +open FSharp.Compiler +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.CheckExpressions +open FSharp.Compiler.CheckDeclarations +open FSharp.Compiler.CompilerConfig +open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.CompilerGlobalState +open FSharp.Compiler.CompilerImports +open FSharp.Compiler.CompilerOptions +open FSharp.Compiler.DependencyManager +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Driver +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.ScriptClosure +open FSharp.Compiler.Symbols +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Range +open FSharp.Compiler.Tokenization +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps + +//------------------------------------------------------------------------- +// InteractiveChecker +//------------------------------------------------------------------------- + +type internal TcResult = TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType +type internal TcErrors = FSharpDiagnostic[] + +type internal CompilerState = { + tcConfig: TcConfig + tcGlobals: TcGlobals + tcImports: TcImports + tcInitialState: TcState + projectOptions: FSharpProjectOptions + parseCache: ConcurrentDictionary + checkCache: ConcurrentDictionary +} + +// Cache to store current compiler state. +// In the case of type provider invalidation, +// compiler state needs to be reset to recognize TP changes. +type internal CompilerStateCache(projectOptions: FSharpProjectOptions) as this = + + let initializeCompilerState() = + let tcConfig = + let tcConfigB = + TcConfigBuilder.CreateNew(SimulatedMSBuildReferenceResolver.getResolver(), + defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, + reduceMemoryUsage=ReduceMemoryFlag.Yes, + implicitIncludeDir=Path.GetDirectoryName(projectOptions.ProjectFileName), + isInteractive=false, + isInvalidationSupported=true, + defaultCopyFSharpCore=CopyFSharpCoreFlag.No, + tryGetMetadataSnapshot=(fun _ -> None), + sdkDirOverride=None, + rangeForErrors=range0) + let sourceFiles = projectOptions.SourceFiles |> Array.toList + let argv = projectOptions.OtherOptions |> Array.toList + let _sourceFiles = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) + TcConfig.Create(tcConfigB, validate=false) + + let tcConfigP = TcConfigProvider.Constant(tcConfig) + + let ctok = CompilationThreadToken() + let dependencyProvider = new DependencyProvider() + let tcGlobals, tcImports = + TcImports.BuildTcImports (ctok, tcConfigP, dependencyProvider) + |> Cancellable.runWithoutCancellation + + // Handle type provider invalidation by resetting compiler state + tcImports.GetCcusExcludingBase() + |> Seq.iter (fun ccu -> + ccu.Deref.InvalidateEvent.Add(fun _ -> this.Reset()) + ) + + let niceNameGen = NiceNameGenerator() + let assemblyName = projectOptions.ProjectFileName |> Path.GetFileNameWithoutExtension + let tcInitialEnv = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitialEnv) + + // parse cache, keyed on file name and source hash + let parseCache = ConcurrentDictionary(HashIdentity.Structural) + // type check cache, keyed on file name + let checkCache = ConcurrentDictionary(HashIdentity.Structural) + + { + tcConfig = tcConfig + tcGlobals = tcGlobals + tcImports = tcImports + tcInitialState = tcInitialState + projectOptions = projectOptions + parseCache = parseCache + checkCache = checkCache + } + + // Lazily evaluated in case multiple TP invalidations are triggered before next compilation requested + let mutable compilerStateLazy = lazy initializeCompilerState() + let lockObj = obj() + + member x.Get() = + lock lockObj (fun () -> compilerStateLazy.Value) + member x.Reset() = + lock lockObj (fun () -> compilerStateLazy <- lazy initializeCompilerState()) + +[] +module internal ParseAndCheck = + + let userOpName = "Unknown" + let suggestNamesForErrors = true + + let MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpDiagnostic[], + symbolUses: TcSymbolUses list, topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option, + compilerState) = + let assemblyRef = mkSimpleAssemblyRef "stdin" + let assemblyDataOpt = None + let access = tcState.TcEnvFromImpls.AccessRights + let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat + let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, + assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) + let keepAssemblyContents = true + FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) + + let ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions, compilerState) = + let fileIndex = parsingOptions.SourceFiles |> Array.findIndex ((=) fileName) + let filesAbove = parsingOptions.SourceFiles |> Array.take fileIndex + // backup all cached typecheck entries above file + let cachedAbove = filesAbove |> Array.choose (fun key -> + match compilerState.checkCache.TryGetValue(key) with + | true, value -> Some (key, value) + | false, _ -> None) + // remove all parse cache entries with the same file name + let staleParseKeys = compilerState.parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray + staleParseKeys |> Array.iter (fun key -> compilerState.parseCache.TryRemove(key) |> ignore) + compilerState.checkCache.Clear(); // clear all typecheck cache + // restore all cached typecheck entries above file + cachedAbove |> Array.iter (fun (key, value) -> compilerState.checkCache.TryAdd(key, value) |> ignore) + + let ParseFile (fileName: string, sourceHash: int, source: Lazy, parsingOptions: FSharpParsingOptions, compilerState) = + let parseCacheKey = fileName, sourceHash + compilerState.parseCache.GetOrAdd(parseCacheKey, fun _ -> + ClearStaleCache(fileName, parsingOptions, compilerState) + let sourceText = SourceText.ofString source.Value + let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors) + let dependencyFiles = [||] // interactions have no dependencies + FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) + + let TypeCheckOneInput (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let input = parseResults.ParseTree + let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", compilerState.tcConfig.errorSeverityOptions) + let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) + use _errorScope = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) + + let checkForErrors () = parseResults.ParseHadErrors || errorLogger.ErrorCount > 0 + let prefixPathOpt = None + + let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict + let tcResult, tcState = + TypeCheckOneInputEventually (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + |> Eventually.force CancellationToken.None + |> function + | ValueOrCancelled.Value v -> v + | ValueOrCancelled.Cancelled ce -> raise ce // this condition is unexpected, since CancellationToken.None was passed + + let fileName = parseResults.FileName + let tcErrors = DiagnosticHelpers.CreateDiagnostics (compilerState.tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetDiagnostics()), suggestNamesForErrors) + (tcResult, tcErrors), (tcState, moduleNamesDict) + + let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let sink = TcResultsSinkImpl(compilerState.tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + TypeCheckOneInput (parseResults, tcSink, tcState, moduleNamesDict, compilerState) + let fileName = parseResults.FileName + compilerState.checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Diagnostics tcErrors + + let scope = TypeCheckInfo (compilerState.tcConfig, compilerState.tcGlobals, ccuSigForFile, tcState.Ccu, compilerState.tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) + + let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = + let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = + let checkCacheKey = parseRes.FileName + let typeCheckOneInput _fileName = + TypeCheckOneInput (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) + compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + let results, (tcState, moduleNamesDict) = + ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck + let tcResults, tcErrors = Array.unzip results + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState = + TypeCheckMultipleInputsFinish(tcResults |> Array.toList, tcState) + let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) + tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors + + /// Errors grouped by file, sorted by line, column + let ErrorsByFile (fileNames: string[], errorList: FSharpDiagnostic[] list) = + let errorMap = errorList |> Array.concat |> Array.groupBy (fun x -> x.FileName) |> Map.ofArray + let errors = fileNames |> Array.choose errorMap.TryFind + errors |> Array.iter (Array.sortInPlaceBy (fun x -> x.StartLine, x.StartColumn)) + errors |> Array.concat + + +type InteractiveChecker internal (compilerStateCache) = + + static member Create(projectOptions: FSharpProjectOptions) = + InteractiveChecker(CompilerStateCache(projectOptions)) + + /// Clears parse and typecheck caches. + member _.ClearCache () = + let compilerState = compilerStateCache.Get() + compilerState.parseCache.Clear() + compilerState.checkCache.Clear() + + /// Parses and checks the whole project, good for compilers (Fable etc.) + /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). + /// Already parsed files will be cached so subsequent compilations will be faster. + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy) = + let compilerState = compilerStateCache.Get() + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseResults = fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState)) + + // type check files + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + + // make project results + let parseErrors = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrors = tcErrors |> Array.concat + let errors = ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) + let symbolUses = [] //TODO: + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles, compilerState) + + projectResults + + /// Parses and checks file in project, will compile and cache all the files up to this one + /// (if not already done before), or fetch them from cache. Returns partial project results, + /// up to and including the file requested. Returns parse and typecheck results containing + /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. + member _.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) = + let compilerState = compilerStateCache.Get() + // get files before file + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + let fileNamesBeforeFile = fileNames |> Array.take fileIndex + let sourcesBeforeFile = sources |> Array.take fileIndex + + // parse files before file + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile (fileName, source) = ParseFile (fileName, hash source, lazy source, parsingOptions, compilerState) + let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + + // parse and type check file + let parseFileResults = parseFile (fileName, sources.[fileIndex]) + let checkFileResults = CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict, compilerState) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = compilerState.checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = checkFileResults.Diagnostics + let errors = ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ]) + + // make partial project results + let parseResults = Array.append parseResults [| parseFileResults |] + let tcImplFiles = List.append tcImplFiles (Option.toList implFile) + let topAttrs = CombineTopAttrs topAttrsFile topAttrs + let symbolUses = [] //TODO: + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles, compilerState) + + parseFileResults, checkFileResults, projectResults diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index c383eac6f74..f4eb82da6a0 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -248,8 +248,10 @@ and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = let g = cenv.g if g.generateWitnesses && not env.suppressWitnesses then let witnessExprs = + try ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcVal g cenv.amap m tps tyargs |> CommitOperationResult + with _ -> [] let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> match arg with diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index a32176b61ee..221a7a7dbca 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -207,9 +207,45 @@ type public FSharpParsingOptions = static member internal FromTcConfigBuilder: tcConfigB: TcConfigBuilder * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions +[] +type internal TypeCheckInfo = + internal new : + _sTcConfig: TcConfig * + g: TcGlobals * + ccuSigForFile: ModuleOrNamespaceType * + thisCcu: CcuThunk * + tcImports: TcImports * + tcAccessRights: AccessorDomain * + projectFileName: string * + mainInputFileName: string * + projectOptions: FSharpProjectOptions * + sResolutions: TcResolutions * + sSymbolUses: TcSymbolUses * + sFallback: NameResolutionEnv * + loadClosure: LoadClosure option * + implFileOpt: TypedImplFile option * + openDeclarations: OpenDeclaration[] + -> TypeCheckInfo + member ScopeResolutions: TcResolutions + member ScopeSymbolUses: TcSymbolUses + member TcGlobals: TcGlobals + member TcImports: TcImports + member CcuSigForFile: ModuleOrNamespaceType + member ThisCcu: CcuThunk + member ImplementationFile: TypedImplFile option + /// A handle to the results of CheckFileInProject. [] type public FSharpCheckFileResults = + internal new : + filename: string * + errors: FSharpDiagnostic[] * + scopeOptX: TypeCheckInfo option * + dependencyFiles: string[] * + builderX: IncrementalBuilder option * + keepAssemblyContents: bool + -> FSharpCheckFileResults + /// The errors returned by parsing a source file. member Diagnostics: FSharpDiagnostic[] diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index 84da9a9be1f..728feaea6d2 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -506,6 +506,7 @@ module FSharpExprConvert = // let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) // in FSharp.Core. | ErrorResult _ when vref.LogicalName = "op_LeftShift" && tyargs.Length = 1 -> [] + | ErrorResult (warns, err) -> ReportWarnings (err::warns); [] // temporary, ignores the error | res -> CommitOperationResult res let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> From adcea0883d55eb5e5f43e637558e9b732fc101b9 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 15 Nov 2021 15:35:48 -0800 Subject: [PATCH 24/26] Async ParseAndCheckProject by Alfonso --- fcs/build.sh | 1 + .../FSharp.Compiler.Service/service_slim.fs | 207 ++++++++---------- 2 files changed, 96 insertions(+), 112 deletions(-) diff --git a/fcs/build.sh b/fcs/build.sh index d027a7f7acb..98855758986 100644 --- a/fcs/build.sh +++ b/fcs/build.sh @@ -2,3 +2,4 @@ dotnet build -c Release src/buildtools/buildtools.proj dotnet build -c Release src/fsharp/FSharp.Compiler.Service +#dotnet /usr/share/dotnet/sdk/5.0.402/MSBuild.dll /p:Configuration=Release /p:FscToolExe=fsc src/fsharp/FSharp.Compiler.Service/ diff --git a/src/fsharp/FSharp.Compiler.Service/service_slim.fs b/src/fsharp/FSharp.Compiler.Service/service_slim.fs index ef29396dbe5..ffeac9b08f4 100644 --- a/src/fsharp/FSharp.Compiler.Service/service_slim.fs +++ b/src/fsharp/FSharp.Compiler.Service/service_slim.fs @@ -38,6 +38,7 @@ open FSharp.Compiler.Tokenization open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.BuildGraph //------------------------------------------------------------------------- // InteractiveChecker @@ -56,12 +57,56 @@ type internal CompilerState = { checkCache: ConcurrentDictionary } -// Cache to store current compiler state. -// In the case of type provider invalidation, -// compiler state needs to be reset to recognize TP changes. -type internal CompilerStateCache(projectOptions: FSharpProjectOptions) as this = +type internal CacheMsg<'T> = + | Get of AsyncReplyChannel<'T> + | Reset + +type internal Cache<'T>(init: (unit -> unit) -> Async<'T>) = + let agent = + MailboxProcessor>.Start(fun agent -> + let rec loop cached = async { + match! agent.Receive() with + | Get channel -> + match cached with + | Some cached -> + channel.Reply(cached) + return! Some cached |> loop + | None -> + let reset() = agent.Post Reset + let! cached = init reset + channel.Reply cached + return! Some cached |> loop + | Reset -> + return! loop None + } + + loop None) + member _.Get() = agent.PostAndAsyncReply(Get) + member _.Reset() = agent.Post Reset - let initializeCompilerState() = +[] +module internal ParseAndCheck = + + let userOpName = "Unknown" + let suggestNamesForErrors = true + + let measureTime (f: unit -> 'a) = + let sw = Diagnostics.Stopwatch.StartNew() + let res = f() + sw.Stop() + res, sw.ElapsedMilliseconds + + let measureTimeAsync (f: unit -> Async<'a>) = async { + let sw = Diagnostics.Stopwatch.StartNew() + let! res = f() + sw.Stop() + return res, sw.ElapsedMilliseconds + } + + // Cache to store current compiler state. + // In the case of type provider invalidation, + // compiler state needs to be reset to recognize TP changes. + let initializeCompilerState projectOptions reset = async { let tcConfig = let tcConfigB = TcConfigBuilder.CreateNew(SimulatedMSBuildReferenceResolver.getResolver(), @@ -81,29 +126,28 @@ type internal CompilerStateCache(projectOptions: FSharpProjectOptions) as this = let tcConfigP = TcConfigProvider.Constant(tcConfig) - let ctok = CompilationThreadToken() let dependencyProvider = new DependencyProvider() - let tcGlobals, tcImports = - TcImports.BuildTcImports (ctok, tcConfigP, dependencyProvider) - |> Cancellable.runWithoutCancellation + let! tcGlobals, tcImports = + TcImports.BuildTcImports (tcConfigP, dependencyProvider) + |> Async.AwaitNodeCode // Handle type provider invalidation by resetting compiler state tcImports.GetCcusExcludingBase() |> Seq.iter (fun ccu -> - ccu.Deref.InvalidateEvent.Add(fun _ -> this.Reset()) + ccu.Deref.InvalidateEvent.Add(fun _ -> reset()) ) let niceNameGen = NiceNameGenerator() let assemblyName = projectOptions.ProjectFileName |> Path.GetFileNameWithoutExtension - let tcInitialEnv = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) - let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitialEnv) + let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitial, openDecls0) // parse cache, keyed on file name and source hash let parseCache = ConcurrentDictionary(HashIdentity.Structural) // type check cache, keyed on file name let checkCache = ConcurrentDictionary(HashIdentity.Structural) - { + return { tcConfig = tcConfig tcGlobals = tcGlobals tcImports = tcImports @@ -112,31 +156,16 @@ type internal CompilerStateCache(projectOptions: FSharpProjectOptions) as this = parseCache = parseCache checkCache = checkCache } - - // Lazily evaluated in case multiple TP invalidations are triggered before next compilation requested - let mutable compilerStateLazy = lazy initializeCompilerState() - let lockObj = obj() - - member x.Get() = - lock lockObj (fun () -> compilerStateLazy.Value) - member x.Reset() = - lock lockObj (fun () -> compilerStateLazy <- lazy initializeCompilerState()) - -[] -module internal ParseAndCheck = - - let userOpName = "Unknown" - let suggestNamesForErrors = true + } let MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpDiagnostic[], - symbolUses: TcSymbolUses list, topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option, + topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option, compilerState) = let assemblyRef = mkSimpleAssemblyRef "stdin" - let assemblyDataOpt = None let access = tcState.TcEnvFromImpls.AccessRights let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat - let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, - assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) + let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, (Choice2Of2 TcSymbolUses.Empty), topAttrsOpt, + assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) let keepAssemblyContents = true FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) @@ -164,7 +193,7 @@ module internal ParseAndCheck = let dependencyFiles = [||] // interactions have no dependencies FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) - let TypeCheckOneInput (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let TypeCheckOneInputEntry (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = let input = parseResults.ParseTree let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", compilerState.tcConfig.errorSeverityOptions) let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) @@ -175,47 +204,29 @@ module internal ParseAndCheck = let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict let tcResult, tcState = - TypeCheckOneInputEventually (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) - |> Eventually.force CancellationToken.None - |> function - | ValueOrCancelled.Value v -> v - | ValueOrCancelled.Cancelled ce -> raise ce // this condition is unexpected, since CancellationToken.None was passed + TypeCheckOneInput (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + |> Cancellable.runWithoutCancellation let fileName = parseResults.FileName let tcErrors = DiagnosticHelpers.CreateDiagnostics (compilerState.tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetDiagnostics()), suggestNamesForErrors) (tcResult, tcErrors), (tcState, moduleNamesDict) - let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = - let sink = TcResultsSinkImpl(compilerState.tcGlobals) - let tcSink = TcResultsSink.WithSink sink - let (tcResult, tcErrors), (tcState, moduleNamesDict) = - TypeCheckOneInput (parseResults, tcSink, tcState, moduleNamesDict, compilerState) - let fileName = parseResults.FileName - compilerState.checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) - - let loadClosure = None - let keepAssemblyContents = true - - let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult - let errors = Array.append parseResults.Diagnostics tcErrors - - let scope = TypeCheckInfo (compilerState.tcConfig, compilerState.tcGlobals, ccuSigForFile, tcState.Ccu, compilerState.tcImports, tcEnvAtEnd.AccessRights, - projectFileName, fileName, compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, - loadClosure, implFile, sink.GetOpenDeclarations()) - FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) - let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = let checkCacheKey = parseRes.FileName let typeCheckOneInput _fileName = - TypeCheckOneInput (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) + TypeCheckOneInputEntry (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + let results, (tcState, moduleNamesDict) = ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck + let tcResults, tcErrors = Array.unzip results let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState = TypeCheckMultipleInputsFinish(tcResults |> Array.toList, tcState) - let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) + + let tcState, declaredImpls, ccuContents = TypeCheckClosedInputSetFinish (implFiles, tcState) + tcState.Ccu.Deref.Contents <- ccuContents tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors /// Errors grouped by file, sorted by line, column @@ -229,75 +240,47 @@ module internal ParseAndCheck = type InteractiveChecker internal (compilerStateCache) = static member Create(projectOptions: FSharpProjectOptions) = - InteractiveChecker(CompilerStateCache(projectOptions)) + Cache(initializeCompilerState projectOptions) |> InteractiveChecker /// Clears parse and typecheck caches. - member _.ClearCache () = - let compilerState = compilerStateCache.Get() + member _.ClearCache () = async { + let! compilerState = compilerStateCache.Get() compilerState.parseCache.Clear() compilerState.checkCache.Clear() + } /// Parses and checks the whole project, good for compilers (Fable etc.) /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). /// Already parsed files will be cached so subsequent compilations will be faster. - member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy) = - let compilerState = compilerStateCache.Get() + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy, ?lastFile: string) = async { + let! compilerState = compilerStateCache.Get() // parse files let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) - let parseResults = fileNames |> Array.map (fun fileName -> - let sourceHash, source = sourceReader fileName - ParseFile(fileName, sourceHash, source, parsingOptions, compilerState)) + // We can paralellize this, but only in the first compilation because later it causes issues when invalidating the cache + let parseResults = // measureTime <| fun _ -> + let fileNames = + match lastFile with + | None -> fileNames + | Some fileName -> + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + fileNames |> Array.take (fileIndex + 1) + + fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState) + ) + // printfn "FCS: Parsing finished in %ims" ms // type check files - let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors = + let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors) = // measureTime <| fun _ -> TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + // printfn "FCS: Checking finished in %ims" ms // make project results let parseErrors = parseResults |> Array.collect (fun p -> p.Diagnostics) let typedErrors = tcErrors |> Array.concat let errors = ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) - let symbolUses = [] //TODO: - let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles, compilerState) - - projectResults - - /// Parses and checks file in project, will compile and cache all the files up to this one - /// (if not already done before), or fetch them from cache. Returns partial project results, - /// up to and including the file requested. Returns parse and typecheck results containing - /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. - member _.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) = - let compilerState = compilerStateCache.Get() - // get files before file - let fileIndex = fileNames |> Array.findIndex ((=) fileName) - let fileNamesBeforeFile = fileNames |> Array.take fileIndex - let sourcesBeforeFile = sources |> Array.take fileIndex - - // parse files before file - let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) - let parseFile (fileName, source) = ParseFile (fileName, hash source, lazy source, parsingOptions, compilerState) - let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile - - // type check files before file - let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = - TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, Some topAttrs, Some tcImplFiles, compilerState) - // parse and type check file - let parseFileResults = parseFile (fileName, sources.[fileIndex]) - let checkFileResults = CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict, compilerState) - let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = compilerState.checkCache.[fileName] - let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult - - // collect errors - let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Diagnostics) - let typedErrorsBefore = tcErrors |> Array.concat - let newErrors = checkFileResults.Diagnostics - let errors = ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ]) - - // make partial project results - let parseResults = Array.append parseResults [| parseFileResults |] - let tcImplFiles = List.append tcImplFiles (Option.toList implFile) - let topAttrs = CombineTopAttrs topAttrsFile topAttrs - let symbolUses = [] //TODO: - let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles, compilerState) - - parseFileResults, checkFileResults, projectResults + return projectResults + } From 760f583eee79962150dea90eae1cf460f428a3fc Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 15 Nov 2021 15:51:59 -0800 Subject: [PATCH 25/26] Added ParseAndCheckFileInProject --- fcs/fcs-test/Program.fs | 12 ++-- .../FSharp.Compiler.Service/service_slim.fs | 67 ++++++++++++++++++- 2 files changed, 72 insertions(+), 7 deletions(-) diff --git a/fcs/fcs-test/Program.fs b/fcs/fcs-test/Program.fs index 83c6ab67ee2..2cada0cbbd6 100644 --- a/fcs/fcs-test/Program.fs +++ b/fcs/fcs-test/Program.fs @@ -83,7 +83,6 @@ let main argv = let fileName = "test_script.fsx" let fileNames = [| fileName |] let source = File.ReadAllText (fileName, System.Text.Encoding.UTF8) - let sources = [| source |] let dllName = Path.ChangeExtension(fileName, ".dll") let args = mkProjectCommandLineArgsForScript (dllName, fileNames) @@ -91,16 +90,19 @@ let main argv = let projectOptions = getProjectOptionsFromCommandLineArgs (projName, args) let checker = InteractiveChecker.Create(projectOptions) + let sourceReader _fileName = (hash source, lazy source) // parse and typecheck a project - let sourceReader _key = (1, lazy source) - let projectResults = checker.ParseAndCheckProject(projName, fileNames, sourceReader) + let projectResults = + checker.ParseAndCheckProject(projName, fileNames, sourceReader) + |> Async.RunSynchronously projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) printAst "ParseAndCheckProject" projectResults // or just parse and typecheck a file in project - let parseResults, typeCheckResults, projectResults = - checker.ParseAndCheckFileInProject(fileName, projName, fileNames, sources) + let (parseResults, typeCheckResults, projectResults) = + checker.ParseAndCheckFileInProject(projName, fileNames, sourceReader, fileName) + |> Async.RunSynchronously projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) printAst "ParseAndCheckFileInProject" projectResults diff --git a/src/fsharp/FSharp.Compiler.Service/service_slim.fs b/src/fsharp/FSharp.Compiler.Service/service_slim.fs index ffeac9b08f4..b4159adc790 100644 --- a/src/fsharp/FSharp.Compiler.Service/service_slim.fs +++ b/src/fsharp/FSharp.Compiler.Service/service_slim.fs @@ -163,8 +163,9 @@ module internal ParseAndCheck = compilerState) = let assemblyRef = mkSimpleAssemblyRef "stdin" let access = tcState.TcEnvFromImpls.AccessRights + let symbolUses = Choice2Of2 TcSymbolUses.Empty let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat - let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, (Choice2Of2 TcSymbolUses.Empty), topAttrsOpt, + let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) let keepAssemblyContents = true FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) @@ -211,6 +212,25 @@ module internal ParseAndCheck = let tcErrors = DiagnosticHelpers.CreateDiagnostics (compilerState.tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetDiagnostics()), suggestNamesForErrors) (tcResult, tcErrors), (tcState, moduleNamesDict) + let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let sink = TcResultsSinkImpl(compilerState.tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + TypeCheckOneInputEntry (parseResults, tcSink, tcState, moduleNamesDict, compilerState) + let fileName = parseResults.FileName + compilerState.checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Diagnostics tcErrors + + let scope = TypeCheckInfo (compilerState.tcConfig, compilerState.tcGlobals, ccuSigForFile, tcState.Ccu, compilerState.tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) + let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = let checkCacheKey = parseRes.FileName @@ -252,7 +272,7 @@ type InteractiveChecker internal (compilerStateCache) = /// Parses and checks the whole project, good for compilers (Fable etc.) /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). /// Already parsed files will be cached so subsequent compilations will be faster. - member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy, ?lastFile: string) = async { + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, ?lastFile: string) = async { let! compilerState = compilerStateCache.Get() // parse files let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) @@ -284,3 +304,46 @@ type InteractiveChecker internal (compilerStateCache) = return projectResults } + + /// Parses and checks file in project, will compile and cache all the files up to this one + /// (if not already done before), or fetch them from cache. Returns partial project results, + /// up to and including the file requested. Returns parse and typecheck results containing + /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. + member _.ParseAndCheckFileInProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, fileName: string) = async { + let! compilerState = compilerStateCache.Get() + + // get files before file + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + let fileNamesBeforeFile = fileNames |> Array.take fileIndex + + // parse files before file + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile fileName = + let sourceHash, source = sourceReader fileName + ParseFile (fileName, sourceHash, source, parsingOptions, compilerState) + let parseResults = fileNamesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + + // parse and type check file + let parseFileResults = parseFile fileName + let checkFileResults = CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict, compilerState) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = compilerState.checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = checkFileResults.Diagnostics + let errors = ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ]) + + // make partial project results + let parseResults = Array.append parseResults [| parseFileResults |] + let tcImplFiles = List.append tcImplFiles (Option.toList implFile) + let topAttrs = CombineTopAttrs topAttrsFile topAttrs + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, Some topAttrs, Some tcImplFiles, compilerState) + + return (parseFileResults, checkFileResults, projectResults) + } From 2a497180fd9366531f89cf6d7dcf3447637c9d28 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Thu, 23 Dec 2021 23:59:13 +0900 Subject: [PATCH 26/26] Add Compile to service_slim and pub-sub pattern --- .../FSharp.Compiler.Service/service_slim.fs | 71 +++++++++++++++---- src/fsharp/fsc.fs | 17 +++++ src/fsharp/fsc.fsi | 13 ++++ src/fsharp/service/service.fsi | 6 ++ 4 files changed, 95 insertions(+), 12 deletions(-) diff --git a/src/fsharp/FSharp.Compiler.Service/service_slim.fs b/src/fsharp/FSharp.Compiler.Service/service_slim.fs index b4159adc790..2d6c2bc86a0 100644 --- a/src/fsharp/FSharp.Compiler.Service/service_slim.fs +++ b/src/fsharp/FSharp.Compiler.Service/service_slim.fs @@ -110,6 +110,9 @@ module internal ParseAndCheck = let tcConfig = let tcConfigB = TcConfigBuilder.CreateNew(SimulatedMSBuildReferenceResolver.getResolver(), + includewin32manifest=false, + framework=false, + portablePDB=false, defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, reduceMemoryUsage=ReduceMemoryFlag.Yes, implicitIncludeDir=Path.GetDirectoryName(projectOptions.ProjectFileName), @@ -231,12 +234,23 @@ module internal ParseAndCheck = loadClosure, implFile, sink.GetOpenDeclarations()) FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) - let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = + let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState, subscriber) = let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = let checkCacheKey = parseRes.FileName + let typeCheckOneInput _fileName = TypeCheckOneInputEntry (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) - compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + + let (result, errors), (tcState, moduleNamesDict) = compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + + let _, _, implFile, _ = result + match subscriber, implFile with + | Some subscriber, Some implFile -> + let cenv = SymbolEnv(compilerState.tcGlobals, tcState.Ccu, Some tcState.CcuSig, compilerState.tcImports) + FSharpImplementationFileContents(cenv, implFile) |> subscriber + | _ -> () + + (result, errors), (tcState, moduleNamesDict) let results, (tcState, moduleNamesDict) = ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck @@ -256,7 +270,6 @@ module internal ParseAndCheck = errors |> Array.iter (Array.sortInPlaceBy (fun x -> x.StartLine, x.StartColumn)) errors |> Array.concat - type InteractiveChecker internal (compilerStateCache) = static member Create(projectOptions: FSharpProjectOptions) = @@ -269,15 +282,46 @@ type InteractiveChecker internal (compilerStateCache) = compilerState.checkCache.Clear() } + member _.GetImportedAssemblies() = async { + let! compilerState = compilerStateCache.Get() + let tcImports = compilerState.tcImports + let tcGlobals = compilerState.tcGlobals + return + tcImports.GetImportedAssemblies() + |> List.map (fun x -> FSharpAssembly(tcGlobals, tcImports, x.FSharpViewOfMetadata)) + } + + /// Compile project to file. If project has already been type checked, + /// check results will be taken from the cache. + member _.Compile(fileNames: string[], sourceReader: string -> int * Lazy, outFile: string) = async { + let! compilerState = compilerStateCache.Get() + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseResults = fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState)) + + let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, _tcErrors) = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, None) + + let ctok = CompilationThreadToken() + let errors, errorLogger, _loggerProvider = CompileHelpers.mkCompilationErrorHandlers() + let exitCode = + CompileHelpers.tryCompile errorLogger (fun exiter -> + compileOfTypedAst (ctok, compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, + tcImplFiles, topAttrs, compilerState.tcConfig, outFile, errorLogger, exiter)) + + return errors.ToArray(), exitCode + } + /// Parses and checks the whole project, good for compilers (Fable etc.) /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). /// Already parsed files will be cached so subsequent compilations will be faster. - member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, ?lastFile: string) = async { + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, + ?lastFile: string, ?subscriber: FSharpImplementationFileContents -> unit) = async { let! compilerState = compilerStateCache.Get() // parse files let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) - // We can paralellize this, but only in the first compilation because later it causes issues when invalidating the cache - let parseResults = // measureTime <| fun _ -> + let parseResults = let fileNames = match lastFile with | None -> fileNames @@ -285,16 +329,19 @@ type InteractiveChecker internal (compilerStateCache) = let fileIndex = fileNames |> Array.findIndex ((=) fileName) fileNames |> Array.take (fileIndex + 1) - fileNames |> Array.map (fun fileName -> + let parseFile fileName = let sourceHash, source = sourceReader fileName ParseFile(fileName, sourceHash, source, parsingOptions, compilerState) - ) - // printfn "FCS: Parsing finished in %ims" ms + + // Don't parallelize if we have cached files, as it would create issues with invalidation + if compilerState.parseCache.Count = 0 then + fileNames |> Array.Parallel.map parseFile + else + fileNames |> Array.map parseFile // type check files let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors) = // measureTime <| fun _ -> - TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) - // printfn "FCS: Checking finished in %ims" ms + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, subscriber) // make project results let parseErrors = parseResults |> Array.collect (fun p -> p.Diagnostics) @@ -325,7 +372,7 @@ type InteractiveChecker internal (compilerStateCache) = // type check files before file let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = - TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, None) // parse and type check file let parseFileResults = parseFile fileName diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 54edda22d2e..aa7143e11b1 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -974,3 +974,20 @@ let compileOfAst |> main4 (tcImportsCapture, dynamicAssemblyCreator) |> main5 |> main6 dynamicAssemblyCreator + +let compileOfTypedAst + (ctok, tcGlobals, tcImports: TcImports, generatedCcu: CcuThunk, typedImplFiles, + topAttrs, tcConfig: TcConfig, outfile, errorLogger, exiter: Exiter) = + + let tcImportsCapture = None + let dynamicAssemblyCreator = None + let assemblyName = Path.GetFileNameWithoutExtension(outfile) + // Doubling here tcImports as frameworkTcImports, seems to work... + let frameworkTcImports = tcImports + + Args (ctok, tcGlobals, tcImports, frameworkTcImports, generatedCcu, typedImplFiles, topAttrs, tcConfig, outfile, None, assemblyName, errorLogger, exiter) + |> main2 + |> main3 + |> main4 (tcImportsCapture, dynamicAssemblyCreator) + |> main5 + |> main6 dynamicAssemblyCreator diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 8de6f416740..03c05b14dcf 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -55,6 +55,19 @@ val compileOfAst: dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit + val compileOfTypedAst: + ctok: CompilationThreadToken * + tcGlobals: TcGlobals * + tcImports: TcImports * + generatedCcu: TypedTree.CcuThunk * + typedImplFiles: TypedTree.TypedImplFile list * + topAttrs: CheckDeclarations.TopAttribs * + tcConfig: TcConfig * + outfile: string * + errorLogger: ErrorLogger * + exiter: Exiter + -> unit + /// Part of LegacyHostedCompilerForTesting type InProcErrorLoggerProvider = new : unit -> InProcErrorLoggerProvider diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index a841cdcbc3b..bc21b7b4f59 100644 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -14,6 +14,12 @@ open FSharp.Compiler.Symbols open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Tokenization +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Driver + +module internal CompileHelpers = + val mkCompilationErrorHandlers: unit -> ResizeArray * ErrorLogger * ErrorLoggerProvider + val tryCompile: ErrorLogger -> (Exiter -> unit) -> int /// Used to parse and check F# source code. []