From 65643c1e4bb6f59a3ddf14c96df9ed7039a0d5c4 Mon Sep 17 00:00:00 2001 From: dotnet bot Date: Tue, 12 Jul 2022 12:50:30 -0700 Subject: [PATCH] Merge main to release/dev17.4 (#13492) * ValRepInfoForDisplay added for improved quick info for functions defined in expressions * Update * Update QuickInfoTests.fs * Update QuickInfoTests.fs * Update * add identifier analysis script (#13486) * add identifier analysis script * add identifier analysis script * Update fantomas alpha 11 (#13481) Co-authored-by: Don Syme Co-authored-by: Peter Semkin Co-authored-by: Don Syme Co-authored-by: Florian Verdonck Co-authored-by: Petr Semkin --- .config/dotnet-tools.json | 2 +- src/Compiler/AbstractIL/il.fs | 62 ++-- src/Compiler/AbstractIL/ilnativeres.fs | 12 +- src/Compiler/AbstractIL/ilprint.fs | 60 ++-- src/Compiler/AbstractIL/ilread.fs | 81 +++--- src/Compiler/AbstractIL/ilreflect.fs | 57 ++-- src/Compiler/AbstractIL/ilsupp.fs | 6 +- src/Compiler/AbstractIL/ilsupp.fsi | 12 +- src/Compiler/AbstractIL/ilwritepdb.fs | 22 +- src/Compiler/AbstractIL/ilx.fs | 2 +- src/Compiler/AbstractIL/ilx.fsi | 2 +- src/Compiler/Checking/CheckExpressions.fs | 52 ++-- src/Compiler/Checking/CheckExpressions.fsi | 3 +- .../Checking/CheckIncrementalClasses.fs | 8 +- src/Compiler/Checking/NicePrint.fs | 3 +- src/Compiler/CodeGen/EraseClosures.fs | 16 +- src/Compiler/CodeGen/EraseUnions.fs | 17 +- src/Compiler/CodeGen/IlxGen.fs | 275 +++++++++++------- src/Compiler/Driver/CompilerConfig.fs | 26 +- src/Compiler/Driver/CompilerDiagnostics.fs | 13 +- src/Compiler/Driver/CompilerImports.fs | 29 +- src/Compiler/Driver/CompilerOptions.fs | 17 +- src/Compiler/Driver/CreateILModule.fs | 25 +- src/Compiler/Driver/FxResolver.fs | 24 +- src/Compiler/Driver/OptimizeInputs.fs | 6 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 3 +- src/Compiler/Driver/ScriptClosure.fs | 3 +- src/Compiler/Driver/StaticLinking.fs | 13 +- src/Compiler/Driver/XmlDocFileWriter.fs | 7 +- src/Compiler/Driver/fsc.fs | 40 ++- src/Compiler/Service/FSharpCheckerResults.fs | 24 +- .../Service/FSharpParseFileResults.fs | 13 +- src/Compiler/Service/ItemKey.fs | 8 +- .../Service/SemanticClassification.fs | 20 +- src/Compiler/Service/ServiceAnalysis.fs | 15 +- .../Service/ServiceInterfaceStubGenerator.fs | 34 ++- src/Compiler/Service/ServiceLexing.fs | 6 +- src/Compiler/Service/ServiceNavigation.fs | 8 +- .../Service/ServiceParamInfoLocations.fs | 12 +- src/Compiler/Service/ServiceParseTreeWalk.fs | 21 +- src/Compiler/Service/ServiceParsedInputOps.fs | 8 +- src/Compiler/Service/ServiceStructure.fs | 30 +- src/Compiler/Service/service.fs | 10 +- src/Compiler/SyntaxTree/LexHelpers.fs | 14 +- src/Compiler/SyntaxTree/ParseHelpers.fs | 2 +- src/Compiler/SyntaxTree/PrettyNaming.fs | 8 +- src/Compiler/SyntaxTree/XmlDoc.fs | 5 +- src/Compiler/TypedTree/TypedTree.fs | 19 ++ src/Compiler/TypedTree/TypedTree.fsi | 13 + src/Compiler/TypedTree/TypedTreeBasics.fs | 20 +- src/Compiler/TypedTree/TypedTreeBasics.fsi | 4 + src/Compiler/TypedTree/TypedTreeOps.fs | 3 +- src/Compiler/TypedTree/TypedTreePickle.fs | 1 + src/Compiler/Utilities/FileSystem.fs | 18 +- src/Compiler/Utilities/HashMultiMap.fs | 3 +- src/Compiler/Utilities/ImmutableArray.fs | 9 +- src/Compiler/Utilities/ResizeArray.fs | 13 +- src/Compiler/Utilities/illib.fs | 11 +- src/Compiler/Utilities/range.fs | 24 +- src/Compiler/Utilities/sformat.fs | 35 ++- src/FSharp.Build/FSharpEmbedResXSource.fs | 8 +- src/FSharp.Core/QueryExtensions.fs | 2 +- src/FSharp.Core/array.fs | 11 +- src/FSharp.Core/async.fs | 19 +- src/FSharp.Core/eventmodule.fs | 6 +- src/FSharp.Core/list.fs | 13 +- src/FSharp.Core/map.fs | 6 +- src/FSharp.Core/observable.fs | 20 +- src/FSharp.Core/quotations.fs | 8 +- src/FSharp.Core/reflect.fs | 30 +- src/FSharp.Core/seq.fs | 61 ++-- .../FSharp.DependencyManager.Utilities.fs | 4 +- src/fsc/fscmain.fs | 6 +- src/fsi/console.fs | 15 +- src/fsi/fsimain.fs | 6 +- tests/scripts/identifierAnalysisByType.fsx | 152 ++++++++++ .../tests/UnitTests/QuickInfoTests.fs | 41 +-- 77 files changed, 1147 insertions(+), 570 deletions(-) create mode 100644 tests/scripts/identifierAnalysisByType.fsx diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index b56be5549a4..98702f25d91 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -3,7 +3,7 @@ "isRoot": true, "tools": { "fantomas": { - "version": "5.0.0-alpha-008", + "version": "5.0.0-alpha-011", "commands": [ "fantomas" ] diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index ed951e0a03b..3600b0e2cf4 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -25,7 +25,9 @@ open Internal.Utilities let logging = false -let _ = if logging then dprintn "* warning: Il.logging is on" +let _ = + if logging then + dprintn "* warning: Il.logging is on" let int_order = LanguagePrimitives.FastGenericComparer @@ -68,11 +70,13 @@ let memoizeNamespaceRightTable = let memoizeNamespacePartTable = ConcurrentDictionary() let splitNameAt (nm: string) idx = - if idx < 0 then failwith "splitNameAt: idx < 0" + if idx < 0 then + failwith "splitNameAt: idx < 0" let last = nm.Length - 1 - if idx > last then failwith "splitNameAt: idx > last" + if idx > last then + failwith "splitNameAt: idx > last" (nm.Substring(0, idx)), (if idx < last then nm.Substring(idx + 1, last - idx) else "") @@ -551,7 +555,8 @@ type ILAssemblyRef(data) = addC (convDigit (int32 v / 16)) addC (convDigit (int32 v % 16)) // retargetable can be true only for system assemblies that definitely have Version - if aref.Retargetable then add ", Retargetable=Yes" + if aref.Retargetable then + add ", Retargetable=Yes" b.ToString() @@ -2497,8 +2502,10 @@ let typeKindOfFlags nm (super: ILType option) flags = if name = "System.Enum" then ILTypeDefKind.Enum - elif (name = "System.Delegate" && nm <> "System.MulticastDelegate") - || name = "System.MulticastDelegate" then + elif + (name = "System.Delegate" && nm <> "System.MulticastDelegate") + || name = "System.MulticastDelegate" + then ILTypeDefKind.Delegate elif name = "System.ValueType" && nm <> "System.Enum" then ILTypeDefKind.ValueType @@ -3925,7 +3932,8 @@ let cdef_cctorCode2CodeOrCreate tag imports f (cd: ILTypeDef) = [| yield f cctor for md in mdefs do - if md.Name <> ".cctor" then yield md + if md.Name <> ".cctor" then + yield md |]) cd.With(methods = methods) @@ -4888,7 +4896,8 @@ type ILTypeSigParser(tstring: string) = // Does the type name start with a leading '['? If so, ignore it // (if the specialization type is in another module, it will be wrapped in bracket) - if here () = '[' then drop () + if here () = '[' then + drop () // 1. Iterate over beginning of type, grabbing the type name and determining if it's generic or an array let typeName = @@ -4947,8 +4956,11 @@ type ILTypeSigParser(tstring: string) = let scope = if (here () = ',' || here () = ' ') && (peek () <> '[' && peekN 2 <> '[') then let grabScopeComponent () = - if here () = ',' then drop () // ditch the ',' - if here () = ' ' then drop () // ditch the ' ' + if here () = ',' then + drop () // ditch the ',' + + if here () = ' ' then + drop () // ditch the ' ' while (peek () <> ',' && peek () <> ']' && peek () <> nil) do step () @@ -4969,8 +4981,11 @@ type ILTypeSigParser(tstring: string) = ILScopeRef.Local // strip any extraneous trailing brackets or commas - if (here () = ']') then drop () - if (here () = ',') then drop () + if (here () = ']') then + drop () + + if (here () = ',') then + drop () // build the IL type let tref = mkILTyRef (scope, typeName) @@ -5549,17 +5564,18 @@ let resolveILMethodRefWithRescope r (td: ILTypeDef) (mref: ILMethodRef) = let argTypes = mref.ArgTypes |> List.map r let retType: ILType = r mref.ReturnType - match possibles - |> List.filter (fun md -> - mref.CallingConv = md.CallingConv - && - // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct - (md.Parameters, argTypes) - ||> List.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) - && - // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct - r md.Return.Type = retType) - with + match + possibles + |> List.filter (fun md -> + mref.CallingConv = md.CallingConv + && + // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct + (md.Parameters, argTypes) + ||> List.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) + && + // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct + r md.Return.Type = retType) + with | [] -> failwith ( "no method named " diff --git a/src/Compiler/AbstractIL/ilnativeres.fs b/src/Compiler/AbstractIL/ilnativeres.fs index 3c0752ea8db..70846577d68 100644 --- a/src/Compiler/AbstractIL/ilnativeres.fs +++ b/src/Compiler/AbstractIL/ilnativeres.fs @@ -96,8 +96,10 @@ type CvtResFile() = reader.Read(pAdditional.data, 0, pAdditional.data.Length) |> ignore stream.Position <- stream.Position + 3L &&& ~~~ 3L - if pAdditional.pstringType.theString = Unchecked.defaultof<_> - && (pAdditional.pstringType.Ordinal = uint16 CvtResFile.RT_DLGINCLUDE) then + if + pAdditional.pstringType.theString = Unchecked.defaultof<_> + && (pAdditional.pstringType.Ordinal = uint16 CvtResFile.RT_DLGINCLUDE) + then () (* ERROR ContinueNotSupported *) else resourceNames.Add pAdditional @@ -454,7 +456,8 @@ type VersionHelper() = doBreak <- false () (* ERROR ContinueNotSupported *) (* ERROR BreakNotSupported *) - if not breakLoop then i <- i + 1 + if not breakLoop then + i <- i + 1 if hasWildcard then let mutable (i: int) = lastExplicitValue @@ -1149,7 +1152,8 @@ type NativeResourceWriter() = if id >= 0 then writer.WriteInt32 id else - if name = Unchecked.defaultof<_> then name <- String.Empty + if name = Unchecked.defaultof<_> then + name <- String.Empty writer.WriteUInt32(nameOffset ||| 0x80000000u) dataWriter.WriteUInt16(uint16 name.Length) diff --git a/src/Compiler/AbstractIL/ilprint.fs b/src/Compiler/AbstractIL/ilprint.fs index a9f95cbc1b0..1c777f278b9 100644 --- a/src/Compiler/AbstractIL/ilprint.fs +++ b/src/Compiler/AbstractIL/ilprint.fs @@ -661,16 +661,20 @@ let goutput_fdef _tref env os (fd: ILFieldDef) = output_member_access os fd.Access output_string os " " - if fd.IsStatic then output_string os " static " + if fd.IsStatic then + output_string os " static " - if fd.IsLiteral then output_string os " literal " + if fd.IsLiteral then + output_string os " literal " if fd.IsSpecialName then output_string os " specialname rtspecialname " - if fd.IsInitOnly then output_string os " initonly " + if fd.IsInitOnly then + output_string os " initonly " - if fd.NotSerialized then output_string os " notserialized " + if fd.NotSerialized then + output_string os " notserialized " goutput_typ env os fd.FieldType output_string os " " @@ -740,7 +744,8 @@ let output_code_label os lab = output_string os (formatCodeLabel lab) let goutput_local env os (l: ILLocal) = goutput_typ env os l.Type - if l.IsPinned then output_string os " pinned" + if l.IsPinned then + output_string os " pinned" let goutput_param env os (l: ILParameter) = match l.Name with @@ -985,7 +990,8 @@ let rec goutput_instr env os inst = let rank = shape.Rank output_parens (output_array ", " (goutput_typ env)) os (Array.create rank PrimaryAssemblyILGlobals.typ_Int32) | I_ldelema (ro, _, shape, tok) -> - if ro = ReadonlyAddress then output_string os "readonly. " + if ro = ReadonlyAddress then + output_string os "readonly. " if shape = ILArrayShape.SingleDimensional then output_string os "ldelema " @@ -1034,7 +1040,8 @@ let rec goutput_instr env os inst = | _ -> output_string os "" let goutput_ilmbody env os (il: ILMethodBody) = - if il.IsZeroInit then output_string os " .zeroinit\n" + if il.IsZeroInit then + output_string os " .zeroinit\n" output_string os " .maxstack " output_i32 os il.MaxStack @@ -1067,7 +1074,8 @@ let goutput_mbody is_entrypoint env os (md: ILMethodDef) = | MethodBody.IL il -> goutput_ilmbody env os il.Value | _ -> () - if is_entrypoint then output_string os " .entrypoint" + if is_entrypoint then + output_string os " .entrypoint" output_string os "\n" output_string os "}\n" @@ -1125,11 +1133,14 @@ let goutput_mdef env os (md: ILMethodDef) = let menv = ppenv_enter_method (List.length md.GenericParams) env output_string os " .method " - if md.IsHideBySig then output_string os "hidebysig " + if md.IsHideBySig then + output_string os "hidebysig " - if md.IsReqSecObj then output_string os "reqsecobj " + if md.IsReqSecObj then + output_string os "reqsecobj " - if md.IsSpecialName then output_string os "specialname " + if md.IsSpecialName then + output_string os "specialname " if md.IsUnmanagedExport then output_string os "unmanagedexp " @@ -1149,13 +1160,17 @@ let goutput_mdef env os (md: ILMethodDef) = (goutput_params menv) os md.Parameters output_string os " " - if md.IsSynchronized then output_string os "synchronized " + if md.IsSynchronized then + output_string os "synchronized " - if md.IsMustRun then output_string os "/* mustrun */ " + if md.IsMustRun then + output_string os "/* mustrun */ " - if md.IsPreserveSig then output_string os "preservesig " + if md.IsPreserveSig then + output_string os "preservesig " - if md.IsNoInline then output_string os "noinlining " + if md.IsNoInline then + output_string os "noinlining " if md.IsAggressiveInline then output_string os "aggressiveinlining " @@ -1255,13 +1270,17 @@ let rec goutput_tdef enc env contents os (cd: ILTypeDef) = output_string os layout_attr output_string os " " - if cd.IsSealed then output_string os "sealed " + if cd.IsSealed then + output_string os "sealed " - if cd.IsAbstract then output_string os "abstract " + if cd.IsAbstract then + output_string os "abstract " - if cd.IsSerializable then output_string os "serializable " + if cd.IsSerializable then + output_string os "serializable " - if cd.IsComInterop then output_string os "import " + if cd.IsComInterop then + output_string os "import " output_sqstring os cd.Name goutput_gparams env os cd.GenericParams @@ -1339,7 +1358,8 @@ let output_assemblyRef os (aref: ILAssemblyRef) = output_string os " .assembly extern " output_sqstring os aref.Name - if aref.Retargetable then output_string os " retargetable " + if aref.Retargetable then + output_string os " retargetable " output_string os " { " output_option output_hash os aref.Hash diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 3b536d891fd..6ec589b3115 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -1379,7 +1379,8 @@ let seekReadGuidIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadId let seekReadBlobIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadIdx ctxt.blobsBigness mdv &addr let seekReadModuleRow (ctxt: ILMetadataReader) mdv idx = - if idx = 0 then failwith "cannot read Module table row 0" + if idx = 0 then + failwith "cannot read Module table row 0" let mutable addr = ctxt.rowAddr TableNames.Module idx let generation = seekReadUInt16Adv mdv &addr @@ -1846,7 +1847,9 @@ let getDataEndPointsDelayed (pectxt: PEReader) ctxtH = |> List.sort let rvaToData (ctxt: ILMetadataReader) (pectxt: PEReader) nm rva = - if rva = 0x0 then failwith "rva is zero" + if rva = 0x0 then + failwith "rva is zero" + let start = pectxt.anyV2P (nm, rva) let endPoints = (Lazy.force ctxt.dataEndPoints) @@ -2565,7 +2568,8 @@ and sigptrGetTy (ctxt: ILMetadataReader) numTypars bytes sigptr = let ccByte, sigptr = sigptrGetByte bytes sigptr let generic, cc = byteAsCallConv ccByte - if generic then failwith "fptr sig may not be generic" + if generic then + failwith "fptr sig may not be generic" let struct (numparams, sigptr) = sigptrGetZInt32 bytes sigptr let retTy, sigptr = sigptrGetTy ctxt numTypars bytes sigptr @@ -3082,16 +3086,15 @@ and seekReadEvents (ctxt: ILMetadataReader) numTypars tidx = let mdv = ctxt.mdfile.GetView() match - seekReadOptionalIndexedRow - ( - ctxt.getNumRows TableNames.EventMap, - (fun i -> i, seekReadEventMapRow ctxt mdv i), - (fun (_, row) -> fst row), - compare tidx, - false, - (fun (i, row) -> (i, snd row)) - ) - with + seekReadOptionalIndexedRow ( + ctxt.getNumRows TableNames.EventMap, + (fun i -> i, seekReadEventMapRow ctxt mdv i), + (fun (_, row) -> fst row), + compare tidx, + false, + (fun (i, row) -> (i, snd row)) + ) + with | None -> [] | Some (rowNum, beginEventIdx) -> let endEventIdx = @@ -3150,16 +3153,15 @@ and seekReadProperties (ctxt: ILMetadataReader) numTypars tidx = let mdv = ctxt.mdfile.GetView() match - seekReadOptionalIndexedRow - ( - ctxt.getNumRows TableNames.PropertyMap, - (fun i -> i, seekReadPropertyMapRow ctxt mdv i), - (fun (_, row) -> fst row), - compare tidx, - false, - (fun (i, row) -> (i, snd row)) - ) - with + seekReadOptionalIndexedRow ( + ctxt.getNumRows TableNames.PropertyMap, + (fun i -> i, seekReadPropertyMapRow ctxt mdv i), + (fun (_, row) -> fst row), + compare tidx, + false, + (fun (i, row) -> (i, snd row)) + ) + with | None -> [] | Some (rowNum, beginPropIdx) -> let endPropIdx = @@ -3592,17 +3594,21 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numTypars (sz: int) start s curr <- curr + 4 (* REVIEW: this incorrectly labels all MemberRef tokens as ILMethod's: we should go look at the MemberRef sig to determine if it is a field or method *) let token_info = - if tab = TableNames.Method - || tab = TableNames.MemberRef (* REVIEW: generics or tab = TableNames.MethodSpec *) then + if + tab = TableNames.Method + || tab = TableNames.MemberRef (* REVIEW: generics or tab = TableNames.MethodSpec *) + then let (MethodData (enclTy, cc, nm, argTys, retTy, methInst)) = seekReadMethodDefOrRefNoVarargs ctxt numTypars (uncodedTokenToMethodDefOrRef (tab, idx)) ILToken.ILMethod(mkILMethSpecInTy (enclTy, cc, nm, argTys, retTy, methInst)) elif tab = TableNames.Field then ILToken.ILField(seekReadFieldDefAsFieldSpec ctxt idx) - elif tab = TableNames.TypeDef - || tab = TableNames.TypeRef - || tab = TableNames.TypeSpec then + elif + tab = TableNames.TypeDef + || tab = TableNames.TypeRef + || tab = TableNames.TypeSpec + then ILToken.ILType(seekReadTypeDefOrRef ctxt numTypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec (tab, idx))) else failwith "bad token for ldtoken" @@ -3680,7 +3686,8 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int let isFatFormat = (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_FatFormat if not isTinyFormat && not isFatFormat then - if logging then failwith "unknown format" + if logging then + failwith "unknown format" MethodBody.Abstract else @@ -3924,7 +3931,8 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int nextSectionBase <- sectionBase + sectionSize // Convert the linear code format to the nested code format - if logging then dprintn "doing localPdbInfos2" + if logging then + dprintn "doing localPdbInfos2" let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos @@ -3933,7 +3941,8 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int let code = buildILCode nm lab2pc instrs seh localPdbInfos2 - if logging then dprintn "done checking code." + if logging then + dprintn "done checking code." { IsZeroInit = initlocals @@ -4254,10 +4263,10 @@ let openMetadataReader | Some positions -> positions let tablesStreamPhysLoc, _tablesStreamSize = - match tryFindStream [| 0x23; 0x7e |] (* #~ *) with + match tryFindStream [| 0x23; 0x7e |] (* #~ *) with | Some res -> res | None -> - match tryFindStream [| 0x23; 0x2d |] (* #-: at least one DLL I've seen uses this! *) with + match tryFindStream [| 0x23; 0x2d |] (* #-: at least one DLL I've seen uses this! *) with | Some res -> res | None -> let firstStreamOffset = seekReadInt32 mdv (streamHeadersStart + 0) @@ -5073,8 +5082,10 @@ let stableFileHeuristicApplies fileName = let createByteFileChunk opts fileName chunk = // If we're trying to reduce memory usage then we are willing to go back and re-read the binary, so we can use // a weakly-held handle to an array of bytes. - if opts.reduceMemoryUsage = ReduceMemoryFlag.Yes - && stableFileHeuristicApplies fileName then + if + opts.reduceMemoryUsage = ReduceMemoryFlag.Yes + && stableFileHeuristicApplies fileName + then WeakByteFile(fileName, chunk) :> BinaryFile else let bytes = diff --git a/src/Compiler/AbstractIL/ilreflect.fs b/src/Compiler/AbstractIL/ilreflect.fs index 06e2fc67a35..2781d8a381a 100644 --- a/src/Compiler/AbstractIL/ilreflect.fs +++ b/src/Compiler/AbstractIL/ilreflect.fs @@ -638,11 +638,13 @@ let envUpdateCreatedTypeRef emEnv (tref: ILTypeRef) = // of objects. We use System.Runtime.Serialization.FormatterServices.GetUninitializedObject to do // the fake allocation - this creates an "empty" object, even if the object doesn't have // a constructor. It is not usable in partial trust code. - if runningOnMono - && ty.IsClass - && not ty.IsAbstract - && not ty.IsGenericType - && not ty.IsGenericTypeDefinition then + if + runningOnMono + && ty.IsClass + && not ty.IsAbstract + && not ty.IsGenericType + && not ty.IsGenericTypeDefinition + then try System.Runtime.Serialization.FormatterServices.GetUninitializedObject ty |> ignore @@ -972,7 +974,9 @@ let convFieldSpec cenv emEnv fspec = nonQueryableTypeGetField parentTI fieldB else // Prior type. - if typeIsNotQueryable parentTI then + if + typeIsNotQueryable parentTI + then let parentT = getTypeConstructor parentTI let fieldInfo = queryableTypeGetField emEnv parentT fref nonQueryableTypeGetField parentTI fieldInfo @@ -1009,10 +1013,12 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref: ILMethodRef) = | Some a -> if // obvious case - p.IsAssignableFrom a then + p.IsAssignableFrom a + then true elif - p.IsGenericType && a.IsGenericType + p.IsGenericType + && a.IsGenericType // non obvious due to contravariance: Action where T: IFoo accepts Action (for FooImpl: IFoo) && p.GetGenericTypeDefinition().IsAssignableFrom(a.GetGenericTypeDefinition()) then @@ -1124,8 +1130,10 @@ let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) : MethodInfo = queryableTypeGetMethodBySearch cenv emEnv parentT mref let nonQueryableTypeGetMethod (parentTI: Type) (methInfo: MethodInfo) : MethodInfo MaybeNull = - if (parentTI.IsGenericType - && not (equalTypes parentTI (getTypeConstructor parentTI))) then + if + (parentTI.IsGenericType + && not (equalTypes parentTI (getTypeConstructor parentTI))) + then TypeBuilder.GetMethod(parentTI, methInfo) else methInfo @@ -1141,7 +1149,9 @@ let convMethodRef cenv emEnv (parentTI: Type) (mref: ILMethodRef) = nonQueryableTypeGetMethod parentTI methB else // Prior type. - if typeIsNotQueryable parentTI then + if + typeIsNotQueryable parentTI + then let parentT = getTypeConstructor parentTI let methInfo = queryableTypeGetMethod cenv emEnv parentT mref nonQueryableTypeGetMethod parentTI methInfo @@ -1216,7 +1226,9 @@ let convConstructorSpec cenv emEnv (mspec: ILMethodSpec) = nonQueryableTypeGetConstructor parentTI consB else // Prior type. - if typeIsNotQueryable parentTI then + if + typeIsNotQueryable parentTI + then let parentT = getTypeConstructor parentTI let ctorG = queryableTypeGetConstructor cenv emEnv parentT mref nonQueryableTypeGetConstructor parentTI ctorG @@ -2134,9 +2146,11 @@ let buildFieldPass2 cenv tref (typB: TypeBuilder) emEnv (fdef: ILFieldDef) = match fdef.LiteralValue with | None -> emEnv | Some initial -> - if not fieldT.IsEnum - // it is ok to init fields with type = enum that are defined in other assemblies - || not fieldT.Assembly.IsDynamic then + if + not fieldT.IsEnum + // it is ok to init fields with type = enum that are defined in other assemblies + || not fieldT.Assembly.IsDynamic + then fieldB.SetConstant(initial.AsObject()) emEnv else @@ -2267,9 +2281,10 @@ let typeAttributesOfTypeLayout cenv emEnv x = if p.Size = None && p.Pack = None then None else - match cenv.tryFindSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", - cenv.tryFindSysILTypeRef "System.Runtime.InteropServices.LayoutKind" - with + match + cenv.tryFindSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", + cenv.tryFindSysILTypeRef "System.Runtime.InteropServices.LayoutKind" + with | Some tref1, Some tref2 -> Some( convCustomAttr @@ -2564,7 +2579,8 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t match emEnv.emTypMap.TryFind typeRef with | Some (_, tb, _, _) -> - if not (tb.IsCreated()) then tb.CreateTypeAndLog() |> ignore + if not (tb.IsCreated()) then + tb.CreateTypeAndLog() |> ignore tb.Assembly | None -> null) @@ -2590,7 +2606,8 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t traverseTypeRef tref let rec buildTypeDefPass4 (visited, created) nesting emEnv (tdef: ILTypeDef) = - if verbose2 then dprintf "buildTypeDefPass4 %s\n" tdef.Name + if verbose2 then + dprintf "buildTypeDefPass4 %s\n" tdef.Name let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) createTypeRef (visited, created) emEnv tref diff --git a/src/Compiler/AbstractIL/ilsupp.fs b/src/Compiler/AbstractIL/ilsupp.fs index 1db894b1801..fea9a764487 100644 --- a/src/Compiler/AbstractIL/ilsupp.fs +++ b/src/Compiler/AbstractIL/ilsupp.fs @@ -611,7 +611,8 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink let bNil = Bytes.zeroCreate 3 // Align remaining fields on DWORD (nb. poor bit twiddling code taken from ildasm's dres.cpp) - if (dwFiller &&& 0x1) <> 0 then SaveChunk(bNil, 2) + if (dwFiller &&& 0x1) <> 0 then + SaveChunk(bNil, 2) //---- Constant part of the header: DWORD, WORD, WORD, DWORD, DWORD SaveChunk(dwToBytes resHdr.DataVersion) @@ -627,7 +628,8 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink dwFiller <- dataEntry.Size &&& 0x3 - if dwFiller <> 0 then SaveChunk(bNil, 4 - dwFiller) + if dwFiller <> 0 then + SaveChunk(bNil, 4 - dwFiller) size diff --git a/src/Compiler/AbstractIL/ilsupp.fsi b/src/Compiler/AbstractIL/ilsupp.fsi index a7b9ddefcfe..e0aa2785471 100644 --- a/src/Compiler/AbstractIL/ilsupp.fsi +++ b/src/Compiler/AbstractIL/ilsupp.fsi @@ -48,14 +48,14 @@ type PdbDebugPoint = pdbSeqPointEndLine: int pdbSeqPointEndColumn: int } -val pdbReadOpen: string (* module *) -> string (* path *) -> PdbReader +val pdbReadOpen: string (* module *) -> string (* path *) -> PdbReader val pdbReadClose: PdbReader -> unit -val pdbReaderGetMethod: PdbReader -> int32 (* token *) -> PdbMethod -val pdbReaderGetMethodFromDocumentPosition: PdbReader -> PdbDocument -> int (* line *) -> int (* col *) -> PdbMethod +val pdbReaderGetMethod: PdbReader -> int32 (* token *) -> PdbMethod +val pdbReaderGetMethodFromDocumentPosition: PdbReader -> PdbDocument -> int (* line *) -> int (* col *) -> PdbMethod val pdbReaderGetDocuments: PdbReader -> PdbDocument array val pdbReaderGetDocument: - PdbReader -> string (* url *) -> byte (* guid *) [] -> byte (* guid *) [] -> byte (* guid *) [] -> PdbDocument + PdbReader -> string (* url *) -> byte (* guid *) [] -> byte (* guid *) [] -> byte (* guid *) [] -> PdbDocument val pdbDocumentGetURL: PdbDocument -> string val pdbDocumentGetType: PdbDocument -> byte (* guid *) [] @@ -72,7 +72,7 @@ val pdbScopeGetLocals: PdbMethodScope -> PdbVariable array val pdbVariableGetName: PdbVariable -> string val pdbVariableGetSignature: PdbVariable -> byte[] -val pdbVariableGetAddressAttributes: PdbVariable -> int32 (* kind *) * int32 (* addrField1 *) +val pdbVariableGetAddressAttributes: PdbVariable -> int32 (* kind *) * int32 (* addrField1 *) #endif #if !FX_NO_PDB_WRITER @@ -89,7 +89,7 @@ type idd = iddType: int32 iddData: byte[] } -val pdbInitialize: string (* .exe/.dll already written and closed *) -> string (* .pdb to write *) -> PdbWriter +val pdbInitialize: string (* .exe/.dll already written and closed *) -> string (* .pdb to write *) -> PdbWriter val pdbClose: PdbWriter -> string -> string -> unit val pdbCloseDocument: PdbDocumentWriter -> unit val pdbSetUserEntryPoint: PdbWriter -> int32 -> unit diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index c81cfc23ad3..55b23795bbc 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fs +++ b/src/Compiler/AbstractIL/ilwritepdb.fs @@ -751,10 +751,12 @@ type PortablePdbGenerator builder.WriteCompressedInteger offsetDelta // Check for hidden-sequence-point-record - if startLine = 0xfeefee - || endLine = 0xfeefee - || (startColumn = 0 && endColumn = 0) - || ((endLine - startLine) = 0 && (endColumn - startColumn) = 0) then + if + startLine = 0xfeefee + || endLine = 0xfeefee + || (startColumn = 0 && endColumn = 0) + || ((endLine - startLine) = 0 && (endColumn - startColumn) = 0) + then // Hidden-sequence-point-record builder.WriteCompressedInteger 0 builder.WriteCompressedInteger 0 @@ -1008,14 +1010,16 @@ let writePdbInfo showTimes outfile pdbfile info cvChunk = | Some p -> sco.StartOffset <> p.StartOffset || sco.EndOffset <> p.EndOffset | None -> true - if nested then pdbOpenScope pdbw sco.StartOffset + if nested then + pdbOpenScope pdbw sco.StartOffset sco.Locals |> Array.iter (fun v -> pdbDefineLocalVariable pdbw v.Name v.Signature v.Index) sco.Children |> Array.iter (writePdbScope (if nested then Some sco else parent)) - if nested then pdbCloseScope pdbw sco.EndOffset) + if nested then + pdbCloseScope pdbw sco.EndOffset) match minfo.RootScope with | None -> () @@ -1242,8 +1246,10 @@ and allNamesOfScopes acc (scopes: 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 + if + scope.Children + |> Array.forall (fun child -> child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) + then let children = scope.Children |> Array.sortWith scopeSorter diff --git a/src/Compiler/AbstractIL/ilx.fs b/src/Compiler/AbstractIL/ilx.fs index 6a7adab880b..4eb18649752 100644 --- a/src/Compiler/AbstractIL/ilx.fs +++ b/src/Compiler/AbstractIL/ilx.fs @@ -39,7 +39,7 @@ type IlxUnionHasHelpers = | SpecialFSharpListHelpers | SpecialFSharpOptionHelpers -type IlxUnionRef = IlxUnionRef of boxity: ILBoxity * ILTypeRef * IlxUnionCase[] * bool (* hasHelpers: *) * IlxUnionHasHelpers +type IlxUnionRef = IlxUnionRef of boxity: ILBoxity * ILTypeRef * IlxUnionCase[] * bool (* hasHelpers: *) * IlxUnionHasHelpers type IlxUnionSpec = | IlxUnionSpec of IlxUnionRef * ILGenericArgs diff --git a/src/Compiler/AbstractIL/ilx.fsi b/src/Compiler/AbstractIL/ilx.fsi index 901117867b7..a6a008434be 100644 --- a/src/Compiler/AbstractIL/ilx.fsi +++ b/src/Compiler/AbstractIL/ilx.fsi @@ -39,7 +39,7 @@ type IlxUnionRef = boxity: ILBoxity * ILTypeRef * IlxUnionCase[] * - bool (* IsNullPermitted *) * + bool (* IsNullPermitted *) * IlxUnionHasHelpers (* HasHelpers *) type IlxUnionSpec = diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 0de950283e7..d513a326a74 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -578,6 +578,7 @@ type ValScheme = id: Ident * typeScheme: GeneralizedType * valReprInfo: ValReprInfo option * + valReprInfoForDisplay: ValReprInfo option * memberInfo: PrelimMemberInfo option * isMutable: bool * inlineInfo: ValInline * @@ -1500,7 +1501,7 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec let g = cenv.g - let (ValScheme(id, typeScheme, valReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)) = vscheme + let (ValScheme(id, typeScheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)) = vscheme let ty = GeneralizedTypeForTypeScheme typeScheme @@ -1608,6 +1609,10 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec xmlDoc, isTopBinding, isExtrinsic, isIncrClass, isTyFunc, (hasDeclaredTypars || inSig), isGeneratedEventVal, konst, actualParent) + match valReprInfoForDisplay with + | Some info when not (ValReprInfo.IsEmpty info) -> + vspec.SetValReprInfoForDisplay valReprInfoForDisplay + | _ -> () CheckForAbnormalOperatorNames cenv id.idRange vspec.DisplayNameCoreMangled memberInfoOpt @@ -1641,10 +1646,11 @@ let MakeAndPublishVals cenv env (altActualParent, inSig, declKind, valRecInfo, v valSchemes Map.empty +/// Create a Val node for "base" in a class let MakeAndPublishBaseVal cenv env baseIdOpt ty = baseIdOpt |> Option.map (fun (id: Ident) -> - let valscheme = ValScheme(id, NonGenericTypeScheme ty, None, None, false, ValInline.Never, BaseVal, None, false, false, false, false) + let valscheme = ValScheme(id, NonGenericTypeScheme ty, None, None, None, false, ValInline.Never, BaseVal, None, false, false, false, false) MakeAndPublishVal cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valscheme, [], XmlDoc.Empty, None, false)) // Make the "delayed reference" value where the this pointer will reside after calling the base class constructor @@ -1657,7 +1663,7 @@ let MakeAndPublishSafeThisVal (cenv: cenv) env (thisIdOpt: Ident option) thisTy if not (isFSharpObjModelTy g thisTy) then errorR(Error(FSComp.SR.tcStructsCanOnlyBindThisAtMemberDeclaration(), thisId.idRange)) - let valScheme = ValScheme(thisId, NonGenericTypeScheme(mkRefCellTy g thisTy), None, None, false, ValInline.Never, CtorThisVal, None, false, false, false, false) + let valScheme = ValScheme(thisId, NonGenericTypeScheme(mkRefCellTy g thisTy), None, None, None, false, ValInline.Never, CtorThisVal, None, false, false, false, false) Some(MakeAndPublishVal cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valScheme, [], XmlDoc.Empty, None, false)) | None -> @@ -1742,11 +1748,11 @@ let ChooseCanonicalDeclaredTyparsAfterInference g denv declaredTypars m = declaredTypars let ChooseCanonicalValSchemeAfterInference g denv vscheme m = - let (ValScheme(id, typeScheme, arityInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)) = vscheme + let (ValScheme(id, typeScheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)) = vscheme let (GeneralizedType(generalizedTypars, ty)) = typeScheme let generalizedTypars = ChooseCanonicalDeclaredTyparsAfterInference g denv generalizedTypars m let typeScheme = GeneralizedType(generalizedTypars, ty) - let valscheme = ValScheme(id, typeScheme, arityInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars) + let valscheme = ValScheme(id, typeScheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars) valscheme let PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars = @@ -1817,10 +1823,11 @@ let ComputeIsTyFunc(id: Ident, hasDeclaredTypars, arityInfo: ValReprInfo option) | Some info -> info.NumCurriedArgs = 0) let UseSyntacticArity declKind typeScheme prelimValReprInfo = + let valReprInfo = InferGenericArityFromTyScheme typeScheme prelimValReprInfo if DeclKind.MustHaveArity declKind then - Some(InferGenericArityFromTyScheme typeScheme prelimValReprInfo) + Some valReprInfo, None else - None + None, Some valReprInfo /// Combine the results of InferSynValData and InferArityOfExpr. // @@ -1855,18 +1862,17 @@ let UseSyntacticArity declKind typeScheme prelimValReprInfo = // { new Base with // member x.M(v: unit) = () } // -let CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme = +let CombineSyntacticAndInferredArities g rhsExpr prelimScheme = let (PrelimVal2(_, typeScheme, partialValReprInfoOpt, memberInfoOpt, isMutable, _, _, ArgAndRetAttribs(argAttribs, retAttribs), _, _, _)) = prelimScheme - match partialValReprInfoOpt, DeclKind.MustHaveArity declKind with - | _, false -> None - | None, true -> Some(PrelimValReprInfo([], ValReprInfo.unnamedRetVal)) + match partialValReprInfoOpt with + | None -> Some(PrelimValReprInfo([], ValReprInfo.unnamedRetVal)) // Don't use any expression information for members, where syntax dictates the arity completely | _ when memberInfoOpt.IsSome -> partialValReprInfoOpt // Don't use any expression information for 'let' bindings where return attributes are present | _ when retAttribs.Length > 0 -> partialValReprInfoOpt - | Some partialValReprInfoFromSyntax, true -> + | Some partialValReprInfoFromSyntax -> let (PrelimValReprInfo(curriedArgInfosFromSyntax, retInfoFromSyntax)) = partialValReprInfoFromSyntax let partialArityInfo = if isMutable then @@ -1899,16 +1905,20 @@ let CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme = let BuildValScheme declKind partialArityInfoOpt prelimScheme = let (PrelimVal2(id, typeScheme, _, memberInfoOpt, isMutable, inlineFlag, baseOrThis, _, vis, isCompGen, hasDeclaredTypars)) = prelimScheme - let valReprInfo = + let valReprInfoOpt = + partialArityInfoOpt + |> Option.map (InferGenericArityFromTyScheme typeScheme) + + let valReprInfo, valReprInfoForDisplay = if DeclKind.MustHaveArity declKind then - Option.map (InferGenericArityFromTyScheme typeScheme) partialArityInfoOpt + valReprInfoOpt, None else - None + None, valReprInfoOpt let isTyFunc = ComputeIsTyFunc(id, hasDeclaredTypars, valReprInfo) - ValScheme(id, typeScheme, valReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, false, isTyFunc, hasDeclaredTypars) + ValScheme(id, typeScheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, false, isTyFunc, hasDeclaredTypars) let UseCombinedArity g declKind rhsExpr prelimScheme = - let partialArityInfoOpt = CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme + let partialArityInfoOpt = CombineSyntacticAndInferredArities g rhsExpr prelimScheme BuildValScheme declKind partialArityInfoOpt prelimScheme let UseNoArity prelimScheme = @@ -10229,7 +10239,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt | [] -> valSynData | {Range=mHead} :: _ -> let (SynValData(valMf, SynValInfo(args, SynArgInfo(attrs, opt, retId)), valId)) = valSynData - in SynValData(valMf, SynValInfo(args, SynArgInfo({Attributes=rotRetSynAttrs; Range=mHead} :: attrs, opt, retId)), valId) + SynValData(valMf, SynValInfo(args, SynArgInfo({Attributes=rotRetSynAttrs; Range=mHead} :: attrs, opt, retId)), valId) retAttribs, valAttribs, valSynData let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute valAttribs @@ -10779,7 +10789,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds // If the overall declaration is declaring statics or a module value, then force the patternInputTmp to also // have representation as module value. - if (DeclKind.MustHaveArity declKind) then + if DeclKind.MustHaveArity declKind then AdjustValToTopVal tmp altActualParent (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes tmp rhsExpr) tmp, checkedPat @@ -11355,9 +11365,9 @@ and AnalyzeAndMakeAndPublishRecursiveValue // NOTE: top arity, type and typars get fixed-up after inference let prelimTyscheme = GeneralizedType(enclosingDeclaredTypars@declaredTypars, ty) let prelimValReprInfo = TranslateSynValInfo mBinding (TcAttributes cenv envinner) valSynInfo - let valReprInfo = UseSyntacticArity declKind prelimTyscheme prelimValReprInfo + let valReprInfo, valReprInfoForDisplay = UseSyntacticArity declKind prelimTyscheme prelimValReprInfo let hasDeclaredTypars = not (List.isEmpty declaredTypars) - let prelimValScheme = ValScheme(bindingId, prelimTyscheme, valReprInfo, memberInfoOpt, false, inlineFlag, NormalVal, vis, false, false, false, hasDeclaredTypars) + let prelimValScheme = ValScheme(bindingId, prelimTyscheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, false, inlineFlag, NormalVal, vis, false, false, false, hasDeclaredTypars) // Check the literal r.h.s., if any let _, literalValue = TcLiteral cenv ty envinner tpenv (bindingAttribs, bindingExpr) diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 831a4cf9b20..8b5f1878532 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -584,12 +584,13 @@ type RecursiveBindingInfo = [] type CheckedBindingInfo -/// Represnts the results of the second phase of checking simple values +/// Represents the results of the second phase of checking simple values type ValScheme = | ValScheme of id: Ident * typeScheme: GeneralizedType * valReprInfo: ValReprInfo option * + valReprInfoForDisplay: ValReprInfo option * memberInfo: PrelimMemberInfo option * isMutable: bool * inlineInfo: ValInline * diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs index f4371e3c925..f225a9927e8 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fs +++ b/src/Compiler/Checking/CheckIncrementalClasses.fs @@ -133,7 +133,7 @@ let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attr let prelimTyschemeG = GeneralizedType(copyOfTyconTypars, ctorTy) let isComplete = ComputeIsComplete copyOfTyconTypars [] ctorTy let varReprInfo = InferGenericArityFromTyScheme prelimTyschemeG prelimValReprInfo - let ctorValScheme = ValScheme(id, prelimTyschemeG, Some varReprInfo, Some memberInfo, false, ValInline.Never, NormalVal, vis, false, true, false, false) + let ctorValScheme = ValScheme(id, prelimTyschemeG, Some varReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, vis, false, true, false, false) let paramNames = varReprInfo.ArgNames let xmlDoc = xmlDoc.ToXmlDoc(true, Some paramNames) let ctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValInRecScope isComplete, ctorValScheme, attribs, xmlDoc, None, false) @@ -154,7 +154,7 @@ let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attr let prelimValReprInfo = TranslateSynValInfo m (TcAttributes cenv env) valSynData let prelimTyschemeG = GeneralizedType(copyOfTyconTypars, cctorTy) let valReprInfo = InferGenericArityFromTyScheme prelimTyschemeG prelimValReprInfo - let cctorValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, Some memberInfo, false, ValInline.Never, NormalVal, Some (SynAccess.Private Range.Zero), false, true, false, false) + let cctorValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, Some (SynAccess.Private Range.Zero), false, true, false, false) let cctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValNotInRecScope, cctorValScheme, [(* no attributes*)], XmlDoc.Empty, None, false) cctorArgs, cctorVal, cctorValScheme @@ -162,7 +162,7 @@ let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attr let thisVal = // --- Create this for use inside constructor let thisId = ident ("this", m) - let thisValScheme = ValScheme(thisId, NonGenericTypeScheme thisTy, None, None, false, ValInline.Never, CtorThisVal, None, true, false, false, false) + let thisValScheme = ValScheme(thisId, NonGenericTypeScheme thisTy, None, None, None, false, ValInline.Never, CtorThisVal, None, true, false, false, false) let thisVal = MakeAndPublishVal cenv env (ParentNone, false, ClassLetBinding false, ValNotInRecScope, thisValScheme, [], XmlDoc.Empty, None, false) thisVal @@ -350,7 +350,7 @@ type IncrClassReprInfo = // NOTE: putting isCompilerGenerated=true here is strange. The method is not public, nor is // it a "member" in the F# sense, but the F# spec says it is generated and it is reasonable to reflect on it. - let memberValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, Some memberInfo, false, ValInline.Never, NormalVal, None, true (* isCompilerGenerated *), true (* isIncrClass *), false, false) + let memberValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, None, true (* isCompilerGenerated *), true (* isIncrClass *), false, false) let methodVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValNotInRecScope, memberValScheme, v.Attribs, XmlDoc.Empty, None, false) diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 3a398620de9..6d8b38c7956 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1270,7 +1270,8 @@ module PrintTastMemberOrVals = let layoutNonMemberVal denv (tps, v: Val, tau, cxs) = let env = SimplifyTypes.CollectInfo true [tau] cxs let cxs = env.postfixConstraints - let argInfos, retTy = GetTopTauTypeInFSharpForm denv.g (arityOfVal v).ArgInfos tau v.Range + let valReprInfo = arityOfValForDisplay v + let argInfos, retTy = GetTopTauTypeInFSharpForm denv.g valReprInfo.ArgInfos tau v.Range let nameL = let tagF = diff --git a/src/Compiler/CodeGen/EraseClosures.fs b/src/Compiler/CodeGen/EraseClosures.fs index 6f6646177a5..5ba6c4b50a0 100644 --- a/src/Compiler/CodeGen/EraseClosures.fs +++ b/src/Compiler/CodeGen/EraseClosures.fs @@ -500,9 +500,11 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = // nb. should combine the term and type abstraction cases for // to allow for term and type variables to be mixed in a single // application. - if (match laterStruct with - | Lambdas_return _ -> false - | _ -> true) then + if + (match laterStruct with + | Lambdas_return _ -> false + | _ -> true) + then let nowStruct = List.foldBack (fun x y -> Lambdas_forall(x, y)) tyargsl (Lambdas_return nowReturnTy) @@ -622,9 +624,11 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let nowReturnTy = mkTyOfLambdas cenv laterStruct // CASE 2a - Too Many Term Arguments or Remaining Type arguments - Split the Closure Class in Two - if (match laterStruct with - | Lambdas_return _ -> false - | _ -> true) then + if + (match laterStruct with + | Lambdas_return _ -> false + | _ -> true) + then let nowStruct = List.foldBack (fun l r -> Lambdas_lambda(l, r)) nowParams (Lambdas_return nowReturnTy) diff --git a/src/Compiler/CodeGen/EraseUnions.fs b/src/Compiler/CodeGen/EraseUnions.fs index 1e4b3c1f591..626ddd49758 100644 --- a/src/Compiler/CodeGen/EraseUnions.fs +++ b/src/Compiler/CodeGen/EraseUnions.fs @@ -76,7 +76,8 @@ type UnionReprDecisions<'Union, 'Alt, 'Type> if alts.Length = 1 then SingleCase elif - not (isStruct cu) && alts.Length < TaggingThresholdFixedConstant + not (isStruct cu) + && alts.Length < TaggingThresholdFixedConstant && not (repr.RepresentAllAlternativesAsConstantFieldsInRootClass cu) then RuntimeTypes @@ -1280,12 +1281,14 @@ let mkClassUnionDef ] let ctorMeths = - if (List.isEmpty selfFields - && List.isEmpty tagFieldsInObject - && not (List.isEmpty selfMeths)) - || isStruct - || cud.UnionCases - |> Array.forall (fun alt -> repr.RepresentAlternativeAsFreshInstancesOfRootClass(info, alt)) then + if + (List.isEmpty selfFields + && List.isEmpty tagFieldsInObject + && not (List.isEmpty selfMeths)) + || isStruct + || cud.UnionCases + |> Array.forall (fun alt -> repr.RepresentAlternativeAsFreshInstancesOfRootClass(info, alt)) + then [] (* no need for a second ctor in these cases *) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 1bf87805a0b..c39508fc595 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -210,7 +210,11 @@ let ReportStatistics (oc: TextWriter) = reports oc let NewCounter nm = let mutable count = 0 - AddReport(fun oc -> if count <> 0 then oc.WriteLine(string count + " " + nm)) + + AddReport(fun oc -> + if count <> 0 then + oc.WriteLine(string count + " " + nm)) + (fun () -> count <- count + 1) let CountClosure = NewCounter "closures" @@ -653,9 +657,11 @@ and GenNamedTyAppAux (cenv: cenv) m (tyenv: TypeReprEnv) ptrsOK tcref tinst = | _ -> let tinst = DropErasedTyargs tinst // See above note on ptrsOK - if ptrsOK = PtrTypesOK - && tyconRefEq g tcref g.nativeptr_tcr - && (freeInTypes CollectTypars tinst).FreeTypars.IsEmpty then + if + ptrsOK = PtrTypesOK + && tyconRefEq g tcref g.nativeptr_tcr + && (freeInTypes CollectTypars tinst).FreeTypars.IsEmpty + then GenNamedTyAppAux cenv m tyenv ptrsOK g.ilsigptr_tcr tinst else #if !NO_TYPEPROVIDERS @@ -1910,7 +1916,8 @@ type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = | Some (mdefDiscard, _) -> mdefDiscard ilMethodDef | None -> false - if not discard then gmethods.Add ilMethodDef + if not discard then + gmethods.Add ilMethodDef member _.NestedTypeDefs = gnested @@ -1924,7 +1931,8 @@ type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = | Some (_, pdefDiscard) -> pdefDiscard pdef | None -> false - if not discard then AddPropertyDefToHash m gproperties pdef + if not discard then + AddPropertyDefToHash m gproperties pdef member _.PrependInstructionsToSpecificMethodDef(cond, instrs, tag, imports) = match ResizeArray.tryFindIndex cond gmethods with @@ -2138,7 +2146,8 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu lmtyp ) - if isStruct then tycon.SetIsStructRecordOrUnion true + if isStruct then + tycon.SetIsStructRecordOrUnion true tycon.entity_tycon_repr <- TFSharpRecdRepr( @@ -2470,10 +2479,12 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs member private _.EnsureNopBetweenDebugPoints() = // Always add a nop between debug points to help .NET get the stepping right // Don't do this after a FeeFee marker for hidden code - if (codebuf.Count > 0 - && (match codebuf[codebuf.Count - 1] with - | I_seqpoint sm when sm.Line <> FeeFee mgbuf.cenv -> true - | _ -> false)) then + if + (codebuf.Count > 0 + && (match codebuf[codebuf.Count - 1] with + | I_seqpoint sm when sm.Line <> FeeFee mgbuf.cenv -> true + | _ -> false)) + then codebuf.Add(AI_nop) @@ -2599,11 +2610,13 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs let instrs = instrs |> Array.mapi (fun idx i2 -> - if idx = 0 - && (match i2 with - | AI_nop -> true - | _ -> false) - && anyDocument.IsSome then + if + idx = 0 + && (match i2 with + | AI_nop -> true + | _ -> false) + && anyDocument.IsSome + then // This special dummy debug point says skip the start of the method hasDebugPoints <- true FeeFeeInstr mgbuf.cenv anyDocument.Value @@ -2842,7 +2855,8 @@ and GenExprPreSteps (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr sequel = let others = [ for k in cenv.namedDebugPointsForInlinedCode.Keys do - if Range.equals m k.Range then yield k.Name + if Range.equals m k.Range then + yield k.Name ] |> String.concat "," @@ -3553,9 +3567,11 @@ and GenNewArray cenv cgbuf eenv (elems: Expr list, elemTy, m) sequel = // InitializeArray is a JIT intrinsic that will result in invalid runtime CodeGen when initializing an array // of enum types. Until bug 872799 is fixed, we'll need to generate arrays the "simple" way for enum types // Also note - C# never uses InitializeArray for enum types, so this change puts us on equal footing with them. - if elems.Length <= 5 - || not cenv.options.emitConstantArraysUsingStaticDataBlobs - || (isEnumTy cenv.g elemTy) then + if + elems.Length <= 5 + || not cenv.options.emitConstantArraysUsingStaticDataBlobs + || (isEnumTy cenv.g elemTy) + then GenNewArraySimple cenv cgbuf eenv (elems, elemTy, m) sequel else // Try to emit a constant byte-blob array @@ -3648,10 +3664,12 @@ and GenNewArray cenv cgbuf eenv (elems: Expr list, elemTy, m) sequel = | _ -> false), (fun _ _ -> failwith "unreachable") - if elemsArray - |> Array.forall (function - | Expr.Const (c, _, _) -> test c - | _ -> false) then + if + elemsArray + |> Array.forall (function + | Expr.Const (c, _, _) -> test c + | _ -> false) + then let ilElemTy = GenType cenv m eenv.tyenv elemTy GenConstArray cenv cgbuf eenv ilElemTy elemsArray (fun buf -> @@ -3667,10 +3685,12 @@ and GenNewArray cenv cgbuf eenv (elems: Expr list, elemTy, m) sequel = and GenCoerce cenv cgbuf eenv (e, tgty, m, srcty) sequel = let g = cenv.g // Is this an upcast? - if TypeDefinitelySubsumesTypeNoCoercion 0 g cenv.amap m tgty srcty - && - // Do an extra check - should not be needed - TypeFeasiblySubsumesType 0 g cenv.amap m tgty NoCoerce srcty then + if + TypeDefinitelySubsumesTypeNoCoercion 0 g cenv.amap m tgty srcty + && + // Do an extra check - should not be needed + TypeFeasiblySubsumesType 0 g cenv.amap m tgty NoCoerce srcty + then if isInterfaceTy g tgty then GenExpr cenv cgbuf eenv e Continue let ilToTy = GenType cenv m eenv.tyenv tgty @@ -3838,8 +3858,10 @@ and GenFieldGet isStatic cenv cgbuf eenv (rfref: RecdFieldRef, tyargs, m) = let fspec = GenRecdFieldRef m cenv eenv.tyenv rfref tyargs let vol = if rfref.RecdField.IsVolatile then Volatile else Nonvolatile - if useGenuineField rfref.Tycon rfref.RecdField - || entityRefInThisAssembly cenv.g.compilingFSharpCore rfref.TyconRef then + if + useGenuineField rfref.Tycon rfref.RecdField + || entityRefInThisAssembly cenv.g.compilingFSharpCore rfref.TyconRef + then let instr = if isStatic then I_ldsfld(vol, fspec) @@ -4306,9 +4328,11 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = // When generating debug code, generate a 'nop' after a 'call' that returns 'void' // This is what C# does, as it allows the call location to be maintained correctly in the stack frame - if cenv.options.generateDebugSymbols - && mustGenerateUnitAfterCall - && (isTailCall = Normalcall) then + if + cenv.options.generateDebugSymbols + && mustGenerateUnitAfterCall + && (isTailCall = Normalcall) + then CG.EmitInstr cgbuf (pop 0) Push0 AI_nop if isNil laterArgs then @@ -4352,22 +4376,24 @@ and CanTailcall // Can't tailcall with a struct object arg since it involves a byref // Can't tailcall with a .NET 2.0 generic constrained call since it involves a byref - if not hasStructObjArg - && Option.isNone ccallInfo - && not withinSEH - && not hasByrefArg - && not isDllImport - && not isSelfInit - && not makesNoCriticalTailcalls - && - - // We can tailcall even if we need to generate "unit", as long as we're about to throw the value away anyway as par of the return. - // We can tailcall if we don't need to generate "unit", as long as we're about to return. - (match sequelIgnoreEndScopes sequel with - | ReturnVoid - | Return -> not mustGenerateUnitAfterCall - | DiscardThen ReturnVoid -> mustGenerateUnitAfterCall - | _ -> false) then + if + not hasStructObjArg + && Option.isNone ccallInfo + && not withinSEH + && not hasByrefArg + && not isDllImport + && not isSelfInit + && not makesNoCriticalTailcalls + && + + // We can tailcall even if we need to generate "unit", as long as we're about to throw the value away anyway as par of the return. + // We can tailcall if we don't need to generate "unit", as long as we're about to return. + (match sequelIgnoreEndScopes sequel with + | ReturnVoid + | Return -> not mustGenerateUnitAfterCall + | DiscardThen ReturnVoid -> mustGenerateUnitAfterCall + | _ -> false) + then Tailcall else Normalcall @@ -5562,9 +5588,11 @@ and GenGenericParam cenv eenv (tp: Typar) = | _ -> if nm.TrimEnd([| '0' .. '9' |]).Length = 1 then nm - elif nm.Length >= 1 - && nm[0] = 'T' - && (nm.Length = 1 || not (System.Char.IsLower nm[1])) then + elif + nm.Length >= 1 + && nm[0] = 'T' + && (nm.Length = 1 || not (System.Char.IsLower nm[1])) + then nm else "T" + (String.capitalize nm) @@ -5874,14 +5902,13 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel let finfo = match - infoReader.GetRecordOrClassFieldsOfType - ( - Some fieldName, - AccessibilityLogic.AccessorDomain.AccessibleFromSomewhere, - m, - templateStructTy - ) - with + infoReader.GetRecordOrClassFieldsOfType( + Some fieldName, + AccessibilityLogic.AccessorDomain.AccessibleFromSomewhere, + m, + templateStructTy + ) + with | [ finfo ] -> finfo | _ -> error (InternalError(sprintf "expected class field %s not found" fieldName, m)) @@ -5894,14 +5921,13 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel let finfo = match - infoReader.GetRecordOrClassFieldsOfType - ( - Some fieldName, - AccessibilityLogic.AccessorDomain.AccessibleFromSomewhere, - m, - templateStructTy - ) - with + infoReader.GetRecordOrClassFieldsOfType( + Some fieldName, + AccessibilityLogic.AccessorDomain.AccessibleFromSomewhere, + m, + templateStructTy + ) + with | [ finfo ] -> finfo | _ -> error (InternalError(sprintf "expected class field %s not found" fieldName, m)) @@ -5939,7 +5965,7 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel AccessibilityLogic.AccessorDomain.AccessibleFromSomewhere imethName interfaceTy - with + with | [ meth ] when meth.IsInstance -> meth | _ -> error (InternalError(sprintf "expected method %s not found" imethName, m)) @@ -5989,7 +6015,7 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel AccessibilityLogic.AccessorDomain.AccessibleFromSomewhere imethName interfaceTy - with + with | [ meth ] when meth.IsInstance -> meth | _ -> error (InternalError(sprintf "expected method %s not found" imethName, m)) @@ -8093,9 +8119,11 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt = // Workaround for .NET and Visual Studio restriction w.r.t debugger type proxys // Mark internal constructors in internal classes as public. let access = - if access = ILMemberAccess.Assembly - && vspec.IsConstructor - && IsHiddenTycon eenv.sigToImplRemapInfo vspec.MemberApparentEntity.Deref then + if + access = ILMemberAccess.Assembly + && vspec.IsConstructor + && IsHiddenTycon eenv.sigToImplRemapInfo vspec.MemberApparentEntity.Deref + then ILMemberAccess.Public else access @@ -8488,8 +8516,10 @@ and GenMarshal cenv attribs = match decoder.FindTypeName "SafeArrayUserDefinedSubType" "" with | "" -> None | res -> - if (safeArraySubType = ILNativeVariant.IDispatch) - || (safeArraySubType = ILNativeVariant.IUnknown) then + if + (safeArraySubType = ILNativeVariant.IDispatch) + || (safeArraySubType = ILNativeVariant.IUnknown) + then Some res else None @@ -8856,8 +8886,10 @@ and GenMethodForBinding |> AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v, Arg(numArgsUsed + i))) nonUnitNonSelfMethodVars) let eenvForMeth = - if eenvForMeth.initLocals - && HasFSharpAttribute g g.attrib_SkipLocalsInitAttribute v.Attribs then + if + eenvForMeth.initLocals + && HasFSharpAttribute g g.attrib_SkipLocalsInitAttribute v.Attribs + then { eenvForMeth with initLocals = false } else eenvForMeth @@ -8905,8 +8937,10 @@ and GenMethodForBinding let attr = TryFindFSharpBoolAttributeAssumeFalse cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs - if (not generateWitnessArgs && attr.IsSome) - || (generateWitnessArgs && attr = Some false) then + if + (not generateWitnessArgs && attr.IsSome) + || (generateWitnessArgs && attr = Some false) + then let exnArg = mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported (v.CompiledName g.CompilerGlobalState)) @@ -8939,7 +8973,7 @@ and GenMethodForBinding match v.Attribs |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_CompiledNameAttribute) - with + with | Some (Attrib (_, _, [ AttribStringArg b ], _, _, _, _)) -> [ mkCompilationSourceNameAttr g v.LogicalName ], Some b | _ -> [], None @@ -9010,9 +9044,11 @@ and GenMethodForBinding -> let useMethodImpl = - if compileAsInstance - && ((memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) - || memberInfo.MemberFlags.IsOverrideOrExplicitImpl) then + if + compileAsInstance + && ((memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) + || memberInfo.MemberFlags.IsOverrideOrExplicitImpl) + then let useMethodImpl = ComputeUseMethodImpl cenv.g v @@ -9068,8 +9104,10 @@ and GenMethodForBinding if not compileAsInstance then mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) - elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) - || memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + elif + (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) + || memberInfo.MemberFlags.IsOverrideOrExplicitImpl + then let flagFixups = ComputeFlagFixupsForMemberBinding cenv v @@ -9197,7 +9235,8 @@ and GenMethodForBinding mdef.Name.StartsWithOrdinal("|") || // event add/remove method - v.val_flags.IsGeneratedEventVal then + v.val_flags.IsGeneratedEventVal + then mdef.WithSpecialName else mdef @@ -9763,7 +9802,8 @@ and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attr TypeNameForImplicitMainMethod cloc TypeNameForInitClass cloc TypeNameForPrivateImplementationDetails cloc - ] then + ] + then [] else [ mkCompilationMappingAttr g (int SourceConstructFlags.Module) ]) @@ -9899,10 +9939,12 @@ and GenModuleBinding cenv (cgbuf: CodeGenBuffer) (qname: QualifiedNameOfFile) la // If the module has a .cctor for some mutable fields, we need to ensure that when // those fields are "touched" the InitClass .cctor is forced. The InitClass .cctor will // then fill in the value of the mutable fields. - if not mspec.IsNamespace - && (cgbuf.mgbuf.GetCurrentFields(TypeRefForCompLoc eenvinner.cloc) - |> Seq.isEmpty - |> not) then + if + not mspec.IsNamespace + && (cgbuf.mgbuf.GetCurrentFields(TypeRefForCompLoc eenvinner.cloc) + |> Seq.isEmpty + |> not) + then GenForceWholeFileInitializationAsPartOfCCtor cenv cgbuf.mgbuf @@ -10386,11 +10428,13 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = // HOWEVER, if the type doesn't override Object.Equals already. let augmentOverrideMethodDefs = - (if Option.isNone tycon.GeneratedCompareToValues - && Option.isNone tycon.GeneratedHashAndEqualsValues - && tycon.HasInterface g g.mk_IComparable_ty - && not (tycon.HasOverride g "Equals" [ g.obj_ty ]) - && not tycon.IsFSharpInterfaceTycon then + (if + Option.isNone tycon.GeneratedCompareToValues + && Option.isNone tycon.GeneratedHashAndEqualsValues + && tycon.HasInterface g g.mk_IComparable_ty + && not (tycon.HasOverride g "Equals" [ g.obj_ty ]) + && not tycon.IsFSharpInterfaceTycon + then [ GenEqualsOverrideCallingIComparable cenv (tcref, ilThisTy, ilThisTy) ] else []) @@ -10602,7 +10646,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = [ // If using a field then all the attributes go on the field // See also FSharp 1.0 Bug 4727: once we start compiling them as real mutable fields, you should not be able to target both "property" for "val mutable" fields in classes - if useGenuineField then yield! fspec.PropertyAttribs + if useGenuineField then + yield! fspec.PropertyAttribs yield! fspec.FieldAttribs ] @@ -10866,9 +10911,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = // FSharp 1.0 bug 1988: Explicitly setting the ComVisible(true) attribute on an F# type causes an F# record to be emitted in a way that enables mutation for COM interop scenarios // FSharp 3.0 feature: adding CLIMutable to a record type causes emit of default constructor, and all fields get property setters // Records that are value types do not create a default constructor with CLIMutable or ComVisible - if not isStructRecord - && (isCLIMutable - || (TryFindFSharpBoolAttribute g g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) then + if + not isStructRecord + && (isCLIMutable + || (TryFindFSharpBoolAttribute g g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) + then yield mkILSimpleStorageCtor (Some g.ilg.typ_Object.TypeSpec, ilThisTy, [], [], reprAccess, None, eenv.imports) if not (tycon.HasMember g "ToString" []) then @@ -11034,11 +11081,13 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = // All structs are sequential by default // Structs with no instance fields get size 1, pack 0 - if tycon.AllFieldsArray |> Array.exists (fun f -> not f.IsStatic) - || - // Reflection emit doesn't let us emit 'pack' and 'size' for generic structs. - // In that case we generate a dummy field instead - (cenv.options.workAroundReflectionEmitBugs && not tycon.TyparsNoRange.IsEmpty) then + if + tycon.AllFieldsArray |> Array.exists (fun f -> not f.IsStatic) + || + // Reflection emit doesn't let us emit 'pack' and 'size' for generic structs. + // In that case we generate a dummy field instead + (cenv.options.workAroundReflectionEmitBugs && not tycon.TyparsNoRange.IsEmpty) + then ILTypeDefLayout.Sequential { Size = None; Pack = None }, ILDefaultPInvokeEncoding.Ansi else ILTypeDefLayout.Sequential { Size = Some 1; Pack = Some 0us }, ILDefaultPInvokeEncoding.Ansi @@ -11103,9 +11152,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let layout = if isStructTy g thisTy then - if (match ilTypeDefKind with - | ILTypeDefKind.ValueType -> true - | _ -> false) then + if + (match ilTypeDefKind with + | ILTypeDefKind.ValueType -> true + | _ -> false) + then // Structs with no instance fields get size 1, pack 0 ILTypeDefLayout.Sequential { Size = Some 1; Pack = Some 0us } else @@ -11206,9 +11257,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = // order in the sequential initialization of the file. // // In this case, the .cctor for this type must force the .cctor of the backing static class for the file. - if tycon.TyparsNoRange.IsEmpty - && tycon.MembersOfFSharpTyconSorted - |> List.exists (fun vref -> vref.Deref.IsClassConstructor) then + if + tycon.TyparsNoRange.IsEmpty + && tycon.MembersOfFSharpTyconSorted + |> List.exists (fun vref -> vref.Deref.IsClassConstructor) + then GenForceWholeFileInitializationAsPartOfCCtor cenv mgbuf lazyInitInfo tref eenv.imports m /// Generate the type for an F# exception declaration. diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index b1bca1b6092..2786e30e9a3 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -859,7 +859,8 @@ type TcConfigBuilder = | None -> () | Some n -> // nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus - if n = 62 then tcConfigB.mlCompatibility <- true + if n = 62 then + tcConfigB.mlCompatibility <- true tcConfigB.diagnosticsOptions <- { tcConfigB.diagnosticsOptions with @@ -873,7 +874,8 @@ type TcConfigBuilder = | None -> () | Some n -> // warnon 62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus - if n = 62 then tcConfigB.mlCompatibility <- false + if n = 62 then + tcConfigB.mlCompatibility <- false tcConfigB.diagnosticsOptions <- { tcConfigB.diagnosticsOptions with @@ -941,11 +943,10 @@ type TcConfigBuilder = if FileSystem.IsInvalidPathShim path then warning (Error(FSComp.SR.buildInvalidAssemblyName (path), m)) elif - not - ( - tcConfigB.referencedDLLs - |> List.exists (fun ar2 -> equals m ar2.Range && path = ar2.Text) - ) + not ( + tcConfigB.referencedDLLs + |> List.exists (fun ar2 -> equals m ar2.Range && path = ar2.Text) + ) then // NOTE: We keep same paths if range is different. let projectReference = tcConfigB.projectReferences @@ -1052,9 +1053,10 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = else None - match data.referencedDLLs - |> List.filter (fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) - with + match + data.referencedDLLs + |> List.filter (fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) + with | [] -> defaultCoreLibraryReference, None | [ r ] | r :: _ -> nameOfDll r @@ -1179,7 +1181,9 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let frameworkRootVersion = Path.Combine(frameworkRoot, targetFrameworkVersionValue) yield frameworkRootVersion let facades = Path.Combine(frameworkRootVersion, "Facades") - if FileSystem.DirectoryExistsShim facades then yield facades + + if FileSystem.DirectoryExistsShim facades then + yield facades match data.FxResolver.GetFrameworkRefsPackDirectory() with | Some path when FileSystem.DirectoryExistsShim(path) -> yield path diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index f8fd613b267..fba0a064091 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -1673,7 +1673,8 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | Some (cex, false) -> os.AppendString(MatchIncomplete2E().Format cex) | Some (cex, true) -> os.AppendString(MatchIncomplete3E().Format cex) - if isComp then os.AppendString(MatchIncomplete4E().Format) + if isComp then + os.AppendString(MatchIncomplete4E().Format) | PatternMatchCompilation.EnumMatchIncomplete (isComp, cexOpt, _) -> os.AppendString(EnumMatchIncomplete1E().Format) @@ -1683,7 +1684,8 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | Some (cex, false) -> os.AppendString(MatchIncomplete2E().Format cex) | Some (cex, true) -> os.AppendString(MatchIncomplete3E().Format cex) - if isComp then os.AppendString(MatchIncomplete4E().Format) + if isComp then + os.AppendString(MatchIncomplete4E().Format) | PatternMatchCompilation.RuleNeverMatched _ -> os.AppendString(RuleNeverMatchedE().Format) @@ -1695,7 +1697,9 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | ObsoleteWarning (s, _) -> os.AppendString(Obsolete1E().Format) - if s <> "" then os.AppendString(Obsolete2E().Format s) + + if s <> "" then + os.AppendString(Obsolete2E().Format s) | Experimental (s, _) -> os.AppendString(ExperimentalE().Format s) @@ -1990,7 +1994,8 @@ let CollectFormattedDiagnostics // Show prefix only for real files. Otherwise, we just want a truncated error like: // parse error FS0031: blah blah if - not (equals m range0) && not (equals m rangeStartup) + not (equals m range0) + && not (equals m rangeStartup) && not (equals m rangeCmdArgs) then let file = file.Replace("/", "\\") diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 515bb1b3868..1e63aa45dd5 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -402,7 +402,8 @@ type TcConfig with seq { yield! tcConfig.GetSearchPathsForLibraryFiles() - if isHashRReference m then Path.GetDirectoryName(m.FileName) + if isHashRReference m then + Path.GetDirectoryName(m.FileName) } let resolved = TryResolveFileUsingPaths(searchPaths, m, nm) @@ -592,8 +593,10 @@ type TcConfig with // O(N^2) here over a small set of referenced assemblies. let IsResolved (originalName: string) = - if resultingResolutions - |> List.exists (fun resolution -> resolution.originalReference.Text = originalName) then + if + resultingResolutions + |> List.exists (fun resolution -> resolution.originalReference.Text = originalName) + then true else // MSBuild resolution may have unified the result of two duplicate references. Try to re-resolve now. @@ -615,8 +618,10 @@ type TcConfig with // If mode=Speculative, then we haven't reported any errors. // We report the error condition by returning an empty list of resolutions - if mode = ResolveAssemblyReferenceMode.Speculative - && unresolvedReferences.Length > 0 then + if + mode = ResolveAssemblyReferenceMode.Speculative + && unresolvedReferences.Length > 0 + then [], unresolved else resultingResolutions, unresolved @@ -736,7 +741,8 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list, resolutions.Length = 1 - if found then asm + if found then + asm if tcConfig.implicitlyReferenceDotNetAssemblies then let references, _useDotNetFramework = @@ -1097,7 +1103,9 @@ and [] TcImports let mutable disposed = false // this doesn't need locking, it's only for debugging let mutable tcGlobals = None // this doesn't need locking, it's set during construction of the TcImports - let CheckDisposed () = if disposed then assert false + let CheckDisposed () = + if disposed then + assert false let dispose () = CheckDisposed() @@ -1116,8 +1124,11 @@ and [] TcImports let unsuccessful = [ for ccuThunk, func in contents do - if ccuThunk.IsUnresolvedReference then func () - if ccuThunk.IsUnresolvedReference then (ccuThunk, func) + if ccuThunk.IsUnresolvedReference then + func () + + if ccuThunk.IsUnresolvedReference then + (ccuThunk, func) ] ccuThunks <- ResizeArray unsuccessful) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index e33e311eb86..b8fbfbe4f91 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -288,9 +288,11 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler let getSwitchOpt (opt: string) = // if opt is a switch, strip the '+' or '-' - if opt <> "--" - && opt.Length > 1 - && (opt.EndsWithOrdinal("+") || opt.EndsWithOrdinal("-")) then + if + opt <> "--" + && opt.Length > 1 + && (opt.EndsWithOrdinal("+") || opt.EndsWithOrdinal("-")) + then opt[0 .. opt.Length - 2] else opt @@ -368,7 +370,10 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler | CompilerOption (s, _, OptionString f, d, _) as compilerOption :: _ when optToken = s -> reportDeprecatedOption d let oa = getOptionArg compilerOption argString - if oa <> "" then f (getOptionArg compilerOption oa) + + if oa <> "" then + f (getOptionArg compilerOption oa) + t | CompilerOption (s, _, OptionInt f, d, _) as compilerOption :: _ when optToken = s -> reportDeprecatedOption d @@ -1234,7 +1239,9 @@ let noFrameworkFlag isFsc tcConfigB = tagNone, OptionUnit(fun () -> tcConfigB.implicitlyReferenceDotNetAssemblies <- false - if isFsc then tcConfigB.implicitlyResolveAssemblies <- false), + + if isFsc then + tcConfigB.implicitlyResolveAssemblies <- false), None, Some(FSComp.SR.optsNoframework ()) ) diff --git a/src/Compiler/Driver/CreateILModule.fs b/src/Compiler/Driver/CreateILModule.fs index 9039453478c..55ec3ad40a1 100644 --- a/src/Compiler/Driver/CreateILModule.fs +++ b/src/Compiler/Driver/CreateILModule.fs @@ -195,9 +195,10 @@ module MainModuleBuilder = "System.Runtime.Numerics" let numericsAssemblyRef = - match tcImports.GetImportedAssemblies() - |> List.tryFind (fun a -> a.FSharpViewOfMetadata.AssemblyName = refNumericsDllName) - with + match + tcImports.GetImportedAssemblies() + |> List.tryFind (fun a -> a.FSharpViewOfMetadata.AssemblyName = refNumericsDllName) + with | Some asm -> match asm.ILScopeRef with | ILScopeRef.Assembly aref -> Some aref @@ -581,10 +582,12 @@ module MainModuleBuilder = tcConfig.win32manifest // don't embed a manifest if target is not an exe, if manifest is specifically excluded, if another native resource is being included, or if running on mono - elif not (tcConfig.target.IsExe) - || not (tcConfig.includewin32manifest) - || not (tcConfig.win32res = "") - || runningOnMono then + elif + not (tcConfig.target.IsExe) + || not (tcConfig.includewin32manifest) + || not (tcConfig.win32res = "") + || runningOnMono + then "" // otherwise, include the default manifest else @@ -617,9 +620,11 @@ module MainModuleBuilder = tcConfig.target = CompilerTarget.Dll )) |] - if tcConfig.win32res = "" - && tcConfig.win32icon <> "" - && tcConfig.target <> CompilerTarget.Dll then + if + tcConfig.win32res = "" + && tcConfig.win32icon <> "" + && tcConfig.target <> CompilerTarget.Dll + then use ms = new MemoryStream() use iconStream = FileSystem.OpenFileForReadShim(tcConfig.win32icon) Win32ResourceConversions.AppendIconToResourceStream(ms, iconStream) diff --git a/src/Compiler/Driver/FxResolver.fs b/src/Compiler/Driver/FxResolver.fs index 2d1eb4ce7ae..d769b36678e 100644 --- a/src/Compiler/Driver/FxResolver.fs +++ b/src/Compiler/Driver/FxResolver.fs @@ -492,13 +492,14 @@ type internal FxResolver defaultMscorlibVersion // Get the ProductVersion of this framework compare with table compatible monikers - match desktopProductVersionMonikers - |> Array.tryFind (fun (major, minor, build, revision, _) -> - (majorPart >= major) - && (minorPart >= minor) - && (buildPart >= build) - && (privatePart >= revision)) - with + match + desktopProductVersionMonikers + |> Array.tryFind (fun (major, minor, build, revision, _) -> + (majorPart >= major) + && (minorPart >= minor) + && (buildPart >= build) + && (privatePart >= revision)) + with | Some (_, _, _, _, moniker) -> moniker | None -> // no TFM could be found, assume latest stable? @@ -653,7 +654,8 @@ type internal FxResolver "System.Configuration" getFSharpCoreLibraryName - if useFsiAuxLib then fsiLibraryName + if useFsiAuxLib then + fsiLibraryName // always include a default reference to System.ValueTuple.dll in scripts and out-of-project sources match getSystemValueTupleImplementationReference () with @@ -687,7 +689,8 @@ type internal FxResolver [ yield! Directory.GetFiles(implDir, "*.dll") getFSharpCoreImplementationReference () - if useFsiAuxLib then getFsiLibraryImplementationReference () + if useFsiAuxLib then + getFsiLibraryImplementationReference () ] (getDependenciesOf roots).Values |> Seq.toList @@ -979,7 +982,8 @@ type internal FxResolver [ yield! Directory.GetFiles(path, "*.dll") getFSharpCoreImplementationReference () - if useFsiAuxLib then getFsiLibraryImplementationReference () + if useFsiAuxLib then + getFsiLibraryImplementationReference () ] |> List.filter (fun f -> systemAssemblies.Contains(Path.GetFileNameWithoutExtension(f))) diff --git a/src/Compiler/Driver/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index bd8a76ab674..fc276a711a0 100644 --- a/src/Compiler/Driver/OptimizeInputs.fs +++ b/src/Compiler/Driver/OptimizeInputs.fs @@ -232,8 +232,10 @@ let GenerateIlxCode ) = let mainMethodInfo = - if (tcConfig.target = CompilerTarget.Dll) - || (tcConfig.target = CompilerTarget.Module) then + if + (tcConfig.target = CompilerTarget.Dll) + || (tcConfig.target = CompilerTarget.Module) + then None else Some topAttrs.mainMethodAttrs diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 3470f97a8af..6d764f264dd 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -617,7 +617,8 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileNam ) // Report the statistics for testing purposes - if tcConfig.reportNumDecls then ReportParsingStatistics res + if tcConfig.reportNumDecls then + ReportParsingStatistics res res) diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index 67adfb1e8de..868a9f80cae 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -98,7 +98,8 @@ module ScriptPreprocessClosure = let seen = Dictionary<_, bool>() member _.SetSeen check = - if not (seen.ContainsKey check) then seen.Add(check, true) + if not (seen.ContainsKey check) then + seen.Add(check, true) member _.HaveSeen check = seen.ContainsKey check diff --git a/src/Compiler/Driver/StaticLinking.fs b/src/Compiler/Driver/StaticLinking.fs index 6c23eb9b024..5ad9ff15f40 100644 --- a/src/Compiler/Driver/StaticLinking.fs +++ b/src/Compiler/Driver/StaticLinking.fs @@ -304,8 +304,10 @@ let FindDependentILModulesForStaticLinking (ctok, tcConfig: TcConfig, tcImports: let ilAssemRef = List.head remaining remaining <- List.tail remaining - if assumedIndependentSet.Contains ilAssemRef.Name - || (ilAssemRef.PublicKey = Some ecmaPublicKey) then + if + assumedIndependentSet.Contains ilAssemRef.Name + || (ilAssemRef.PublicKey = Some ecmaPublicKey) + then depModuleTable[ilAssemRef.Name] <- dummyEntry ilAssemRef.Name else if not (depModuleTable.ContainsKey ilAssemRef.Name) then match tcImports.TryFindDllInfo(ctok, rangeStartup, ilAssemRef.Name, lookupOnly = false) with @@ -502,10 +504,11 @@ let StaticLink (ctok, tcConfig: TcConfig, tcImports: TcImports, ilGlobals: ILGlo | Some provAssemStaticLinkInfo -> (importedBinary, provAssemStaticLinkInfo) ] #endif - if not tcConfig.standalone - && tcConfig.extraStaticLinkRoots.IsEmpty + if + not tcConfig.standalone + && tcConfig.extraStaticLinkRoots.IsEmpty #if !NO_TYPEPROVIDERS - && providerGeneratedAssemblies.IsEmpty + && providerGeneratedAssemblies.IsEmpty #endif then id diff --git a/src/Compiler/Driver/XmlDocFileWriter.fs b/src/Compiler/Driver/XmlDocFileWriter.fs index 97125744ace..fe6ac2a3fac 100644 --- a/src/Compiler/Driver/XmlDocFileWriter.fs +++ b/src/Compiler/Driver/XmlDocFileWriter.fs @@ -63,7 +63,8 @@ module XmlDocWriter = let ptext = defaultArg path "" - if mspec.IsModule then doModuleMemberSig ptext mspec + if mspec.IsModule then + doModuleMemberSig ptext mspec let vals = mtype.AllValsAndMembers @@ -116,7 +117,9 @@ module XmlDocWriter = let rec doModule (mspec: ModuleOrNamespace) = let mtype = mspec.ModuleOrNamespaceType - if mspec.IsModule then modulMember mspec + + if mspec.IsModule then + modulMember mspec let vals = mtype.AllValsAndMembers diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index b0519d50a8d..84fd4742d6d 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -149,7 +149,8 @@ type ConsoleLoggerProvider() = /// Notify the exiter if any error has occurred let AbortOnError (diagnosticsLogger: DiagnosticsLogger, exiter: Exiter) = - if diagnosticsLogger.ErrorCount > 0 then exiter.Exit 1 + if diagnosticsLogger.ErrorCount > 0 then + exiter.Exit 1 let TypeCheck ( @@ -382,7 +383,8 @@ module InterfaceFileWriter = for impl in declaredImpls do writeToFile os impl - if tcConfig.printSignatureFile <> "" then os.Dispose() + if tcConfig.printSignatureFile <> "" then + os.Dispose() let extensionForFile (filePath: string) = if (List.exists (FileSystemUtils.checkSuffix filePath) FSharpMLCompatFileSuffixes) then @@ -489,11 +491,13 @@ let main1 // See Bug 735819 let lcidFromCodePage = - if (Console.OutputEncoding.CodePage <> 65001) - && (Console.OutputEncoding.CodePage - <> Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) - && (Console.OutputEncoding.CodePage - <> Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) then + if + (Console.OutputEncoding.CodePage <> 65001) + && (Console.OutputEncoding.CodePage + <> Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) + && (Console.OutputEncoding.CodePage + <> Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) + then Thread.CurrentThread.CurrentUICulture <- CultureInfo("en-US") Some 1033 else @@ -553,7 +557,8 @@ let main1 tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines // Display the banner text, if necessary - if not bannerAlreadyPrinted then DisplayBannerText tcConfigB + if not bannerAlreadyPrinted then + DisplayBannerText tcConfigB // Create tcGlobals and frameworkTcImports let outfile, pdbfile, assemblyName = @@ -633,7 +638,8 @@ let main1 printfn "%+A" input printf "\n" - if tcConfig.parseOnly then exiter.Exit 0 + if tcConfig.parseOnly then + exiter.Exit 0 if not tcConfig.continueAfterParseFailure then AbortOnError(diagnosticsLogger, exiter) @@ -659,7 +665,8 @@ let main1 if not tcConfig.continueAfterParseFailure then AbortOnError(diagnosticsLogger, exiter) - if tcConfig.importAllReferencesOnly then exiter.Exit 0 + if tcConfig.importAllReferencesOnly then + exiter.Exit 0 // Build the initial type checking environment ReportTime tcConfig "Typecheck" @@ -912,7 +919,8 @@ let main2 ilSourceDocs)) = - if tcConfig.typeCheckOnly then exiter.Exit 0 + if tcConfig.typeCheckOnly then + exiter.Exit 0 generatedCcu.Contents.SetAttribs(generatedCcu.Contents.Attribs @ topAttrs.assemblyAttrs) @@ -945,7 +953,7 @@ let main2 "AssemblyVersionAttribute" topAttrs.assemblyAttrs tcConfig.deterministic - with + with | Some v -> match tcConfig.version with | VersionNone -> Some v @@ -1351,9 +1359,11 @@ let main6 AbortOnError(diagnosticsLogger, exiter) // Don't copy referenced FSharp.core.dll if we are building FSharp.Core.dll - if (tcConfig.copyFSharpCore = CopyFSharpCoreFlag.Yes) - && not tcConfig.compilingFSharpCore - && not tcConfig.standalone then + if + (tcConfig.copyFSharpCore = CopyFSharpCoreFlag.Yes) + && not tcConfig.compilingFSharpCore + && not tcConfig.standalone + then CopyFSharpCore(outfile, tcConfig.referencedDLLs) ReportTime tcConfig "Exiting" diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index d11ae3d895b..c7f4e0ce0f0 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -381,8 +381,10 @@ type internal TypeCheckInfo if contained then match bestAlmostIncludedSoFar with | Some (rightm: range, _, _) -> - if posGt possm.End rightm.End - || (posEq possm.End rightm.End && posGt possm.Start rightm.Start) then + if + posGt possm.End rightm.End + || (posEq possm.End rightm.End && posGt possm.Start rightm.Start) + then bestAlmostIncludedSoFar <- Some(possm, env, ad) | _ -> bestAlmostIncludedSoFar <- Some(possm, env, ad)) @@ -914,9 +916,10 @@ type internal TypeCheckInfo match TryToResolveLongIdentAsType ncenv nenv m plid with | Some x -> tryTcrefOfAppTy g x | None -> - match lastDotPos - |> Option.orElseWith (fun _ -> FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1)) - with + match + lastDotPos + |> Option.orElseWith (fun _ -> FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1)) + with | Some p when lineStr[p] = '.' -> match FindFirstNonWhitespacePosition lineStr (p - 1) with | Some colAtEndOfNames -> @@ -1154,7 +1157,7 @@ type internal TypeCheckInfo match GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, false) |> toCompletionItems - with + with | [], _, _ -> // no record fields found, return completion list as if we were outside any computation expression GetDeclaredItems( @@ -2395,19 +2398,22 @@ module internal ParseAndCheckFile = let errors = [ for err, severity in diagnostics do - if severity = FSharpDiagnosticSeverity.Error then err + if severity = FSharpDiagnosticSeverity.Error then + err ] let warnings = [ for err, severity in diagnostics do - if severity = FSharpDiagnosticSeverity.Warning then err + if severity = FSharpDiagnosticSeverity.Warning then + err ] let infos = [ for err, severity in diagnostics do - if severity = FSharpDiagnosticSeverity.Info then err + if severity = FSharpDiagnosticSeverity.Info then + err ] let message = HashLoadedSourceHasIssues(infos, warnings, errors, rangeOfHashLoad) diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 3959c84da3f..c2ee71a022e 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -498,7 +498,8 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, let findBreakPoints () = let checkRange m = [ - if isMatchRange m && not m.IsSynthetic then yield m + if isMatchRange m && not m.IsSynthetic then + yield m ] let walkBindSeqPt sp = @@ -559,7 +560,8 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | _ -> false // This extends the range of the implicit debug point for 'do expr' range to include the 'do' - if extendDebugPointForDo then yield! checkRange m + if extendDebugPointForDo then + yield! checkRange m let useImplicitDebugPoint = match spInfo with @@ -944,9 +946,10 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, if pos.Column = 0 then // we have a breakpoint that was set with mouse at line start - match locations - |> List.filter (fun m -> m.StartLine = m.EndLine && pos.Line = m.StartLine) - with + match + locations + |> List.filter (fun m -> m.StartLine = m.EndLine && pos.Line = m.StartLine) + with | [] -> match locations |> List.filter (fun m -> rangeContainsPos m pos) with | [] -> diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index 2854da14a25..261d6ec094f 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -150,7 +150,9 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = while reader.Offset < reader.Length do let m = this.ReadRange &reader let keyString2 = this.ReadKeyString &reader - if keyString1.SequenceEqual keyString2 then results.Add m + + if keyString1.SequenceEqual keyString2 then + results.Add m results :> range seq @@ -271,7 +273,9 @@ and [] ItemKeyStoreBuilder() = and writeTypar (isStandalone: bool) (typar: Typar) = match typar.Solution with | Some ty -> writeType isStandalone ty - | _ -> if isStandalone then writeInt64 typar.Stamp + | _ -> + if isStandalone then + writeInt64 typar.Stamp let writeValRef (vref: ValRef) = match vref.MemberInfo with diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index c95195db8ff..bdbc73d783a 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -93,12 +93,14 @@ module TcResolutionsExtensions = | _ -> None let (|KeywordIntrinsicValue|_|) (vref: ValRef) = - if valRefEq g g.raise_vref vref - || valRefEq g g.reraise_vref vref - || valRefEq g g.typeof_vref vref - || valRefEq g g.typedefof_vref vref - || valRefEq g g.sizeof_vref vref - || valRefEq g g.nameof_vref vref then + if + valRefEq g g.raise_vref vref + || valRefEq g g.reraise_vref vref + || valRefEq g g.typeof_vref vref + || valRefEq g g.typedefof_vref vref + || valRefEq g g.sizeof_vref vref + || valRefEq g g.nameof_vref vref + then Some() else None @@ -257,8 +259,10 @@ module TcResolutionsExtensions = match minfos with | [] -> add m SemanticClassificationType.Method | _ -> - if minfos - |> List.forall (fun minfo -> minfo.IsExtensionMember || minfo.IsCSharpStyleExtensionMember) then + if + minfos + |> List.forall (fun minfo -> minfo.IsExtensionMember || minfo.IsCSharpStyleExtensionMember) + then add m SemanticClassificationType.ExtensionMethod else add m SemanticClassificationType.Method diff --git a/src/Compiler/Service/ServiceAnalysis.fs b/src/Compiler/Service/ServiceAnalysis.fs index 09e3545e8ad..38af8f7156c 100644 --- a/src/Compiler/Service/ServiceAnalysis.fs +++ b/src/Compiler/Service/ServiceAnalysis.fs @@ -40,7 +40,8 @@ module UnusedOpens = // fv.IsExtensionMember is always false for C# extension methods returning by `MembersFunctionsAndValues`, // so we have to check Extension attribute instead. // (note: fv.IsExtensionMember has proper value for symbols returning by GetAllUsesOfAllSymbolsInFile though) - if fv.HasAttribute() then fv + if fv.HasAttribute() then + fv for apCase in entity.ActivePatternCases do apCase @@ -429,11 +430,13 @@ module UnusedDeclarations = symbolsUses |> Seq.distinctBy (fun su -> su.Range) // Account for "hidden" uses, like a val in a member val definition. These aren't relevant |> Seq.choose (fun (su: FSharpSymbolUse) -> - if su.IsFromDefinition - && su.Symbol.DeclarationLocation.IsSome - && (isScript || su.IsPrivateToFile) - && not (su.Symbol.DisplayName.StartsWith "_") - && isPotentiallyUnusedDeclaration su.Symbol then + if + su.IsFromDefinition + && su.Symbol.DeclarationLocation.IsSome + && (isScript || su.IsPrivateToFile) + && not (su.Symbol.DisplayName.StartsWith "_") + && isPotentiallyUnusedDeclaration su.Symbol + then Some(su, usages.Contains su.Symbol.DeclarationLocation.Value) else None) diff --git a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs index 5458e129ffd..410d02dc786 100644 --- a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs +++ b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs @@ -206,9 +206,11 @@ module InterfaceStubGenerator = let nm = match arg.Name with | None -> - if arg.Type.HasTypeDefinition - && arg.Type.TypeDefinition.CompiledName = "unit" - && arg.Type.TypeDefinition.Namespace = Some "Microsoft.FSharp.Core" then + if + arg.Type.HasTypeDefinition + && arg.Type.TypeDefinition.CompiledName = "unit" + && arg.Type.TypeDefinition.Namespace = Some "Microsoft.FSharp.Core" + then "()" else sprintf "arg%d" (namesWithIndices |> Map.toSeq |> Seq.map snd |> Seq.sumBy Set.count |> max 1) @@ -303,8 +305,10 @@ module InterfaceStubGenerator = let internal normalizePropertyName (v: FSharpMemberOrFunctionOrValue) = let displayName = v.DisplayName - if (v.IsPropertyGetterMethod && displayName.StartsWithOrdinal("get_")) - || (v.IsPropertySetterMethod && displayName.StartsWithOrdinal("set_")) then + if + (v.IsPropertyGetterMethod && displayName.StartsWithOrdinal("get_")) + || (v.IsPropertySetterMethod && displayName.StartsWithOrdinal("set_")) + then displayName[4..] else displayName @@ -362,7 +366,8 @@ module InterfaceStubGenerator = [ if v.InlineAnnotation = FSharpInlineAnnotation.AlwaysInline then yield "inline" - if v.Accessibility.IsInternal then yield "internal" + if v.Accessibility.IsInternal then + yield "internal" ] let argInfos, retType = getArgTypes ctx v @@ -371,9 +376,13 @@ module InterfaceStubGenerator = // A couple of helper methods for emitting close declarations of members and stub method bodies. let closeDeclaration (returnType: string) (writer: ColumnIndentedTextWriter) = - if verboseMode then writer.Write(": {0}", returnType) + if verboseMode then + writer.Write(": {0}", returnType) + writer.Write(" = ", returnType) - if verboseMode then writer.WriteLine("") + + if verboseMode then + writer.WriteLine("") let writeImplementation (ctx: Context) (writer: ColumnIndentedTextWriter) = match verboseMode, ctx.MethodBody with @@ -435,7 +444,10 @@ module InterfaceStubGenerator = let closeDeclaration = closeDeclaration retType let writeImplementation = writeImplementation ctx let writer = ctx.Writer - if isEventMember v then writer.WriteLine("[]") + + if isEventMember v then + writer.WriteLine("[]") + writer.Write("member ") for modifier in modifiers do @@ -464,7 +476,9 @@ module InterfaceStubGenerator = writer.Write(")") writer.Write(" = ") - if verboseMode then writer.WriteLine("") + + if verboseMode then + writer.WriteLine("") writer |> writeImplementation writer.Unindent ctx.Indentation diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index 9ecdbb823a4..9f14d717af2 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -683,8 +683,10 @@ module internal LexerStateEncoding = let kind2 = ((nestingValue &&& 0b000000000011) >>> 0) [ - if tag1 then i1, decodeStringStyle kind1, range0 - if tag2 then i2, decodeStringStyle kind2, range0 + if tag1 then + i1, decodeStringStyle kind1, range0 + if tag2 then + i2, decodeStringStyle kind2, range0 ] (colorState, ncomments, pos, ifDefs, hardwhite, stringKind, stringNest) diff --git a/src/Compiler/Service/ServiceNavigation.fs b/src/Compiler/Service/ServiceNavigation.fs index f162076d44e..68b7eb268f9 100755 --- a/src/Compiler/Service/ServiceNavigation.fs +++ b/src/Compiler/Service/ServiceNavigation.fs @@ -831,7 +831,9 @@ module NavigateTo = and walkSynModuleOrNamespaceSig (inp: SynModuleOrNamespaceSig) container = let (SynModuleOrNamespaceSig (longId = lid; kind = kind; decls = decls)) = inp let isModule = kind.IsModule - if isModule then addModule lid true container + + if isModule then + addModule lid true container let container = { @@ -900,7 +902,9 @@ module NavigateTo = and walkSynModuleOrNamespace inp container = let (SynModuleOrNamespace (longId = lid; kind = kind; decls = decls)) = inp let isModule = kind.IsModule - if isModule then addModule lid false container + + if isModule then + addModule lid false container let container = { diff --git a/src/Compiler/Service/ServiceParamInfoLocations.fs b/src/Compiler/Service/ServiceParamInfoLocations.fs index 35b4b777d8a..ff34dd392d4 100755 --- a/src/Compiler/Service/ServiceParamInfoLocations.fs +++ b/src/Compiler/Service/ServiceParamInfoLocations.fs @@ -222,8 +222,10 @@ module internal ParameterLocationsImpl = let lidm = lidwd.Range let betweenTheBrackets = mkRange wholem.FileName openm.Start wholem.End - if SyntaxTraversal.rangeContainsPosEdgesExclusive betweenTheBrackets pos - && args |> List.forall isStaticArg then + if + SyntaxTraversal.rangeContainsPosEdgesExclusive betweenTheBrackets pos + && args |> List.forall isStaticArg + then let commasAndCloseParen = [ for c in commas -> c.End ] @ [ wholem.End ] Some( @@ -344,8 +346,10 @@ module internal ParameterLocationsImpl = | None -> let typeArgsm = mkRange openm.FileName openm.Start wholem.End - if SyntaxTraversal.rangeContainsPosEdgesExclusive typeArgsm pos - && tyArgs |> List.forall isStaticArg then + if + SyntaxTraversal.rangeContainsPosEdgesExclusive typeArgsm pos + && tyArgs |> List.forall isStaticArg + then let commasAndCloseParen = [ for c in commas -> c.End ] @ [ wholem.End ] let argRanges = diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 32e20db6486..e2eedc9ba47 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -246,14 +246,15 @@ module SyntaxTraversal = else None) diveResults - with + with | [] -> // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file. // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position. let mutable e = diveResults.Head for r in diveResults do - if posGt pos (fst r).Start then e <- r + if posGt pos (fst r).Start then + e <- r snd (e) () | [ x ] -> x () @@ -396,9 +397,11 @@ module SyntaxTraversal = // special-case:caret is located in the offside position below inherit // inherit A() // $ - if not (rangeContainsPos expr.Range pos) - && sepOpt.IsNone - && pos.Column = inheritRange.StartColumn then + if + not (rangeContainsPos expr.Range pos) + && sepOpt.IsNone + && pos.Column = inheritRange.StartColumn + then visitor.VisitRecordField(path, None, None) else traverseSynExpr expr) @@ -451,9 +454,11 @@ module SyntaxTraversal = // special case: caret is below field binding // field x = 5 // $ - if not (rangeContainsPos e.Range pos) - && sepOpt.IsNone - && pos.Column = offsideColumn then + if + not (rangeContainsPos e.Range pos) + && sepOpt.IsNone + && pos.Column = offsideColumn + then visitor.VisitRecordField(path, copyOpt, None) else traverseSynExpr expr) diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index f61893d0eaf..757cd90a264 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -1539,7 +1539,9 @@ module ParsedInput = None override this.VisitModuleOrNamespace(_, SynModuleOrNamespace (longId = longId; range = range)) = - if rangeContainsPos range pos then path <- path @ longId + if rangeContainsPos range pos then + path <- path @ longId + None // we should traverse the rest of the AST to find the smallest module } @@ -1916,7 +1918,9 @@ module ParsedInput = List.iter walkAttribute attrs List.iter walkTyparDecl typars List.iter walkTypeConstraint constraints - if isTypeExtensionOrAlias then addLongIdent longIdent + + if isTypeExtensionOrAlias then + addLongIdent longIdent and walkTypeDefnRepr inp = match inp with diff --git a/src/Compiler/Service/ServiceStructure.fs b/src/Compiler/Service/ServiceStructure.fs index 8e3a96112ca..995e4e4d3e9 100644 --- a/src/Compiler/Service/ServiceStructure.fs +++ b/src/Compiler/Service/ServiceStructure.fs @@ -319,24 +319,28 @@ module Structure = | SynExpr.App (atomicFlag, isInfix, funcExpr, argExpr, r) -> // seq exprs, custom operators, etc - if ExprAtomicFlag.NonAtomic = atomicFlag - && not isInfix - && (match funcExpr with - | SynExpr.Ident _ -> true - | _ -> false) - && (match argExpr with - | SynExpr.ComputationExpr _ -> false - | _ -> true) then + if + ExprAtomicFlag.NonAtomic = atomicFlag + && not isInfix + && (match funcExpr with + | SynExpr.Ident _ -> true + | _ -> false) + && (match argExpr with + | SynExpr.ComputationExpr _ -> false + | _ -> true) + then // if the argExpr is a computation expression another match will handle the outlining // these cases must be removed to prevent creating unnecessary tags for the same scope let collapse = Range.endToEnd funcExpr.Range r rcheck Scope.SpecialFunc Collapse.Below r collapse - elif ExprAtomicFlag.NonAtomic = atomicFlag - && (not isInfix) - && (match argExpr with - | SynExpr.ComputationExpr _ -> true - | _ -> false) then + elif + ExprAtomicFlag.NonAtomic = atomicFlag + && (not isInfix) + && (match argExpr with + | SynExpr.ComputationExpr _ -> true + | _ -> false) + then let collapse = Range.startToEnd argExpr.Range r let collapse = Range.modBoth 1 1 collapse rcheck Scope.ComputationExpr Collapse.Same r collapse diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 023c0ddfe2a..20fd5956c43 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -334,11 +334,13 @@ type BackgroundCompiler // these cross-project references to FSharp.Core are VisualFSharp.sln and FSharp.sln. The ramification // of this is that you need to build FSharp.Core to get intellisense in those projects. - if (try + if + (try Path.GetFileNameWithoutExtension(nm) - with _ -> - "") - <> GetFSharpCoreLibraryName() then + with _ -> + "") + <> GetFSharpCoreLibraryName() + then { new IProjectReference with member x.EvaluateRawContents() = node { diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index c9b201b9445..67f6c78f558 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -211,7 +211,8 @@ let stringBufferIsBytes (buf: ByteBuffer) = let mutable ok = true for i = 0 to bytes.Length / 2 - 1 do - if bytes.Span[i * 2 + 1] <> 0uy then ok <- false + if bytes.Span[i * 2 + 1] <> 0uy then + ok <- false ok @@ -237,15 +238,20 @@ let hexdigit d = else failwith "hexdigit" let unicodeGraphShort (s: string) = - if s.Length <> 4 then failwith "unicodegraph" + if s.Length <> 4 then + failwith "unicodegraph" + uint16 (hexdigit s[0] * 4096 + hexdigit s[1] * 256 + hexdigit s[2] * 16 + hexdigit s[3]) let hexGraphShort (s: string) = - if s.Length <> 2 then failwith "hexgraph" + if s.Length <> 2 then + failwith "hexgraph" + uint16 (hexdigit s[0] * 16 + hexdigit s[1]) let unicodeGraphLong (s: string) = - if s.Length <> 8 then failwith "unicodeGraphLong" + if s.Length <> 8 then + failwith "unicodeGraphLong" let high = hexdigit s[0] * 4096 + hexdigit s[1] * 256 + hexdigit s[2] * 16 + hexdigit s[3] in diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index bcaebd20b92..ff7a44e98a4 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -25,7 +25,7 @@ open Internal.Utilities.Text.Parsing /// information about the grammar at the point where the error occurred, e.g. what tokens /// are valid to shift next at that point in the grammar. This information is processed in CompileOps.fs. [] -exception SyntaxError of obj (* ParseErrorContext<_> *) * range: range +exception SyntaxError of obj (* ParseErrorContext<_> *) * range: range exception IndentationProblem of string * range diff --git a/src/Compiler/SyntaxTree/PrettyNaming.fs b/src/Compiler/SyntaxTree/PrettyNaming.fs index ad02a04b1b7..6e25b5c6360 100755 --- a/src/Compiler/SyntaxTree/PrettyNaming.fs +++ b/src/Compiler/SyntaxTree/PrettyNaming.fs @@ -527,7 +527,8 @@ let DoesIdentifierNeedBackticks (name: string) : bool = /// A utility to help determine if an identifier needs to be quoted let AddBackticksToIdentifierIfNeeded (name: string) : string = if - DoesIdentifierNeedBackticks name && not (name.StartsWithOrdinal("`")) + DoesIdentifierNeedBackticks name + && not (name.StartsWithOrdinal("`")) && not (name.EndsWithOrdinal("`")) then "``" + name + "``" @@ -820,7 +821,10 @@ let TryDemangleGenericNameAndPos (n: string) = while res && i < n.Length do let char = n[i] - if not (char >= '0' && char <= '9') then res <- false + + if not (char >= '0' && char <= '9') then + res <- false + i <- i + 1 if res then ValueSome pos else ValueNone diff --git a/src/Compiler/SyntaxTree/XmlDoc.fs b/src/Compiler/SyntaxTree/XmlDoc.fs index 81dbde3ca22..72c657d2911 100644 --- a/src/Compiler/SyntaxTree/XmlDoc.fs +++ b/src/Compiler/SyntaxTree/XmlDoc.fs @@ -262,7 +262,10 @@ type PreXmlDoc = let lines = Array.map fst preLines let m = Array.reduce unionRanges (Array.map snd preLines) let doc = XmlDoc(lines, m) - if check then doc.Check(paramNamesOpt) + + if check then + doc.Check(paramNamesOpt) + doc member internal x.Range = diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 3b328134868..2d3f8c0943f 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2488,6 +2488,9 @@ type ValOptionalData = /// Used to implement [] mutable val_defn: Expr option + /// Records the "extra information" for a value compiled as a method (rather + /// than a closure or a local), including argument names, attributes etc. + // // MUTABILITY CLEANUP: mutability of this field is used by // -- adjustAllUsesOfRecValue // -- TLR optimizations @@ -2497,6 +2500,10 @@ type ValOptionalData = // type-checked expression. mutable val_repr_info: ValReprInfo option + /// Records the "extra information" for display purposes for expression-level function definitions + /// that may be compiled as closures (that is are not necessarily compiled as top-level methods). + mutable val_repr_info_for_display: ValReprInfo option + /// How visible is this? /// MUTABILITY: for unpickle linkage mutable val_access: Accessibility @@ -2556,6 +2563,7 @@ type Val = val_const = None val_defn = None val_repr_info = None + val_repr_info_for_display = None val_access = TAccess [] val_xmldoc = XmlDoc.Empty val_member_info = None @@ -2620,6 +2628,11 @@ type Val = | Some optData -> optData.val_repr_info | _ -> None + member x.ValReprInfoForDisplay: ValReprInfo option = + match x.val_opt_data with + | Some optData -> optData.val_repr_info_for_display + | _ -> None + member x.Id = ident(x.LogicalName, x.Range) /// Is this represented as a "top level" static binding (i.e. a static field, static member, @@ -2998,6 +3011,11 @@ type Val = | Some optData -> optData.val_repr_info <- info | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_repr_info = info } + member x.SetValReprInfoForDisplay info = + match x.val_opt_data with + | Some optData -> optData.val_repr_info_for_display <- info + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_repr_info_for_display = info } + member x.SetType ty = x.val_type <- ty member x.SetOtherRange m = @@ -3055,6 +3073,7 @@ type Val = val_other_range = tg.val_other_range val_const = tg.val_const val_defn = tg.val_defn + val_repr_info_for_display = tg.val_repr_info_for_display val_repr_info = tg.val_repr_info val_access = tg.val_access val_xmldoc = tg.val_xmldoc diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index d2a23e73038..cdcf93e4518 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1777,8 +1777,15 @@ type ValOptionalData = /// What is the original, unoptimized, closed-term definition, if any? /// Used to implement [] mutable val_defn: Expr option + + /// Records the "extra information" for a value compiled as a method (rather + /// than a closure or a local), including argument names, attributes etc. mutable val_repr_info: ValReprInfo option + /// Records the "extra information" for display purposes for expression-level function definitions + /// that may be compiled as closures (that is are not necessarily compiled as top-level methods). + mutable val_repr_info_for_display: ValReprInfo option + /// How visible is this? /// MUTABILITY: for unpickle linkage mutable val_access: Accessibility @@ -1888,6 +1895,8 @@ type Val = member SetValReprInfo: info: ValReprInfo option -> unit + member SetValReprInfoForDisplay: info: ValReprInfo option -> unit + override ToString: unit -> string /// How visible is this value, function or member? @@ -2134,6 +2143,10 @@ type Val = /// represent as "top level" bindings. member ValReprInfo: ValReprInfo option + /// Records the "extra information" for display purposes for expression-level function definitions + /// that may be compiled as closures (that is are not necessarily compiled as top-level methods). + member ValReprInfoForDisplay: ValReprInfo option + /// Get the declared documentation for the value member XmlDoc: XmlDoc diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index b0020664ff7..1ec0b619604 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -26,7 +26,7 @@ let getNameOfScopeRef sref = | ILScopeRef.Assembly aref -> aref.Name | ILScopeRef.PrimaryAssembly -> "" -/// Metadata on values (names of arguments etc. +/// Metadata on values (names of arguments etc.) module ValReprInfo = let unnamedTopArg1: ArgReprInfo = { Attribs=[]; Name=None } @@ -41,6 +41,11 @@ module ValReprInfo = let emptyValData = ValReprInfo([], [], unnamedRetVal) + let IsEmpty info = + match info with + | ValReprInfo([], [], { Attribs = []; Name=None }) -> true + | _ -> false + let InferTyparInfo (tps: Typar list) = tps |> List.map (fun tp -> TyparReprInfo(tp.Id, tp.Kind)) let InferArgReprInfo (v: Val) : ArgReprInfo = { Attribs = []; Name= Some v.Id } @@ -59,7 +64,18 @@ let typesOfVals (v: Val list) = v |> List.map (fun v -> v.Type) let nameOfVal (v: Val) = v.LogicalName -let arityOfVal (v: Val) = (match v.ValReprInfo with None -> ValReprInfo.emptyValData | Some arities -> arities) +let arityOfVal (v: Val) = + match v.ValReprInfo with + | None -> ValReprInfo.emptyValData + | Some info -> info + +let arityOfValForDisplay (v: Val) = + match v.ValReprInfoForDisplay with + | Some info -> info + | None -> + match v.ValReprInfo with + | None -> ValReprInfo.emptyValData + | Some info -> info let tupInfoRef = TupInfo.Const false diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fsi b/src/Compiler/TypedTree/TypedTreeBasics.fsi index 246a9e74baa..fe4930a71d7 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fsi +++ b/src/Compiler/TypedTree/TypedTreeBasics.fsi @@ -29,6 +29,8 @@ module ValReprInfo = val emptyValData: ValReprInfo + val IsEmpty: ValReprInfo -> bool + val InferTyparInfo: tps: Typar list -> TyparReprInfo list val InferArgReprInfo: v: Val -> ArgReprInfo @@ -45,6 +47,8 @@ val nameOfVal: v: Val -> string val arityOfVal: v: Val -> ValReprInfo +val arityOfValForDisplay: v: Val -> ValReprInfo + val tupInfoRef: TupInfo val tupInfoStruct: TupInfo diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index fd00a1f94bd..cef7fe70b74 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -5359,7 +5359,8 @@ let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttri (ids, attribs) ||> List.map2 (fun id attribs -> { Name = id; Attribs = attribs }: ArgReprInfo )) let retInfo: ArgReprInfo = { Attribs = retAttribs; Name = None } - ValReprInfo (ValReprInfo.InferTyparInfo tps, curriedArgInfos, retInfo) + let info = ValReprInfo (ValReprInfo.InferTyparInfo tps, curriedArgInfos, retInfo) + if ValReprInfo.IsEmpty info then ValReprInfo.emptyValData else info let InferArityOfExprBinding g allowTypeDirectedDetupling (v: Val) expr = match v.ValReprInfo with diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index eda40c33fb5..3f5ba37afde 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -2353,6 +2353,7 @@ and u_ValData st = val_other_range = (match x1a with None -> None | Some(_, b) -> Some(b, true)) val_defn = None val_repr_info = x10 + val_repr_info_for_display = None val_const = x14 val_access = x13 val_xmldoc = defaultArg x15 XmlDoc.Empty diff --git a/src/Compiler/Utilities/FileSystem.fs b/src/Compiler/Utilities/FileSystem.fs index 465adeac51d..bdd64e87b69 100644 --- a/src/Compiler/Utilities/FileSystem.fs +++ b/src/Compiler/Utilities/FileSystem.fs @@ -127,7 +127,8 @@ type ByteArrayMemory(bytes: byte[], offset, length) = ByteArrayMemory(Array.empty, 0, 0) :> ByteMemory override _.CopyTo stream = - if length > 0 then stream.Write(bytes, offset, length) + if length > 0 then + stream.Write(bytes, offset, length) override _.Copy(srcOffset, dest, destOffset, count) = checkCount count @@ -412,7 +413,8 @@ module internal FileSystemUtils = let checkSuffix (path: string) (suffix: string) = path.EndsWithOrdinalIgnoreCase(suffix) let hasExtensionWithValidate (validate: bool) (s: string) = - if validate then (checkPathForIllegalChars s) + if validate then + (checkPathForIllegalChars s) let sLen = s.Length @@ -437,7 +439,8 @@ module internal FileSystemUtils = Path.GetFileName(path) let fileNameWithoutExtensionWithValidate (validate: bool) path = - if validate then checkPathForIllegalChars path + if validate then + checkPathForIllegalChars path Path.GetFileNameWithoutExtension(path) @@ -563,7 +566,8 @@ type DefaultFileSystem() as this = let stream = new MemoryMappedStream(mmf, length) - if not stream.CanRead then invalidOp "Cannot read file" + if not stream.CanRead then + invalidOp "Cannot read file" stream :> Stream @@ -881,7 +885,8 @@ type internal ByteStream = } member b.ReadByte() = - if b.pos >= b.max then failwith "end of stream" + if b.pos >= b.max then + failwith "end of stream" let res = b.bytes[b.pos] b.pos <- b.pos + 1 @@ -948,7 +953,8 @@ type internal ByteBuffer = Bytes.blit old 0 buf.bbArray 0 buf.bbCurrent - if buf.useArrayPool then ArrayPool.Shared.Return old + if buf.useArrayPool then + ArrayPool.Shared.Return old member buf.AsMemory() = buf.CheckDisposed() diff --git a/src/Compiler/Utilities/HashMultiMap.fs b/src/Compiler/Utilities/HashMultiMap.fs index cb750676fe3..b88af5d77eb 100644 --- a/src/Compiler/Utilities/HashMultiMap.fs +++ b/src/Compiler/Utilities/HashMultiMap.fs @@ -170,7 +170,8 @@ type internal HashMultiMap<'Key, 'Value>(size: int, comparer: IEqualityComparer< member s.Remove(x) = match s.TryFind x.Key with | Some v -> - if Unchecked.equals v x.Value then s.Remove(x.Key) + if Unchecked.equals v x.Value then + s.Remove(x.Key) true | _ -> false diff --git a/src/Compiler/Utilities/ImmutableArray.fs b/src/Compiler/Utilities/ImmutableArray.fs index 5311efa5e0c..985799856c0 100644 --- a/src/Compiler/Utilities/ImmutableArray.fs +++ b/src/Compiler/Utilities/ImmutableArray.fs @@ -18,7 +18,8 @@ module ImmutableArray = | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(f 0) | n -> - if n < 0 then invalidArg "n" "Below zero." + if n < 0 then + invalidArg "n" "Below zero." let builder = ImmutableArray.CreateBuilder(n) @@ -180,7 +181,8 @@ module ImmutableArray = let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do - if predicate arr[i] then builder.Add(arr[i]) + if predicate arr[i] then + builder.Add(arr[i]) builder.Capacity <- builder.Count builder.MoveToImmutable() @@ -199,7 +201,8 @@ module ImmutableArray = for i = 0 to arr.Length - 1 do let result = chooser arr[i] - if result.IsSome then builder.Add(result.Value) + if result.IsSome then + builder.Add(result.Value) builder.Capacity <- builder.Count builder.MoveToImmutable() diff --git a/src/Compiler/Utilities/ResizeArray.fs b/src/Compiler/Utilities/ResizeArray.fs index e96c775f972..cd6e405129c 100644 --- a/src/Compiler/Utilities/ResizeArray.fs +++ b/src/Compiler/Utilities/ResizeArray.fs @@ -26,7 +26,8 @@ module internal ResizeArray = if start2 < 0 then invalidArg "start2" "index must be positive" - if len < 0 then invalidArg "len" "length must be positive" + if len < 0 then + invalidArg "len" "length must be positive" if start1 + len > length arr1 then invalidArg "start1" "(start1+len) out of range" @@ -52,7 +53,8 @@ module internal ResizeArray = if start < 0 then invalidArg "start" "index must be positive" - if len < 0 then invalidArg "len" "length must be positive" + if len < 0 then + invalidArg "len" "length must be positive" if start + len > length arr then invalidArg "len" "length must be positive" @@ -63,7 +65,8 @@ module internal ResizeArray = if start < 0 then invalidArg "start" "index must be positive" - if len < 0 then invalidArg "len" "length must be positive" + if len < 0 then + invalidArg "len" "length must be positive" if start + len > length arr then invalidArg "len" "length must be positive" @@ -203,7 +206,9 @@ module internal ResizeArray = for i = 0 to length arr - 1 do let x = arr[i] - if f x then res.Add(x) + + if f x then + res.Add(x) res diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 7d99073da91..3c1172aec7d 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -199,7 +199,8 @@ module Array = let mutable i = 0 while eq && i < len do - if not (inp[i] === res[i]) then eq <- false + if not (inp[i] === res[i]) then + eq <- false i <- i + 1 @@ -1082,9 +1083,11 @@ type MemoizationTable<'T, 'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer< let table = new ConcurrentDictionary<'T, 'U>(keyComparer) member t.Apply x = - if (match canMemoize with - | None -> true - | Some f -> f x) then + if + (match canMemoize with + | None -> true + | Some f -> f x) + then match table.TryGetValue x with | true, res -> res | _ -> diff --git a/src/Compiler/Utilities/range.fs b/src/Compiler/Utilities/range.fs index 035a5de80f4..bbd6a9f0673 100755 --- a/src/Compiler/Utilities/range.fs +++ b/src/Compiler/Utilities/range.fs @@ -343,9 +343,11 @@ type Range(code1: int64, code2: int64) = member m.DebugCode = let name = m.FileName - if name = unknownFileName - || name = startupFileName - || name = commandLineArgsFileName then + if + name = unknownFileName + || name = startupFileName + || name = commandLineArgsFileName + then name else @@ -460,20 +462,26 @@ module Range = else // If all identical then return m1. This preserves NotedSourceConstruct when no merging takes place - if m1.Code1 = m2.Code1 && m1.Code2 = m2.Code2 then + if + m1.Code1 = m2.Code1 && m1.Code2 = m2.Code2 + then m1 else let start = - if (m1.StartLine > m2.StartLine - || (m1.StartLine = m2.StartLine && m1.StartColumn > m2.StartColumn)) then + if + (m1.StartLine > m2.StartLine + || (m1.StartLine = m2.StartLine && m1.StartColumn > m2.StartColumn)) + then m2 else m1 let finish = - if (m1.EndLine > m2.EndLine - || (m1.EndLine = m2.EndLine && m1.EndColumn > m2.EndColumn)) then + if + (m1.EndLine > m2.EndLine + || (m1.EndLine = m2.EndLine && m1.EndColumn > m2.EndColumn)) + then m1 else m2 diff --git a/src/Compiler/Utilities/sformat.fs b/src/Compiler/Utilities/sformat.fs index 2c2a4096573..42b13e28ff9 100644 --- a/src/Compiler/Utilities/sformat.fs +++ b/src/Compiler/Utilities/sformat.fs @@ -632,7 +632,8 @@ module Display = Breaks(next + 1, outer, stack) let popBreak (Breaks (next, outer, stack)) = - if next = 0 then raise (Failure "popBreak: underflow") + if next = 0 then + raise (Failure "popBreak: underflow") let topBroke = stack[next - 1] < 0 @@ -1312,12 +1313,14 @@ module Display = let possibleKeyValueL v = let tyv = v.GetType() - if word = "map" - && (match v with - | null -> false - | _ -> true) - && tyv.IsGenericType - && tyv.GetGenericTypeDefinition() = typedefof> then + if + word = "map" + && (match v with + | null -> false + | _ -> true) + && tyv.IsGenericType + && tyv.GetGenericTypeDefinition() = typedefof> + then nestedObjL depthLim Precedence.BracketIfTuple @@ -1529,8 +1532,10 @@ module Display = "-infinity" elif Double.IsPositiveInfinity(d) then "infinity" - elif opts.FloatingPointFormat[0] = 'g' - && String.forall (fun c -> Char.IsDigit(c) || c = '-') s then + elif + opts.FloatingPointFormat[0] = 'g' + && String.forall (fun c -> Char.IsDigit(c) || c = '-') s + then s + ".0" else s @@ -1545,11 +1550,13 @@ module Display = "-infinity" elif Single.IsPositiveInfinity(d) then "infinity" - elif opts.FloatingPointFormat.Length >= 1 - && opts.FloatingPointFormat[0] = 'g' - && float32 (Int32.MinValue) < d - && d < float32 (Int32.MaxValue) - && float32 (int32 (d)) = d then + elif + opts.FloatingPointFormat.Length >= 1 + && opts.FloatingPointFormat[0] = 'g' + && float32 (Int32.MinValue) < d + && d < float32 (Int32.MaxValue) + && float32 (int32 (d)) = d + then (Convert.ToInt32 d).ToString(opts.FormatProvider) + ".0" else d.ToString(opts.FloatingPointFormat, opts.FormatProvider)) diff --git a/src/FSharp.Build/FSharpEmbedResXSource.fs b/src/FSharp.Build/FSharpEmbedResXSource.fs index 39d44f052eb..4b34660b2a8 100644 --- a/src/FSharp.Build/FSharpEmbedResXSource.fs +++ b/src/FSharp.Build/FSharpEmbedResXSource.fs @@ -41,9 +41,11 @@ module internal {1} = let sourcePath = Path.Combine(_outputPath, justFileName + ".fs") // simple up-to-date check - if File.Exists(resx) - && File.Exists(sourcePath) - && File.GetLastWriteTimeUtc(resx) <= File.GetLastWriteTimeUtc(sourcePath) then + if + File.Exists(resx) + && File.Exists(sourcePath) + && File.GetLastWriteTimeUtc(resx) <= File.GetLastWriteTimeUtc(sourcePath) + then printMessage (sprintf "Skipping generation: '%s' since it is up-to-date." sourcePath) Some(sourcePath) else diff --git a/src/FSharp.Core/QueryExtensions.fs b/src/FSharp.Core/QueryExtensions.fs index f9d0ffd72fb..220618ae563 100644 --- a/src/FSharp.Core/QueryExtensions.fs +++ b/src/FSharp.Core/QueryExtensions.fs @@ -212,7 +212,7 @@ module internal Adapters = type ConversionDescription = | TupleConv of ConversionDescription list | RecordConv of Type * ConversionDescription list - | GroupingConv (* origKeyType: *) of Type (* origElemType: *) * Type * ConversionDescription + | GroupingConv (* origKeyType: *) of Type (* origElemType: *) * Type * ConversionDescription | SeqConv of ConversionDescription | NoConv diff --git a/src/FSharp.Core/array.fs b/src/FSharp.Core/array.fs index 1dff8103bda..8c2fa8470fa 100644 --- a/src/FSharp.Core/array.fs +++ b/src/FSharp.Core/array.fs @@ -17,7 +17,8 @@ open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators module Array = let inline checkNonNull argName arg = - if isNull arg then nullArg argName + if isNull arg then + nullArg argName let inline indexNotFound () = raise (KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt))) @@ -1601,7 +1602,9 @@ module Array = for i = 1 to array.Length - 1 do let curr = array.[i] - if curr < acc then acc <- curr + + if curr < acc then + acc <- curr acc @@ -1636,7 +1639,9 @@ module Array = for i = 1 to array.Length - 1 do let curr = array.[i] - if curr > acc then acc <- curr + + if curr > acc then + acc <- curr acc diff --git a/src/FSharp.Core/async.fs b/src/FSharp.Core/async.fs index 46cd93a84ee..e907040c94c 100644 --- a/src/FSharp.Core/async.fs +++ b/src/FSharp.Core/async.fs @@ -412,7 +412,8 @@ type AsyncActivation<'T>(contents: AsyncActivationContents<'T>) = ok <- true res finally - if not ok then ctxt.OnExceptionRaised() + if not ok then + ctxt.OnExceptionRaised() member ctxt.PostWithTrampoline (syncCtxt: SynchronizationContext) (f: unit -> AsyncReturn) = let holder = contents.aux.trampolineHolder @@ -486,7 +487,8 @@ module AsyncPrimitives = result <- userCode arg ok <- true finally - if not ok then ctxt.OnExceptionRaised() + if not ok then + ctxt.OnExceptionRaised() if ok then AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.cont result @@ -508,7 +510,8 @@ module AsyncPrimitives = result <- part2 result1 ok <- true finally - if not ok then ctxt.OnExceptionRaised() + if not ok then + ctxt.OnExceptionRaised() if ok then Invoke result ctxt @@ -525,7 +528,8 @@ module AsyncPrimitives = res <- userCode result1 ok <- true finally - if not ok then ctxt.OnExceptionRaised() + if not ok then + ctxt.OnExceptionRaised() if ok then res.Invoke ctxt else fake () @@ -543,7 +547,8 @@ module AsyncPrimitives = resOpt <- filterFunction (edi.GetAssociatedSourceException()) ok <- true finally - if not ok then ctxt.OnExceptionRaised() + if not ok then + ctxt.OnExceptionRaised() if ok then match resOpt with @@ -990,7 +995,9 @@ module AsyncPrimitives = else // In this case the ResultCell has already been disposed, e.g. due to a timeout. // The result is dropped on the floor. - if disposed then + if + disposed + then [] else result <- Some res diff --git a/src/FSharp.Core/eventmodule.fs b/src/FSharp.Core/eventmodule.fs index cd9dc68a76d..fc3c2eabd64 100644 --- a/src/FSharp.Core/eventmodule.fs +++ b/src/FSharp.Core/eventmodule.fs @@ -22,7 +22,11 @@ module Event = [] let filter predicate (sourceEvent: IEvent<'Delegate, 'T>) = let ev = new Event<_>() - sourceEvent.Add(fun x -> if predicate x then ev.Trigger x) + + sourceEvent.Add(fun x -> + if predicate x then + ev.Trigger x) + ev.Publish [] diff --git a/src/FSharp.Core/list.fs b/src/FSharp.Core/list.fs index fbf8089610d..e0dff3d7adb 100644 --- a/src/FSharp.Core/list.fs +++ b/src/FSharp.Core/list.fs @@ -15,7 +15,8 @@ open System.Collections.Generic module List = let inline checkNonNull argName arg = - if isNull arg then nullArg argName + if isNull arg then + nullArg argName let inline indexNotFound () = raise (KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt))) @@ -742,7 +743,8 @@ module List = let mutable acc = h for x in t do - if x > acc then acc <- x + if x > acc then + acc <- x acc @@ -771,7 +773,8 @@ module List = let mutable acc = h for x in t do - if x < acc then acc <- x + if x < acc then + acc <- x acc @@ -910,7 +913,9 @@ module List = match curr with | [] -> invalidArg "index" "index must be within bounds of the list" | h :: t -> - if i < index then coll.Add(h) //items before index we keep + if i < index then + coll.Add(h) //items before index we keep + curr <- t i <- i + 1 diff --git a/src/FSharp.Core/map.fs b/src/FSharp.Core/map.fs index 0d510239f32..9fad005450e 100644 --- a/src/FSharp.Core/map.fs +++ b/src/FSharp.Core/map.fs @@ -1040,7 +1040,8 @@ and KeyCollection<'Key, 'Value when 'Key: comparison>(parent: Map<'Key, 'Value>) parent.ContainsKey x member _.CopyTo(arr, index) = - if isNull arr then nullArg "arr" + if isNull arr then + nullArg "arr" if index < 0 then invalidArg "index" "index must be positive" @@ -1090,7 +1091,8 @@ and ValueCollection<'Key, 'Value when 'Key: comparison>(parent: Map<'Key, 'Value parent.Exists(fun _ value -> Unchecked.equals value x) member _.CopyTo(arr, index) = - if isNull arr then nullArg "arr" + if isNull arr then + nullArg "arr" if index < 0 then invalidArg "index" "index must be positive" diff --git a/src/FSharp.Core/observable.fs b/src/FSharp.Core/observable.fs index d1bcd160313..eb34c62c850 100644 --- a/src/FSharp.Core/observable.fs +++ b/src/FSharp.Core/observable.fs @@ -12,11 +12,12 @@ open Microsoft.FSharp.Control module Observable = let inline protect f succeed fail = - match (try - Choice1Of2(f ()) - with e -> - Choice2Of2 e) - with + match + (try + Choice1Of2(f ()) + with e -> + Choice2Of2 e) + with | Choice1Of2 x -> (succeed x) | Choice2Of2 e -> (fail e) @@ -34,7 +35,8 @@ module Observable = interface IObserver<'T> with member x.OnNext value = - if not stopped then x.Next value + if not stopped then + x.Next value member x.OnError e = if not stopped then @@ -166,7 +168,8 @@ module Observable = source1.Subscribe { new IObserver<'T> with member x.OnNext(v) = - if not stopped then observer.OnNext v + if not stopped then + observer.OnNext v member x.OnError(e) = if not stopped then @@ -186,7 +189,8 @@ module Observable = source2.Subscribe { new IObserver<'T> with member x.OnNext(v) = - if not stopped then observer.OnNext v + if not stopped then + observer.OnNext v member x.OnError(e) = if not stopped then diff --git a/src/FSharp.Core/quotations.fs b/src/FSharp.Core/quotations.fs index a309d9c1816..54ca7e2e3c4 100644 --- a/src/FSharp.Core/quotations.fs +++ b/src/FSharp.Core/quotations.fs @@ -1469,9 +1469,11 @@ module Patterns = else // If a known-number-of-arguments-including-object-argument has been given then check that - if (match knownArgCount with - | ValueNone -> false - | ValueSome n -> n <> (if methInfo.IsStatic then 0 else 1) + nargTs) then + if + (match knownArgCount with + | ValueNone -> false + | ValueSome n -> n <> (if methInfo.IsStatic then 0 else 1) + nargTs) + then false else diff --git a/src/FSharp.Core/reflect.fs b/src/FSharp.Core/reflect.fs index 4bc089765fb..76dbb87c490 100644 --- a/src/FSharp.Core/reflect.fs +++ b/src/FSharp.Core/reflect.fs @@ -1172,10 +1172,12 @@ type FSharpType = // No assembly passed therefore just get framework local version of Tuple let asm = typeof.Assembly - if types - |> Array.exists (function - | null -> true - | _ -> false) then + if + types + |> Array.exists (function + | null -> true + | _ -> false) + then invalidArg "types" (SR.GetString(SR.nullsNotAllowedInArray)) mkTupleType false asm types @@ -1183,10 +1185,12 @@ type FSharpType = static member MakeTupleType(asm: Assembly, types: Type[]) = checkNonNull "types" types - if types - |> Array.exists (function - | null -> true - | _ -> false) then + if + types + |> Array.exists (function + | null -> true + | _ -> false) + then invalidArg "types" (SR.GetString(SR.nullsNotAllowedInArray)) mkTupleType false asm types @@ -1194,10 +1198,12 @@ type FSharpType = static member MakeStructTupleType(asm: Assembly, types: Type[]) = checkNonNull "types" types - if types - |> Array.exists (function - | null -> true - | _ -> false) then + if + types + |> Array.exists (function + | null -> true + | _ -> false) + then invalidArg "types" (SR.GetString(SR.nullsNotAllowedInArray)) mkTupleType true asm types diff --git a/src/FSharp.Core/seq.fs b/src/FSharp.Core/seq.fs index b04ecfa3ec8..18d89ce07f7 100644 --- a/src/FSharp.Core/seq.fs +++ b/src/FSharp.Core/seq.fs @@ -214,7 +214,9 @@ module Internal = member _.Current = box (get ()) member _.MoveNext() = - if not started then started <- true + if not started then + started <- true + curr <- None while (curr.IsNone && e.MoveNext()) do @@ -244,7 +246,9 @@ module Internal = member _.MoveNext() = let rec next () = - if not started then started <- true + if not started then + started <- true + e.MoveNext() && (f e.Current || next ()) next () @@ -304,7 +308,8 @@ module Internal = current <- (Unchecked.defaultof<_>) // cache node unprimed, initialised on demand. let getCurrent () = - if index = unstarted then notStarted () + if index = unstarted then + notStarted () if index = completed then alreadyFinished () @@ -507,7 +512,8 @@ module Internal = interface System.IDisposable with member _.Dispose() = - if not finished then disposeG g + if not finished then + disposeG g // Internal type, used to optimize Enumerator/Generator chains type LazyGeneratorWrappingEnumerator<'T>(e: IEnumerator<'T>) = @@ -791,7 +797,9 @@ module Seq = while (Option.isNone res && e.MoveNext()) do let c = e.Current - if predicate c then res <- Some c + + if predicate c then + res <- Some c res @@ -1316,7 +1324,8 @@ module Seq = let hashSet = HashSet<'T>(HashIdentity.Structural<'T>) for v in source do - if hashSet.Add v then yield v + if hashSet.Add v then + yield v } [] @@ -1484,7 +1493,9 @@ module Seq = while e.MoveNext() do let curr = e.Current - if curr < acc then acc <- curr + + if curr < acc then + acc <- curr acc @@ -1522,7 +1533,9 @@ module Seq = while e.MoveNext() do let curr = e.Current - if curr > acc then acc <- curr + + if curr > acc then + acc <- curr acc @@ -1593,8 +1606,10 @@ module Seq = let mutable ok = false while e.MoveNext() do - if (latest <- e.Current - (ok || not (predicate latest))) then + if + (latest <- e.Current + (ok || not (predicate latest))) + then ok <- true yield latest } @@ -1741,11 +1756,15 @@ module Seq = if e.MoveNext() then let cached = HashSet(itemsToExclude, HashIdentity.Structural) let next = e.Current - if cached.Add next then yield next + + if cached.Add next then + yield next while e.MoveNext() do let next = e.Current - if cached.Add next then yield next + + if cached.Add next then + yield next } [] @@ -1794,7 +1813,9 @@ module Seq = let mutable i = 0 for item in source do - if i <> index then yield item + if i <> index then + yield item + i <- i + 1 if i <= index then @@ -1848,11 +1869,14 @@ module Seq = let mutable i = 0 for item in source do - if i = index then yield value + if i = index then + yield value + yield item i <- i + 1 - if i = index then yield value + if i = index then + yield value if i < index then invalidArg "index" "index must be within bounds of the array" @@ -1867,11 +1891,14 @@ module Seq = let mutable i = 0 for item in source do - if i = index then yield! values + if i = index then + yield! values + yield item i <- i + 1 - if i = index then yield! values // support inserting at the end + if i = index then + yield! values // support inserting at the end if i < index then invalidArg "index" "index must be within bounds of the array" diff --git a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs index 6d2a990efc2..8a1b526837a 100644 --- a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs +++ b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs @@ -308,7 +308,9 @@ module internal Utilities = // Use enabled feeds only (see NuGet.Commands.ListSourceRunner.Run) and strip off the flags. if source.Length > 0 && source.[0] = 'E' then let pos = source.IndexOf(" ") - if pos >= 0 then "i", source.Substring(pos).Trim() + + if pos >= 0 then + "i", source.Substring(pos).Trim() } let computeSha256HashOfBytes (bytes: byte[]) : byte[] = SHA256.Create().ComputeHash(bytes) diff --git a/src/fsc/fscmain.fs b/src/fsc/fscmain.fs index 9eae6cba0e4..ebdf21af60d 100644 --- a/src/fsc/fscmain.fs +++ b/src/fsc/fscmain.fs @@ -26,8 +26,10 @@ let main (argv) = let compilerName = // the 64 bit desktop version of the compiler is name fscAnyCpu.exe, all others are fsc.exe - if Environment.Is64BitProcess - && typeof.Assembly.GetName().Name <> "System.Private.CoreLib" then + if + Environment.Is64BitProcess + && typeof.Assembly.GetName().Name <> "System.Private.CoreLib" + then "fscAnyCpu.exe" else "fsc.exe" diff --git a/src/fsi/console.fs b/src/fsi/console.fs index 05f242990b2..b64849394d3 100644 --- a/src/fsi/console.fs +++ b/src/fsi/console.fs @@ -247,8 +247,10 @@ type internal ReadLineConsole() = checkLeftEdge false let writeChar (c) = - if Console.CursorTop = Console.BufferHeight - 1 - && Console.CursorLeft = Console.BufferWidth - 1 then + if + Console.CursorTop = Console.BufferHeight - 1 + && Console.CursorLeft = Console.BufferWidth - 1 + then //printf "bottom right!\n" anchor <- { anchor with top = (anchor).top - 1 } @@ -278,7 +280,8 @@ type internal ReadLineConsole() = let mutable position = -1 for i = 0 to input.Length - 1 do - if (i = curr) then position <- output.Length + if (i = curr) then + position <- output.Length let c = input.Chars(i) @@ -287,7 +290,8 @@ type internal ReadLineConsole() = else output.Append(c) |> ignore - if (curr = input.Length) then position <- output.Length + if (curr = input.Length) then + position <- output.Length // render the current text, computing a new value for "rendered" let old_rendered = rendered @@ -419,7 +423,8 @@ type internal ReadLineConsole() = if (line = "\x1A") then null else - if (line.Length > 0) then history.AddLast(line) + if (line.Length > 0) then + history.AddLast(line) line diff --git a/src/fsi/fsimain.fs b/src/fsi/fsimain.fs index b94a152c171..ae6513f00cc 100644 --- a/src/fsi/fsimain.fs +++ b/src/fsi/fsimain.fs @@ -411,8 +411,10 @@ let MainMain argv = || x = "/shadowcopyreferences+" || x = "--shadowcopyreferences+") - if AppDomain.CurrentDomain.IsDefaultAppDomain() - && argv |> Array.exists isShadowCopy then + if + AppDomain.CurrentDomain.IsDefaultAppDomain() + && argv |> Array.exists isShadowCopy + then let setupInformation = AppDomain.CurrentDomain.SetupInformation setupInformation.ShadowCopyFiles <- "true" let helper = AppDomain.CreateDomain("FSI_Domain", null, setupInformation) diff --git a/tests/scripts/identifierAnalysisByType.fsx b/tests/scripts/identifierAnalysisByType.fsx new file mode 100644 index 00000000000..7ac8de7a20b --- /dev/null +++ b/tests/scripts/identifierAnalysisByType.fsx @@ -0,0 +1,152 @@ +// Print some stats about identifiers grouped by type +// + +#r "nuget: Ionide.ProjInfo" +#I @"..\..\artifacts\bin\fsc\Debug\net6.0\" +#r "FSharp.Compiler.Service.dll" + +open System +open System.IO +open Ionide.ProjInfo +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.Symbols +open Ionide.ProjInfo.Types + +let argv = fsi.CommandLineArgs + +if argv.Length = 1 then + eprintfn "usage:" + eprintfn " dotnet fsi tests/scripts/identifierAnalysisByType.fsx " + eprintfn "" + eprintfn "examples:" + eprintfn " dotnet fsi tests/scripts/identifierAnalysisByType.fsx src/FSharp.Build/FSharp.Build.fsproj" + eprintfn " dotnet fsi tests/scripts/identifierAnalysisByType.fsx src/Compiler/FSharp.Compiler.Service.fsproj" + eprintfn "" + eprintfn "Sample output is at https://gist.github.com/dsyme/abfa11bebf0713251418906d55c08804" + +//let projectFile = Path.Combine(__SOURCE_DIRECTORY__, @"..\..\src\Compiler\FSharp.Compiler.Service.fsproj") +//let projectFile = Path.Combine(__SOURCE_DIRECTORY__, @"..\..\src\FSharp.Build\FSharp.Build.fsproj") +let projectFile = Path.GetFullPath(argv[1]) + +let cwd = System.Environment.CurrentDirectory |> System.IO.DirectoryInfo + +let _toolsPath = Init.init cwd None + +printfn "Cracking project options...." +let opts = + match ProjectLoader.getProjectInfo projectFile [] BinaryLogGeneration.Off [] with + | Result.Ok res -> res + | Result.Error err -> failwithf "%s" err + +let checker = FSharpChecker.Create() + +let checkerOpts = checker.GetProjectOptionsFromCommandLineArgs(projectFile, [| yield! opts.SourceFiles; yield! opts.OtherOptions |] ) + +printfn "Checking project...." +let results = checker.ParseAndCheckProject(checkerOpts) |> Async.RunSynchronously + +printfn "Grouping symbol uses...." +let symbols = results.GetAllUsesOfAllSymbols() + +let rec stripTy (ty: FSharpType) = + if ty.IsAbbreviation then stripTy ty.AbbreviatedType else ty + +let getTypeText (sym: FSharpMemberOrFunctionOrValue) = + let ty = stripTy sym.FullType + FSharpType.Prettify(ty).Format(FSharpDisplayContext.Empty) + +symbols +|> Array.choose (fun vUse -> match vUse.Symbol with :? FSharpMemberOrFunctionOrValue as v -> Some (v, vUse.Range) | _ -> None) +|> Array.filter (fun (v, _) -> v.GenericParameters.Count = 0) +|> Array.filter (fun (v, _) -> v.CurriedParameterGroups.Count = 0) +|> Array.filter (fun (v, _) -> not v.FullType.IsGenericParameter) +|> Array.map (fun (v, vUse) -> getTypeText v, v, vUse) +|> Array.filter (fun (vTypeText, v, _) -> + match vTypeText with + | "System.String" -> false + | "System.Boolean" -> false + | "System.Int32" -> false + | "System.Int64" -> false + | "System.Object" -> false + | "Microsoft.FSharp.Collections.List" -> false + | "Microsoft.FSharp.Core.Option" -> false + | s when s.EndsWith(" Microsoft.FSharp.Core.[]") -> false // for now filter array types + | _ when v.DisplayName.StartsWith "_" -> false + | _ -> true) +|> Array.groupBy (fun (vTypeText, _, _) -> vTypeText) +|> Array.map (fun (key, g) -> + key, + (g + |> Array.groupBy (fun (_, v, _) -> v.DisplayName) + |> Array.sortByDescending (snd >> Array.length))) +|> Array.filter (fun (_, g) -> g.Length > 1) +|> Array.sortByDescending (fun (key, g) -> Array.length g) +|> Array.iter (fun (key, g) -> + let key = key.Replace("Microsoft.FSharp", "FSharp").Replace("FSharp.Core.", "") + printfn "Type: %s" key + for (nm, entries) in g do + printfn " %s (%d times)" nm (Array.length entries) + for (_, _, vUse) in entries do + printfn " %s" (vUse.ToString()) + printfn "") + +(* +let isWindows = RuntimeInformation.IsOSPlatform(OSPlatform.Windows) + +let dotnet = + if isWindows then + "dotnet.exe" + else + "dotnet" +let fileExists pathToFile = + try + File.Exists(pathToFile) + with _ -> + false +// Look for global install of dotnet sdk +let getDotnetGlobalHostPath () = + let pf = Environment.GetEnvironmentVariable("ProgramW6432") + + let pf = + if String.IsNullOrEmpty(pf) then + Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + else + pf + + let candidate = Path.Combine(pf, "dotnet", dotnet) + + if fileExists candidate then + Some candidate + else + // Can't find it --- give up + None + +let getDotnetHostPath () = + let probePathForDotnetHost () = + let paths = + let p = Environment.GetEnvironmentVariable("PATH") + + if not (isNull p) then + p.Split(Path.PathSeparator) + else + [||] + + paths |> Array.tryFind (fun f -> fileExists (Path.Combine(f, dotnet))) + + match (Environment.GetEnvironmentVariable("DOTNET_HOST_PATH")) with + // Value set externally + | value when not (String.IsNullOrEmpty(value)) && fileExists value -> Some value + | _ -> + // Probe for netsdk install, dotnet. and dotnet.exe is a constant offset from the location of System.Int32 + let candidate = + let assemblyLocation = Path.GetDirectoryName(typeof.Assembly.Location) + Path.GetFullPath(Path.Combine(assemblyLocation, "..", "..", "..", dotnet)) + + if fileExists candidate then + Some candidate + else + match probePathForDotnetHost () with + | Some f -> Some(Path.Combine(f, dotnet)) + | None -> getDotnetGlobalHostPath () +let dotnetExe = getDotnetHostPath () |> Option.map System.IO.FileInfo +*) diff --git a/vsintegration/tests/UnitTests/QuickInfoTests.fs b/vsintegration/tests/UnitTests/QuickInfoTests.fs index d255f0f3d34..0e65489a70d 100644 --- a/vsintegration/tests/UnitTests/QuickInfoTests.fs +++ b/vsintegration/tests/UnitTests/QuickInfoTests.fs @@ -428,48 +428,35 @@ module Test = Assert.AreEqual(expected, quickInfo) () -[] -let ``Automation.LetBindings.InsideModule``() = - let code = """ +[] -let ``Automation.LetBindings.InsideType.Instance``() = - let code = """ +""">] +[] -let ``Automation.LetBindings.InsideType.Static``() = - let code = """ +""">] +[] +[] +let ``Automation.LetBindings`` code = let expectedSignature = "val func: x: 'a -> unit" let tooltip = GetQuickInfoTextFromCode code