From 7f89ce63c4b1e4fc7a9f30bae613b0d0fd327bbd Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 2 Apr 2019 18:41:42 +0100 Subject: [PATCH] whitespace normalization and cleanup --- src/absil/il.fs | 2003 +++++++++-------- src/absil/illib.fs | 84 +- src/absil/ilread.fs | 68 +- src/absil/ilreflect.fs | 613 +++-- src/absil/ilsign.fs | 156 +- src/absil/ilsupp.fs | 759 +++---- src/absil/ilwrite.fs | 68 +- src/absil/ilwritepdb.fs | 116 +- src/fsharp/AttributeChecking.fs | 2 +- src/fsharp/AugmentWithHashCompare.fs | 108 +- src/fsharp/CompileOps.fs | 426 ++-- src/fsharp/CompileOptions.fs | 96 +- src/fsharp/ConstraintSolver.fs | 6 +- src/fsharp/DetupleArgs.fs | 12 +- src/fsharp/ErrorLogger.fs | 50 +- src/fsharp/ExtensionTyping.fs | 106 +- src/fsharp/FSharp.Core/Linq.fs | 6 +- src/fsharp/FSharp.Core/Query.fs | 102 +- src/fsharp/FSharp.Core/QueryExtensions.fs | 12 +- src/fsharp/FSharp.Core/async.fs | 792 +++---- src/fsharp/FSharp.Core/mailbox.fs | 302 +-- src/fsharp/FSharp.Core/map.fs | 52 +- src/fsharp/FSharp.Core/printf.fs | 48 +- src/fsharp/FSharp.Core/quotations.fs | 330 +-- src/fsharp/FSharp.Core/reflect.fs | 66 +- src/fsharp/FSharp.Core/seq.fs | 48 +- src/fsharp/FSharp.Core/set.fs | 104 +- src/fsharp/FindUnsolved.fs | 16 +- src/fsharp/IlxGen.fs | 348 +-- src/fsharp/InnerLambdasToTopLevelFuncs.fs | 28 +- src/fsharp/LexFilter.fs | 174 +- src/fsharp/LowerCallsAndSeqs.fs | 104 +- src/fsharp/MethodCalls.fs | 20 +- src/fsharp/NameResolution.fs | 66 +- src/fsharp/NicePrint.fs | 6 +- src/fsharp/Optimizer.fs | 206 +- src/fsharp/PatternMatchCompilation.fs | 108 +- src/fsharp/PostInferenceChecks.fs | 128 +- src/fsharp/QuotationTranslator.fs | 116 +- .../SimulatedMSBuildReferenceResolver.fs | 176 +- src/fsharp/TastOps.fs | 444 ++-- src/fsharp/TastPickle.fs | 60 +- src/fsharp/TypeChecker.fs | 884 ++++---- src/fsharp/TypeRelations.fs | 2 +- src/fsharp/ast.fs | 125 +- src/fsharp/autobox.fs | 16 +- src/fsharp/fsc.fs | 98 +- src/fsharp/fsi/fsi.fs | 10 +- src/fsharp/infos.fs | 46 +- src/fsharp/pars.fsy | 198 +- src/fsharp/service/IncrementalBuild.fs | 114 +- src/fsharp/service/ServiceAssemblyContent.fs | 6 +- .../service/ServiceInterfaceStubGenerator.fs | 110 +- src/fsharp/service/ServiceLexing.fs | 66 +- src/fsharp/service/ServiceNavigation.fs | 2 +- .../service/ServiceParamInfoLocations.fs | 34 +- src/fsharp/service/ServiceParseTreeWalk.fs | 120 +- src/fsharp/service/ServiceStructure.fs | 2 +- src/fsharp/service/ServiceUntypedParse.fs | 236 +- src/fsharp/service/service.fs | 2 +- src/fsharp/symbols/Exprs.fs | 183 +- src/fsharp/symbols/SymbolHelpers.fs | 62 +- src/fsharp/symbols/Symbols.fs | 56 +- src/fsharp/tast.fs | 88 +- tests/scripts/codingConventions.fsx | 42 +- 65 files changed, 5526 insertions(+), 5511 deletions(-) diff --git a/src/absil/il.fs b/src/absil/il.fs index 5f6482821..53a3a32bb 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module FSharp.Compiler.AbstractIL.IL +module FSharp.Compiler.AbstractIL.IL #nowarn "49" #nowarn "343" // The type 'ILAssemblyRef' implements 'System.IComparable' explicitly but provides no corresponding override for 'Object.Equals'. @@ -14,6 +14,8 @@ open System.Collections.Generic open System.Collections.Concurrent open System.Runtime.CompilerServices open System.Reflection +open System.Text +open System.Threading open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.Diagnostics @@ -21,23 +23,23 @@ open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open Internal.Utilities - -let logging = false -let runningOnMono = +let logging = false + +let runningOnMono = #if ENABLE_MONO_SUPPORT // Officially supported way to detect if we are running on Mono. // See http://www.mono-project.com/FAQ:_Technical // "How can I detect if am running in Mono?" section try - System.Type.GetType("Mono.Runtime") <> null - with e-> + System.Type.GetType ("Mono.Runtime") <> null + with e-> // Must be robust in the case that someone else has installed a handler into System.AppDomain.OnTypeResolveEvent // that is not reliable. - // This is related to bug 5506--the issue is actually a bug in VSTypeResolutionService.EnsurePopulated which is - // called by OnTypeResolveEvent. The function throws a NullReferenceException. I'm working with that team to get + // This is related to bug 5506--the issue is actually a bug in VSTypeResolutionService.EnsurePopulated which is + // called by OnTypeResolveEvent. The function throws a NullReferenceException. I'm working with that team to get // their issue fixed but we need to be robust here anyway. - false + false #else false #endif @@ -48,45 +50,45 @@ let int_order = LanguagePrimitives.FastGenericComparer let notlazy v = Lazy<_>.CreateFromValue v -/// A little ugly, but the idea is that if a data structure does not -/// contain lazy values then we don't add laziness. So if the thing to map -/// is already evaluated then immediately apply the function. -let lazyMap f (x: Lazy<_>) = +/// A little ugly, but the idea is that if a data structure does not +/// contain lazy values then we don't add laziness. So if the thing to map +/// is already evaluated then immediately apply the function. +let lazyMap f (x: Lazy<_>) = if x.IsValueCreated then notlazy (f (x.Force())) else lazy (f (x.Force())) [] -type PrimaryAssembly = +type PrimaryAssembly = | Mscorlib - | System_Runtime - | NetStandard + | System_Runtime + | NetStandard - member this.Name = + member this.Name = match this with | Mscorlib -> "mscorlib" | System_Runtime -> "System.Runtime" | NetStandard -> "netstandard" - static member IsSomePrimaryAssembly n = - n = PrimaryAssembly.Mscorlib.Name - || n = PrimaryAssembly.System_Runtime.Name - || n = PrimaryAssembly.NetStandard.Name + static member IsSomePrimaryAssembly n = + n = PrimaryAssembly.Mscorlib.Name + || n = PrimaryAssembly.System_Runtime.Name + || n = PrimaryAssembly.NetStandard.Name -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Utilities: type names -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let splitNameAt (nm: string) idx = +let splitNameAt (nm: string) idx = if idx < 0 then failwith "splitNameAt: idx < 0" - let last = nm.Length - 1 + let last = nm.Length - 1 if idx > last then failwith "splitNameAt: idx > last" - (nm.Substring(0, idx)), + (nm.Substring (0, idx)), (if idx < last then nm.Substring (idx+1, last - idx) else "") -let rec splitNamespaceAux (nm: string) = - match nm.IndexOf '.' with +let rec splitNamespaceAux (nm: string) = + match nm.IndexOf '.' with | -1 -> [nm] - | idx -> - let s1, s2 = splitNameAt nm idx - s1::splitNamespaceAux s2 + | idx -> + let s1, s2 = splitNameAt nm idx + s1::splitNamespaceAux s2 /// Global State. All namespace splits ever seen // ++GLOBAL MUTABLE STATE (concurrency-safe) @@ -97,23 +99,23 @@ let memoizeNamespaceRightTable = new ConcurrentDictionary() let splitNamespaceToArray nm = - memoizeNamespaceArrayTable.GetOrAdd(nm, fun nm -> + memoizeNamespaceArrayTable.GetOrAdd (nm, fun nm -> let x = Array.ofList (splitNamespace nm) x) -let splitILTypeName (nm: string) = +let splitILTypeName (nm: string) = match nm.LastIndexOf '.' with | -1 -> [], nm - | idx -> + | idx -> let s1, s2 = splitNameAt nm idx splitNamespace s1, s2 @@ -123,18 +125,18 @@ let emptyStringArray = ([| |] : string[]) // The type names that flow to the point include the "mangled" type names used for static parameters for provided types. // For example, // Foo.Bar,"1.0" -// This is because the ImportSystemType code goes via Abstract IL type references. Ultimately this probably isn't +// This is because the ImportSystemType code goes via Abstract IL type references. Ultimately this probably isn't // the best way to do things. -let splitILTypeNameWithPossibleStaticArguments (nm: string) = - let nm, suffix = +let splitILTypeNameWithPossibleStaticArguments (nm: string) = + let nm, suffix = match nm.IndexOf ',' with | -1 -> nm, None | idx -> let s1, s2 = splitNameAt nm idx in s1, Some s2 - let nsp, nm = + let nsp, nm = match nm.LastIndexOf '.' with | -1 -> emptyStringArray, nm - | idx -> + | idx -> let s1, s2 = splitNameAt nm idx splitNamespaceToArray s1, s2 nsp, (match suffix with None -> nm | Some s -> nm + "," + s) @@ -148,48 +150,48 @@ splitILTypeNameWithPossibleStaticArguments "Foo.Bar,\"1.0\"" = ([| "Foo" |], "Ba splitILTypeNameWithPossibleStaticArguments "Foo.Bar.Bar,\"1.0\"" = ([| "Foo"; "Bar" |], "Bar,\"1.0\"") *) -let unsplitTypeName (ns, n) = - match ns with - | [] -> String.concat "." ns + "." + n - | _ -> n +let unsplitTypeName (ns, n) = + match ns with + | [] -> String.concat "." ns + "." + n + | _ -> n -let splitTypeNameRightAux (nm: string) = +let splitTypeNameRightAux (nm: string) = let idx = nm.LastIndexOf '.' if idx = -1 then None, nm else let s1, s2 = splitNameAt nm idx Some s1, s2 let splitTypeNameRight nm = - memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAux) + memoizeNamespaceRightTable.GetOrAdd (nm, splitTypeNameRightAux) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Ordered lists with a lookup table // -------------------------------------------------------------------- /// This is used to store event, property and field maps. -type LazyOrderedMultiMap<'Key, 'Data when 'Key : equality>(keyf : 'Data -> 'Key, lazyItems : Lazy<'Data list>) = +type LazyOrderedMultiMap<'Key, 'Data when 'Key : equality>(keyf : 'Data -> 'Key, lazyItems : Lazy<'Data list>) = - let quickMap = - lazyItems |> lazyMap (fun entries -> + let quickMap = + lazyItems |> lazyMap (fun entries -> let t = new Dictionary<_, _>(entries.Length, HashIdentity.Structural) do entries |> List.iter (fun y -> let key = keyf y let v = - match t.TryGetValue(key) with + match t.TryGetValue key with | true, v -> v | _ -> [] - t.[key] <- y :: v) + t.[key] <- y :: v) t) member self.Entries() = lazyItems.Force() - member self.Add(y) = new LazyOrderedMultiMap<'Key, 'Data>(keyf, lazyItems |> lazyMap (fun x -> y :: x)) - - member self.Filter(f) = new LazyOrderedMultiMap<'Key, 'Data>(keyf, lazyItems |> lazyMap (List.filter f)) + member self.Add y = new LazyOrderedMultiMap<'Key, 'Data>(keyf, lazyItems |> lazyMap (fun x -> y :: x)) + + member self.Filter f = new LazyOrderedMultiMap<'Key, 'Data>(keyf, lazyItems |> lazyMap (List.filter f)) member self.Item - with get(x) = - match quickMap.Force().TryGetValue(x) with + with get x = + match quickMap.Force().TryGetValue x with | true, v -> v | _ -> [] @@ -206,11 +208,11 @@ let b2 n = ((n >>> 16) &&& 0xFF) let b3 n = ((n >>> 24) &&& 0xFF) -module SHA1 = +module SHA1 = let inline (>>>&) (x: int) (y: int) = int32 (uint32 x >>> y) - let f(t, b, c, d) = + let f(t, b, c, d) = if t < 20 then (b &&& c) ||| ((~~~b) &&& d) elif t < 40 then b ^^^ c ^^^ d elif t < 60 then (b &&& c) ||| (b &&& d) ||| (c &&& d) @@ -221,29 +223,29 @@ module SHA1 = let [] k40to59 = 0x8F1BBCDC let [] k60to79 = 0xCA62C1D6 - let k t = - if t < 20 then k0to19 - elif t < 40 then k20to39 - elif t < 60 then k40to59 - else k60to79 + let k t = + if t < 20 then k0to19 + elif t < 40 then k20to39 + elif t < 60 then k40to59 + else k60to79 - type SHAStream = + type SHAStream = { stream: byte[] mutable pos: int mutable eof: bool } let rotLeft32 x n = (x <<< n) ||| (x >>>& (32-n)) - - // padding and length (in bits!) recorded at end - let shaAfterEof sha = + + // padding and length (in bits!) recorded at end + let shaAfterEof sha = let n = sha.pos let len = sha.stream.Length if n = len then 0x80 - else + else let padded_len = (((len + 9 + 63) / 64) * 64) - 8 - if n < padded_len - 8 then 0x0 + if n < padded_len - 8 then 0x0 elif (n &&& 63) = 56 then int32 ((int64 len * int64 8) >>> 56) &&& 0xff elif (n &&& 63) = 57 then int32 ((int64 len * int64 8) >>> 48) &&& 0xff elif (n &&& 63) = 58 then int32 ((int64 len * int64 8) >>> 40) &&& 0xff @@ -254,13 +256,13 @@ module SHA1 = elif (n &&& 63) = 63 then (sha.eof <- true; int32 (int64 len * int64 8) &&& 0xff) else 0x0 - let shaRead8 sha = - let s = sha.stream + let shaRead8 sha = + let s = sha.stream let b = if sha.pos >= s.Length then shaAfterEof sha else int32 s.[sha.pos] sha.pos <- sha.pos + 1 b - - let shaRead32 sha = + + let shaRead32 sha = let b0 = shaRead8 sha let b1 = shaRead8 sha let b2 = shaRead8 sha @@ -268,7 +270,7 @@ module SHA1 = let res = (b0 <<< 24) ||| (b1 <<< 16) ||| (b2 <<< 8) ||| b3 res - let sha1Hash sha = + let sha1Hash sha = let mutable h0 = 0x67452301 let mutable h1 = 0xEFCDAB89 let mutable h2 = 0x98BADCFE @@ -285,13 +287,13 @@ module SHA1 = w.[i] <- shaRead32 sha for t = 16 to 79 do w.[t] <- rotLeft32 (w.[t-3] ^^^ w.[t-8] ^^^ w.[t-14] ^^^ w.[t-16]) 1 - a <- h0 + a <- h0 b <- h1 c <- h2 d <- h3 e <- h4 for t = 0 to 79 do - let temp = (rotLeft32 a 5) + f(t, b, c, d) + e + w.[t] + k(t) + let temp = (rotLeft32 a 5) + f (t, b, c, d) + e + w.[t] + k t e <- d d <- c c <- rotLeft32 b 30 @@ -304,11 +306,11 @@ module SHA1 = h4 <- h4 + e h0, h1, h2, h3, h4 - let sha1HashBytes s = + let sha1HashBytes s = let (_h0, _h1, _h2, h3, h4) = sha1Hash { stream = s; pos = 0; eof = false } // the result of the SHA algorithm is stored in registers 3 and 4 Array.map byte [| b0 h4; b1 h4; b2 h4; b3 h4; b0 h3; b1 h3; b2 h3; b3 h3; |] - let sha1HashInt64 s = + let sha1HashInt64 s = let (_h0,_h1,_h2,h3,h4) = sha1Hash { stream = s; pos = 0; eof = false } // the result of the SHA algorithm is stored in registers 3 and 4 (int64 h3 <<< 32) ||| int64 h4 @@ -316,8 +318,8 @@ let sha1HashBytes s = SHA1.sha1HashBytes s let sha1HashInt64 s = SHA1.sha1HashInt64 s // -------------------------------------------------------------------- -// -// -------------------------------------------------------------------- +// +// -------------------------------------------------------------------- [] type ILVersionInfo = @@ -327,7 +329,7 @@ type ILVersionInfo = val Build: uint16 val Revision: uint16 - new(major, minor, build, revision) = + new (major, minor, build, revision) = { Major = major; Minor = minor; Build = build; Revision = revision } type Locale = string @@ -347,12 +349,12 @@ type PublicKey = member x.KeyToken=match x with PublicKeyToken b -> b | _ -> invalidOp"not a key token" - member x.ToToken() = - match x with + member x.ToToken() = + match x with | PublicKey bytes -> SHA1.sha1HashBytes bytes | PublicKeyToken token -> token - static member KeyAsToken(k) = PublicKeyToken(PublicKey(k).ToToken()) + static member KeyAsToken key = PublicKeyToken (PublicKey(key).ToToken()) [] type AssemblyRefData = @@ -371,7 +373,7 @@ let isMscorlib data = [] type ILAssemblyRef(data) = - let uniqueStamp = AssemblyRefUniqueStampGenerator.Encode(data) + let uniqueStamp = AssemblyRefUniqueStampGenerator.Encode data member x.Name=data.assemRefName @@ -379,7 +381,7 @@ type ILAssemblyRef(data) = member x.PublicKey=data.assemRefPublicKeyInfo - member x.Retargetable=data.assemRefRetargetable + member x.Retargetable=data.assemRefRetargetable member x.Version=data.assemRefVersion @@ -389,12 +391,12 @@ type ILAssemblyRef(data) = override x.GetHashCode() = uniqueStamp - override x.Equals(yobj) = ((yobj :?> ILAssemblyRef).UniqueStamp = uniqueStamp) + override x.Equals yobj = ((yobj :?> ILAssemblyRef).UniqueStamp = uniqueStamp) - interface System.IComparable with - override x.CompareTo(yobj) = compare (yobj :?> ILAssemblyRef).UniqueStamp uniqueStamp + interface IComparable with + override x.CompareTo yobj = compare (yobj :?> ILAssemblyRef).UniqueStamp uniqueStamp - static member Create(name, hash, publicKey, retargetable, version, locale) = + static member Create (name, hash, publicKey, retargetable, version, locale) = ILAssemblyRef { assemRefName=name assemRefHash=hash @@ -403,36 +405,36 @@ type ILAssemblyRef(data) = assemRefVersion=version assemRefLocale=locale } - static member FromAssemblyName (aname: System.Reflection.AssemblyName) = + static member FromAssemblyName (aname: AssemblyName) = let locale = None - let publicKey = - match aname.GetPublicKey() with - | null | [| |] -> - match aname.GetPublicKeyToken() with + let publicKey = + match aname.GetPublicKey() with + | null | [| |] -> + match aname.GetPublicKeyToken() with | null | [| |] -> None | bytes -> Some (PublicKeyToken bytes) - | bytes -> + | bytes -> Some (PublicKey bytes) - - let version = - match aname.Version with + + let version = + match aname.Version with | null -> None | v -> Some (ILVersionInfo (uint16 v.Major, uint16 v.Minor, uint16 v.Build, uint16 v.Revision)) - - let retargetable = aname.Flags = System.Reflection.AssemblyNameFlags.Retargetable - - ILAssemblyRef.Create(aname.Name, None, publicKey, retargetable, version, locale) - - member aref.QualifiedName = - let b = new System.Text.StringBuilder(100) - let add (s: string) = b.Append(s) |> ignore - let addC (s: char) = b.Append(s) |> ignore - add(aref.Name) - match aref.Version with + + let retargetable = aname.Flags = AssemblyNameFlags.Retargetable + + ILAssemblyRef.Create (aname.Name, None, publicKey, retargetable, version, locale) + + member aref.QualifiedName = + let b = StringBuilder(100) + let add (s: string) = b.Append s |> ignore + let addC (s: char) = b.Append s |> ignore + add aref.Name + match aref.Version with | None -> () - | Some (version) -> + | Some (version) -> add ", Version=" add (string (int version.Major)) add "." @@ -442,52 +444,52 @@ type ILAssemblyRef(data) = add "." add (string (int version.Revision)) add ", Culture=" - match aref.Locale with + match aref.Locale with | None -> add "neutral" | Some b -> add b add ", PublicKeyToken=" - match aref.PublicKey with + match aref.PublicKey with | None -> add "null" - | Some pki -> + | Some pki -> let pkt = pki.ToToken() - let convDigit(digit) = - let digitc = - if digit < 10 - then System.Convert.ToInt32 '0' + digit - else System.Convert.ToInt32 'a' + (digit - 10) - System.Convert.ToChar(digitc) + let convDigit digit = + let digitc = + if digit < 10 + then Convert.ToInt32 '0' + digit + else Convert.ToInt32 'a' + (digit - 10) + Convert.ToChar digitc for i = 0 to pkt.Length-1 do let v = pkt.[i] - addC (convDigit(System.Convert.ToInt32(v)/16)) - addC (convDigit(System.Convert.ToInt32(v)%16)) + 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" + add ", Retargetable=Yes" b.ToString() [] -type ILModuleRef = +type ILModuleRef = { name: string - hasMetadata: bool + hasMetadata: bool hash: byte[] option } - static member Create(name, hasMetadata, hash) = + static member Create (name, hasMetadata, hash) = { name=name hasMetadata= hasMetadata hash=hash } - + member x.Name=x.name member x.HasMetadata=x.hasMetadata - member x.Hash=x.hash + member x.Hash=x.hash [] [] -type ILScopeRef = +type ILScopeRef = | Local - | Module of ILModuleRef + | Module of ILModuleRef | Assembly of ILAssemblyRef member x.IsLocalRef = match x with ILScopeRef.Local -> true | _ -> false @@ -500,18 +502,18 @@ type ILScopeRef = member x.AssemblyRef = match x with ILScopeRef.Assembly x -> x | _ -> failwith "not an assembly reference" - member x.QualifiedName = - match x with + member x.QualifiedName = + match x with | ILScopeRef.Local -> "" | ILScopeRef.Module mref -> "module "+mref.Name | ILScopeRef.Assembly aref -> aref.QualifiedName -type ILArrayBound = int32 option +type ILArrayBound = int32 option type ILArrayBounds = ILArrayBound * ILArrayBound [] -type ILArrayShape = +type ILArrayShape = | ILArrayShape of ILArrayBounds list (* lobound/size pairs *) @@ -519,25 +521,25 @@ type ILArrayShape = static member SingleDimensional = ILArrayShapeStatics.SingleDimensional - static member FromRank n = if n = 1 then ILArrayShape.SingleDimensional else ILArrayShape(List.replicate n (Some 0, None)) + static member FromRank n = if n = 1 then ILArrayShape.SingleDimensional else ILArrayShape (List.replicate n (Some 0, None)) -and ILArrayShapeStatics() = +and ILArrayShapeStatics() = - static let singleDimensional = ILArrayShape [(Some 0, None)] + static let singleDimensional = ILArrayShape [(Some 0, None)] static member SingleDimensional = singleDimensional /// Calling conventions. These are used in method pointer types. [] -type ILArgConvention = +type ILArgConvention = | Default - | CDecl - | StdCall - | ThisCall - | FastCall + | CDecl + | StdCall + | ThisCall + | FastCall | VarArg - + [] type ILThisConvention = | Instance @@ -549,9 +551,9 @@ type ILCallingConv = | Callconv of ILThisConvention * ILArgConvention - member x.ThisConv = let (Callconv(a, _b)) = x in a + member x.ThisConv = let (Callconv (a, _b)) = x in a - member x.BasicConv = let (Callconv(_a, b)) = x in b + member x.BasicConv = let (Callconv (_a, b)) = x in b member x.IsInstance = match x.ThisConv with ILThisConvention.Instance -> true | _ -> false @@ -564,37 +566,37 @@ type ILCallingConv = static member Static = ILCallingConvStatics.Static /// Static storage to amortize the allocation of ILCallingConv.Instance and ILCallingConv.Static. -and ILCallingConvStatics() = +and ILCallingConvStatics() = - static let instanceCallConv = Callconv(ILThisConvention.Instance, ILArgConvention.Default) + static let instanceCallConv = Callconv (ILThisConvention.Instance, ILArgConvention.Default) - static let staticCallConv = Callconv(ILThisConvention.Static, ILArgConvention.Default) + static let staticCallConv = Callconv (ILThisConvention.Static, ILArgConvention.Default) static member Instance = instanceCallConv static member Static = staticCallConv -type ILBoxity = - | AsObject +type ILBoxity = + | AsObject | AsValue // IL type references have a pre-computed hash code to enable quick lookup tables during binary generation. [] -type ILTypeRef = +type ILTypeRef = { trefScope: ILScopeRef trefEnclosing: string list trefName: string - hashCode : int + hashCode : int mutable asBoxedType: ILType } - - static member Create(scope, enclosing, name) = + + static member Create (scope, enclosing, name) = let hashCode = hash scope * 17 ^^^ (hash enclosing * 101 <<< 1) ^^^ (hash name * 47 <<< 2) { trefScope=scope trefEnclosing=enclosing trefName=name hashCode=hashCode asBoxedType = Unchecked.defaultof<_> } - + member x.Scope = x.trefScope member x.Enclosing = x.trefEnclosing @@ -603,50 +605,50 @@ type ILTypeRef = member x.ApproxId = x.hashCode - member x.AsBoxedType (tspec: ILTypeSpec) = + member x.AsBoxedType (tspec: ILTypeSpec) = if isNil tspec.tspecInst then let v = x.asBoxedType - match box v with - | null -> + match box v with + | null -> let r = ILType.Boxed tspec x.asBoxedType <- r r | _ -> v - else + else ILType.Boxed tspec override x.GetHashCode() = x.hashCode - override x.Equals(yobj) = - let y = (yobj :?> ILTypeRef) - (x.ApproxId = y.ApproxId) && - (x.Scope = y.Scope) && - (x.Name = y.Name) && + override x.Equals yobj = + let y = (yobj :?> ILTypeRef) + (x.ApproxId = y.ApproxId) && + (x.Scope = y.Scope) && + (x.Name = y.Name) && (x.Enclosing = y.Enclosing) - interface System.IComparable with + interface IComparable with - override x.CompareTo(yobj) = - let y = (yobj :?> ILTypeRef) + override x.CompareTo yobj = + let y = (yobj :?> ILTypeRef) let c = compare x.ApproxId y.ApproxId if c <> 0 then c else let c = compare x.Scope y.Scope if c <> 0 then c else - let c = compare x.Name y.Name + let c = compare x.Name y.Name if c <> 0 then c else compare x.Enclosing y.Enclosing - + member tref.FullName = String.concat "." (tref.Enclosing @ [tref.Name]) - + member tref.BasicQualifiedName = (String.concat "+" (tref.Enclosing @ [ tref.Name ] )).Replace(",", @"\,") - member tref.AddQualifiedNameExtension(basic) = + member tref.AddQualifiedNameExtension basic = let sco = tref.Scope.QualifiedName if sco = "" then basic else String.concat ", " [basic;sco] - member tref.QualifiedName = - tref.AddQualifiedNameExtension(tref.BasicQualifiedName) + member tref.QualifiedName = + tref.AddQualifiedNameExtension tref.BasicQualifiedName /// For debugging [] @@ -655,12 +657,12 @@ type ILTypeRef = /// For debugging override x.ToString() = x.FullName - + and [] - ILTypeSpec = + ILTypeSpec = { tspecTypeRef: ILTypeRef /// The type instantiation if the type is generic. - tspecInst: ILGenericArgs } + tspecInst: ILGenericArgs } member x.TypeRef=x.tspecTypeRef @@ -672,17 +674,17 @@ and [ List.map (fun arg -> "[" + arg.QualifiedName + "]")) + "]" - member x.AddQualifiedNameExtension(basic) = - x.TypeRef.AddQualifiedNameExtension(basic) + member x.AddQualifiedNameExtension basic = + x.TypeRef.AddQualifiedNameExtension basic member x.FullName=x.TypeRef.FullName @@ -694,69 +696,69 @@ and [] ILType = - | Void - | Array of ILArrayShape * ILType - | Value of ILTypeSpec - | Boxed of ILTypeSpec - | Ptr of ILType - | Byref of ILType - | FunctionPointer of ILCallingSignature - | TypeVar of uint16 + | Void + | Array of ILArrayShape * ILType + | Value of ILTypeSpec + | Boxed of ILTypeSpec + | Ptr of ILType + | Byref of ILType + | FunctionPointer of ILCallingSignature + | TypeVar of uint16 | Modified of bool * ILTypeRef * ILType - member x.BasicQualifiedName = - match x with + member x.BasicQualifiedName = + match x with | ILType.TypeVar n -> "!" + string n - | ILType.Modified(_, _ty1, ty2) -> ty2.BasicQualifiedName - | ILType.Array (ILArrayShape(s), ty) -> ty.BasicQualifiedName + "[" + System.String(',', s.Length-1) + "]" + | ILType.Modified (_, _ty1, ty2) -> ty2.BasicQualifiedName + | ILType.Array (ILArrayShape s, ty) -> ty.BasicQualifiedName + "[" + String(',', s.Length-1) + "]" | ILType.Value tr | ILType.Boxed tr -> tr.BasicQualifiedName | ILType.Void -> "void" | ILType.Ptr _ty -> failwith "unexpected pointer type" | ILType.Byref _ty -> failwith "unexpected byref type" | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" - member x.AddQualifiedNameExtension(basic) = - match x with + member x.AddQualifiedNameExtension basic = + match x with | ILType.TypeVar _n -> basic - | ILType.Modified(_, _ty1, ty2) -> ty2.AddQualifiedNameExtension(basic) - | ILType.Array (ILArrayShape(_s), ty) -> ty.AddQualifiedNameExtension(basic) - | ILType.Value tr | ILType.Boxed tr -> tr.AddQualifiedNameExtension(basic) + | ILType.Modified (_, _ty1, ty2) -> ty2.AddQualifiedNameExtension basic + | ILType.Array (ILArrayShape(_s), ty) -> ty.AddQualifiedNameExtension basic + | ILType.Value tr | ILType.Boxed tr -> tr.AddQualifiedNameExtension basic | ILType.Void -> failwith "void" | ILType.Ptr _ty -> failwith "unexpected pointer type" | ILType.Byref _ty -> failwith "unexpected byref type" | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" - - member x.QualifiedName = + + member x.QualifiedName = x.AddQualifiedNameExtension(x.BasicQualifiedName) member x.TypeSpec = - match x with + match x with | ILType.Boxed tr | ILType.Value tr -> tr | _ -> invalidOp "not a nominal type" member x.Boxity = - match x with + match x with | ILType.Boxed _ -> AsObject | ILType.Value _ -> AsValue | _ -> invalidOp "not a nominal type" - member x.TypeRef = - match x with + member x.TypeRef = + match x with | ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef | _ -> invalidOp "not a nominal type" - member x.IsNominal = - match x with + member x.IsNominal = + match x with | ILType.Boxed _ | ILType.Value _ -> true | _ -> false member x.GenericArgs = - match x with + match x with | ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs | _ -> [] member x.IsTyvar = - match x with + match x with | ILType.TypeVar _ -> true | _ -> false /// For debugging @@ -766,7 +768,7 @@ and [] - ILCallingSignature = + ILCallingSignature = { CallingConv: ILCallingConv ArgTypes: ILTypes ReturnType: ILType } @@ -804,8 +806,8 @@ type ILMethodRef = member x.CallingSignature = mkILCallSig (x.CallingConv, x.ArgTypes, x.ReturnType) - static member Create(a, b, c, d, e, f) = - { mrefParent= a;mrefCallconv=b;mrefName=c;mrefGenericArity=d; mrefArgs=e;mrefReturn=f } + static member Create (a, b, c, d, e, f) = + { mrefParent=a; mrefCallconv=b; mrefName=c; mrefGenericArity=d; mrefArgs=e; mrefReturn=f } /// For debugging [] @@ -813,9 +815,8 @@ type ILMethodRef = override x.ToString() = x.DeclaringTypeRef.ToString() + "::" + x.Name + "(...)" - [] -type ILFieldRef = +type ILFieldRef = { DeclaringTypeRef: ILTypeRef Name: string Type: ILType } @@ -827,14 +828,14 @@ type ILFieldRef = override x.ToString() = x.DeclaringTypeRef.ToString() + "::" + x.Name [] -type ILMethodSpec = +type ILMethodSpec = { mspecMethodRef: ILMethodRef - mspecDeclaringType: ILType + mspecDeclaringType: ILType - mspecMethodInst: ILGenericArgs } + mspecMethodInst: ILGenericArgs } - static member Create(a, b, c) = { mspecDeclaringType=a; mspecMethodRef=b; mspecMethodInst=c } + static member Create (a, b, c) = { mspecDeclaringType=a; mspecMethodRef=b; mspecMethodInst=c } member x.MethodRef = x.mspecMethodRef @@ -861,7 +862,7 @@ type ILMethodSpec = [] type ILFieldSpec = { FieldRef: ILFieldRef - DeclaringType: ILType } + DeclaringType: ILType } member x.FormalType = x.FieldRef.Type @@ -876,23 +877,23 @@ type ILFieldSpec = override x.ToString() = x.FieldRef.ToString() // -------------------------------------------------------------------- -// Debug info. -// -------------------------------------------------------------------- +// Debug info. +// -------------------------------------------------------------------- type ILGuid = byte[] -type ILPlatform = +type ILPlatform = | X86 | AMD64 | IA64 -type ILSourceDocument = +type ILSourceDocument = { sourceLanguage: ILGuid option sourceVendor: ILGuid option sourceDocType: ILGuid option sourceFile: string } - static member Create(language, vendor, docType, file) = + static member Create (language, vendor, docType, file) = { sourceLanguage=language sourceVendor=vendor sourceDocType=docType @@ -914,7 +915,7 @@ type ILSourceMarker = sourceEndLine: int sourceEndColumn: int } - static member Create(document, line, column, endLine, endColumn) = + static member Create (document, line, column, endLine, endColumn) = { sourceDocument=document sourceLine=line sourceColumn=column @@ -937,7 +938,7 @@ type ILSourceMarker = override x.ToString() = sprintf "(%d, %d)-(%d, %d)" x.Line x.Column x.EndLine x.EndColumn -type ILAttribElem = +type ILAttribElem = | String of string option | Bool of bool | Char of char @@ -951,7 +952,7 @@ type ILAttribElem = | UInt64 of uint64 | Single of single | Double of double - | Null + | Null | Type of ILType option | TypeRef of ILTypeRef option | Array of ILType * ILAttribElem list @@ -973,7 +974,7 @@ type ILAttribute = | Encoded (_, _, elements) -> elements | Decoded (_, fixedArgs, namedArgs) -> fixedArgs @ (namedArgs |> List.map (fun (_, _, _, e) -> e)) - member x.WithMethod(method: ILMethodSpec) = + member x.WithMethod (method: ILMethodSpec) = match x with | Encoded (_, data, elements) -> Encoded (method, data, elements) | Decoded (_, fixedArgs, namedArgs) -> Decoded (method, fixedArgs, namedArgs) @@ -1000,9 +1001,9 @@ type ILAttributesStored = /// Already computed | Given of ILAttributes - member x.GetCustomAttrs metadataIndex = + member x.GetCustomAttrs metadataIndex = match x with - | Reader f -> ILAttributes(f metadataIndex) + | Reader f -> ILAttributes (f metadataIndex) | Given attrs -> attrs let emptyILCustomAttrs = ILAttributes [| |] @@ -1020,8 +1021,8 @@ let mkILCustomAttrsReader f = ILAttributesStored.Reader f type ILCodeLabel = int // -------------------------------------------------------------------- -// Instruction set. -// -------------------------------------------------------------------- +// Instruction set. +// -------------------------------------------------------------------- type ILBasicType = | DT_R @@ -1040,91 +1041,91 @@ type ILBasicType = | DT_REF [] -type ILToken = - | ILType of ILType - | ILMethod of ILMethodSpec +type ILToken = + | ILType of ILType + | ILMethod of ILMethodSpec | ILField of ILFieldSpec [] -type ILConst = +type ILConst = | I4 of int32 | I8 of int64 | R4 of single | R8 of double -type ILTailcall = +type ILTailcall = | Tailcall | Normalcall -type ILAlignment = +type ILAlignment = | Aligned | Unaligned1 | Unaligned2 | Unaligned4 -type ILVolatility = +type ILVolatility = | Volatile | Nonvolatile -type ILReadonly = +type ILReadonly = | ReadonlyAddress | NormalAddress type ILVarArgs = ILTypes option [] -type ILComparisonInstr = - | BI_beq - | BI_bge - | BI_bge_un - | BI_bgt - | BI_bgt_un - | BI_ble - | BI_ble_un - | BI_blt - | BI_blt_un - | BI_bne_un - | BI_brfalse - | BI_brtrue +type ILComparisonInstr = + | BI_beq + | BI_bge + | BI_bge_un + | BI_bgt + | BI_bgt_un + | BI_ble + | BI_ble_un + | BI_blt + | BI_blt_un + | BI_bne_un + | BI_brfalse + | BI_brtrue [] -type ILInstr = - | AI_add +type ILInstr = + | AI_add | AI_add_ovf | AI_add_ovf_un - | AI_and - | AI_div + | AI_and + | AI_div | AI_div_un - | AI_ceq - | AI_cgt - | AI_cgt_un - | AI_clt - | AI_clt_un + | AI_ceq + | AI_cgt + | AI_cgt_un + | AI_clt + | AI_clt_un | AI_conv of ILBasicType | AI_conv_ovf of ILBasicType | AI_conv_ovf_un of ILBasicType - | AI_mul - | AI_mul_ovf + | AI_mul + | AI_mul_ovf | AI_mul_ovf_un - | AI_rem - | AI_rem_un - | AI_shl - | AI_shr + | AI_rem + | AI_rem_un + | AI_shl + | AI_shr | AI_shr_un - | AI_sub - | AI_sub_ovf - | AI_sub_ovf_un - | AI_xor - | AI_or - | AI_neg - | AI_not - | AI_ldnull - | AI_dup + | AI_sub + | AI_sub_ovf + | AI_sub_ovf_un + | AI_xor + | AI_or + | AI_neg + | AI_not + | AI_ldnull + | AI_dup | AI_pop - | AI_ckfinite + | AI_ckfinite | AI_nop - | AI_ldc of ILBasicType * ILConst + | AI_ldc of ILBasicType * ILConst | I_ldarg of uint16 | I_ldarga of uint16 | I_ldind of ILAlignment * ILVolatility * ILBasicType @@ -1136,9 +1137,9 @@ type ILInstr = | I_br of ILCodeLabel | I_jmp of ILMethodSpec - | I_brcmp of ILComparisonInstr * ILCodeLabel - | I_switch of ILCodeLabel list - | I_ret + | I_brcmp of ILComparisonInstr * ILCodeLabel + | I_switch of ILCodeLabel list + | I_ret | I_call of ILTailcall * ILMethodSpec * ILVarArgs | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs @@ -1146,7 +1147,7 @@ type ILInstr = | I_calli of ILTailcall * ILCallingSignature * ILVarArgs | I_ldftn of ILMethodSpec | I_newobj of ILMethodSpec * ILVarArgs - + | I_throw | I_endfinally | I_endfilter @@ -1156,7 +1157,7 @@ type ILInstr = | I_ldsfld of ILVolatility * ILFieldSpec | I_ldfld of ILAlignment * ILVolatility * ILFieldSpec | I_ldsflda of ILFieldSpec - | I_ldflda of ILFieldSpec + | I_ldflda of ILFieldSpec | I_stsfld of ILVolatility * ILFieldSpec | I_stfld of ILAlignment * ILVolatility * ILFieldSpec | I_ldstr of string @@ -1179,69 +1180,69 @@ type ILInstr = | I_ldelema of ILReadonly * bool * ILArrayShape * ILType | I_ldelem_any of ILArrayShape * ILType | I_stelem_any of ILArrayShape * ILType - | I_newarr of ILArrayShape * ILType + | I_newarr of ILArrayShape * ILType | I_ldlen | I_mkrefany of ILType - | I_refanytype + | I_refanytype | I_refanyval of ILType - | I_break + | I_break | I_seqpoint of ILSourceMarker - | I_arglist + | I_arglist | I_localloc | I_cpblk of ILAlignment * ILVolatility | I_initblk of ILAlignment * ILVolatility - (* FOR EXTENSIONS, e.g. MS-ILX *) + (* FOR EXTENSIONS, e.g. MS-ILX *) | EI_ilzero of ILType | EI_ldlen_multi of int32 * int32 [] -type ILExceptionClause = +type ILExceptionClause = | Finally of (ILCodeLabel * ILCodeLabel) | Fault of (ILCodeLabel * ILCodeLabel) | FilterCatch of (ILCodeLabel * ILCodeLabel) * (ILCodeLabel * ILCodeLabel) | TypeCatch of ILType * (ILCodeLabel * ILCodeLabel) [] -type ILExceptionSpec = +type ILExceptionSpec = { Range: (ILCodeLabel * ILCodeLabel) Clause: ILExceptionClause } -/// Indicates that a particular local variable has a particular source -/// language name within a given set of ranges. This does not effect local -/// variable numbering, which is global over the whole method. +/// Indicates that a particular local variable has a particular source +/// language name within a given set of ranges. This does not effect local +/// variable numbering, which is global over the whole method. [] type ILLocalDebugMapping = { LocalIndex: int LocalName: string } [] -type ILLocalDebugInfo = +type ILLocalDebugInfo = { Range: (ILCodeLabel * ILCodeLabel) DebugMappings: ILLocalDebugMapping list } [] -type ILCode = - { Labels: Dictionary - Instrs: ILInstr[] - Exceptions: ILExceptionSpec list +type ILCode = + { Labels: Dictionary + Instrs: ILInstr[] + Exceptions: ILExceptionSpec list Locals: ILLocalDebugInfo list } [] -type ILLocal = +type ILLocal = { Type: ILType IsPinned: bool DebugInfo: (string * int * int) option } - + type ILLocals = list [] -type ILMethodBody = +type ILMethodBody = { IsZeroInit: bool MaxStack: int32 NoInlining: bool @@ -1251,17 +1252,17 @@ type ILMethodBody = SourceMarker: ILSourceMarker option } [] -type ILMemberAccess = +type ILMemberAccess = | Assembly | CompilerControlled | FamilyAndAssembly | FamilyOrAssembly | Family - | Private - | Public + | Private + | Public [] -type ILFieldInit = +type ILFieldInit = | String of string | Bool of bool | Char of uint16 @@ -1276,15 +1277,15 @@ type ILFieldInit = | Single of single | Double of double | Null - -// -------------------------------------------------------------------- + +// -------------------------------------------------------------------- // Native Types, for marshalling to the native C interface. // These are taken directly from the ILASM syntax, and don't really -// correspond yet to the ECMA Spec (Partition II, 7.4). -// -------------------------------------------------------------------- +// correspond yet to the ECMA Spec (Partition II, 7.4). +// -------------------------------------------------------------------- [] -type ILNativeType = +type ILNativeType = | Empty | Custom of ILGuid * string * string * byte[] (* guid, nativeTypeName, custMarshallerName, cookieString *) | FixedSysString of int32 @@ -1319,67 +1320,67 @@ type ILNativeType = | IUnknown | IDispatch | Interface - | Error - | SafeArray of ILNativeVariant * string option + | Error + | SafeArray of ILNativeVariant * string option | ANSIBSTR | VariantBool -and +and [] - ILNativeVariant = + ILNativeVariant = | Empty | Null | Variant | Currency - | Decimal - | Date - | BSTR - | LPSTR - | LPWSTR - | IUnknown - | IDispatch - | SafeArray - | Error - | HRESULT - | CArray - | UserDefined - | Record + | Decimal + | Date + | BSTR + | LPSTR + | LPWSTR + | IUnknown + | IDispatch + | SafeArray + | Error + | HRESULT + | CArray + | UserDefined + | Record | FileTime - | Blob - | Stream - | Storage - | StreamedObject - | StoredObject - | BlobObject - | CF + | Blob + | Stream + | Storage + | StreamedObject + | StoredObject + | BlobObject + | CF | CLSID - | Void + | Void | Bool | Int8 - | Int16 - | Int32 - | Int64 - | Single - | Double - | UInt8 - | UInt16 - | UInt32 - | UInt64 - | PTR - | Array of ILNativeVariant - | Vector of ILNativeVariant - | Byref of ILNativeVariant - | Int - | UInt + | Int16 + | Int32 + | Int64 + | Single + | Double + | UInt8 + | UInt16 + | UInt32 + | UInt64 + | PTR + | Array of ILNativeVariant + | Vector of ILNativeVariant + | Byref of ILNativeVariant + | Int + | UInt [] -type ILSecurityAction = - | Request +type ILSecurityAction = + | Request | Demand | Assert | Deny | PermitOnly - | LinkCheck + | LinkCheck | InheritCheck | ReqMin | ReqOpt @@ -1394,11 +1395,11 @@ type ILSecurityAction = | DemandChoice [] -type ILSecurityDecl = +type ILSecurityDecl = | ILSecurityDecl of ILSecurityAction * byte[] [] -type ILSecurityDecls(array : ILSecurityDecl[]) = +type ILSecurityDecls (array : ILSecurityDecl[]) = member x.AsArray = array member x.AsList = x.AsArray |> Array.toList @@ -1411,7 +1412,7 @@ type ILSecurityDeclsStored = /// Already computed | Given of ILSecurityDecls - member x.GetSecurityDecls metadataIndex = + member x.GetSecurityDecls metadataIndex = match x with | Reader f -> ILSecurityDecls(f metadataIndex) | Given attrs -> attrs @@ -1427,7 +1428,7 @@ let storeILSecurityDecls (x: ILSecurityDecls) = if x.AsArray.Length = 0 then emp let mkILSecurityDeclsReader f = ILSecurityDeclsStored.Reader f [] -type PInvokeCharBestFit = +type PInvokeCharBestFit = | UseAssembly | Enabled | Disabled @@ -1482,7 +1483,7 @@ type ILParameter = type ILParameters = list [] -type ILReturn = +type ILReturn = { Marshal: ILNativeType option Type: ILType CustomAttrsStored: ILAttributesStored @@ -1490,26 +1491,26 @@ type ILReturn = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex - member x.WithCustomAttrs(customAttrs) = { x with CustomAttrsStored = storeILCustomAttrs customAttrs } + member x.WithCustomAttrs customAttrs = { x with CustomAttrsStored = storeILCustomAttrs customAttrs } -type ILOverridesSpec = +type ILOverridesSpec = | OverridesSpec of ILMethodRef * ILType - member x.MethodRef = let (OverridesSpec(mr, _ty)) = x in mr + member x.MethodRef = let (OverridesSpec (mr, _ty)) = x in mr - member x.DeclaringType = let (OverridesSpec(_mr, ty)) = x in ty + member x.DeclaringType = let (OverridesSpec (_mr, ty)) = x in ty -type ILMethodVirtualInfo = +type ILMethodVirtualInfo = { IsFinal: bool - IsNewSlot: bool + IsNewSlot: bool IsCheckAccessOnOverride: bool IsAbstract: bool } type MethodKind = - | Static - | Cctor - | Ctor - | NonVirtual + | Static + | Cctor + | Ctor + | NonVirtual | Virtual of ILMethodVirtualInfo [] @@ -1520,7 +1521,7 @@ type MethodBody = | Native | NotAvailable -type ILLazyMethodBody = +type ILLazyMethodBody = | ILLazyMethodBody of Lazy member x.Contents = let (ILLazyMethodBody mb) = x in mb.Force() @@ -1547,10 +1548,10 @@ type ILGenericVariance = type ILGenericParameterDef = { Name: string Constraints: ILTypes - Variance: ILGenericVariance + Variance: ILGenericVariance HasReferenceTypeConstraint: bool HasNotNullableValueTypeConstraint: bool - HasDefaultConstructorConstraint: bool + HasDefaultConstructorConstraint: bool CustomAttrsStored : ILAttributesStored MetadataIndex: int32 } @@ -1560,18 +1561,18 @@ type ILGenericParameterDef = [] member x.DebugText = x.ToString() - override x.ToString() = x.Name + override x.ToString() = x.Name type ILGenericParameterDefs = ILGenericParameterDef list let memberAccessOfFlags flags = let f = (flags &&& 0x00000007) - if f = 0x00000001 then ILMemberAccess.Private - elif f = 0x00000006 then ILMemberAccess.Public - elif f = 0x00000004 then ILMemberAccess.Family - elif f = 0x00000002 then ILMemberAccess.FamilyAndAssembly - elif f = 0x00000005 then ILMemberAccess.FamilyOrAssembly - elif f = 0x00000003 then ILMemberAccess.Assembly + if f = 0x00000001 then ILMemberAccess.Private + elif f = 0x00000006 then ILMemberAccess.Public + elif f = 0x00000004 then ILMemberAccess.Family + elif f = 0x00000002 then ILMemberAccess.FamilyAndAssembly + elif f = 0x00000005 then ILMemberAccess.FamilyOrAssembly + elif f = 0x00000003 then ILMemberAccess.Assembly else ILMemberAccess.CompilerControlled let convertMemberAccess (ilMemberAccess: ILMemberAccess) = @@ -1593,10 +1594,10 @@ type ILMethodDef (name: string, attributes: MethodAttributes, implAttributes: Me parameters: ILParameters, ret: ILReturn, body: ILLazyMethodBody, isEntryPoint: bool, genericParams: ILGenericParameterDefs, securityDeclsStored: ILSecurityDeclsStored, customAttrsStored: ILAttributesStored, metadataIndex: int32) = - new (name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, securityDecls, customAttrs) = - ILMethodDef(name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, - storeILSecurityDecls securityDecls, storeILCustomAttrs customAttrs, NoMetadataIdx) - + new (name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, securityDecls, customAttrs) = + ILMethodDef (name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, + storeILSecurityDecls securityDecls, storeILCustomAttrs customAttrs, NoMetadataIdx) + // The captured data - remember the object will be as large as the data captured by these members member __.Name = name @@ -1622,9 +1623,9 @@ type ILMethodDef (name: string, attributes: MethodAttributes, implAttributes: Me member __.MetadataIndex = metadataIndex - member x.With (?name: string, ?attributes: MethodAttributes, ?implAttributes: MethodImplAttributes, - ?callingConv: ILCallingConv, ?parameters: ILParameters, ?ret: ILReturn, - ?body: ILLazyMethodBody, ?securityDecls: ILSecurityDecls, ?isEntryPoint: bool, + member x.With (?name: string, ?attributes: MethodAttributes, ?implAttributes: MethodImplAttributes, + ?callingConv: ILCallingConv, ?parameters: ILParameters, ?ret: ILReturn, + ?body: ILLazyMethodBody, ?securityDecls: ILSecurityDecls, ?isEntryPoint: bool, ?genericParams: ILGenericParameterDefs, ?customAttrs: ILAttributes) = ILMethodDef (name = defaultArg name x.Name, @@ -1645,8 +1646,8 @@ type ILMethodDef (name: string, attributes: MethodAttributes, implAttributes: Me member x.ParameterTypes = typesOfILParams x.Parameters - member md.Code = - match md.Body.Contents with + member md.Code = + match md.Body.Contents with | MethodBody.IL il-> Some il.Code | _ -> None @@ -1658,7 +1659,7 @@ type ILMethodDef (name: string, attributes: MethodAttributes, implAttributes: Me member x.SourceMarker = x.MethodBody.SourceMarker - member x.MaxStack = x.MethodBody.MaxStack + member x.MaxStack = x.MethodBody.MaxStack member x.IsZeroInit = x.MethodBody.IsZeroInit @@ -1691,61 +1692,61 @@ type ILMethodDef (name: string, attributes: MethodAttributes, implAttributes: Me member x.IsMustRun = x.ImplAttributes &&& MethodImplAttributes.NoOptimization <> enum 0 member x.WithSpecialName = x.With(attributes = (x.Attributes ||| MethodAttributes.SpecialName)) - member x.WithHideBySig() = + member x.WithHideBySig() = x.With(attributes = ( if x.IsVirtual then x.Attributes &&& ~~~MethodAttributes.CheckAccessOnOverride ||| MethodAttributes.HideBySig else failwith "WithHideBySig")) - member x.WithHideBySig(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.HideBySig)) - member x.WithFinal(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.Final)) - member x.WithAbstract(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.Abstract)) - member x.WithAccess(access) = x.With(attributes = (x.Attributes &&& ~~~MethodAttributes.MemberAccessMask ||| convertMemberAccess access)) + member x.WithHideBySig condition = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.HideBySig)) + member x.WithFinal condition = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.Final)) + member x.WithAbstract condition = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.Abstract)) + member x.WithAccess access = x.With(attributes = (x.Attributes &&& ~~~MethodAttributes.MemberAccessMask ||| convertMemberAccess access)) member x.WithNewSlot = x.With(attributes = (x.Attributes ||| MethodAttributes.NewSlot)) - member x.WithSecurity(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.HasSecurity)) - member x.WithPInvoke(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.PinvokeImpl)) - member x.WithPreserveSig(condition) = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.PreserveSig)) - member x.WithSynchronized(condition) = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.Synchronized)) - member x.WithNoInlining(condition) = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.NoInlining)) - member x.WithAggressiveInlining(condition) = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.AggressiveInlining)) - member x.WithRuntime(condition) = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.Runtime)) - -/// Index table by name and arity. + member x.WithSecurity condition = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.HasSecurity)) + member x.WithPInvoke condition = x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.PinvokeImpl)) + member x.WithPreserveSig condition = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.PreserveSig)) + member x.WithSynchronized condition = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.Synchronized)) + member x.WithNoInlining condition = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.NoInlining)) + member x.WithAggressiveInlining condition = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.AggressiveInlining)) + member x.WithRuntime condition = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.Runtime)) + +/// Index table by name and arity. type MethodDefMap = Map [] -type ILMethodDefs(f : (unit -> ILMethodDef[])) = +type ILMethodDefs(f : (unit -> ILMethodDef[])) = let mutable array = InlineDelayInit<_>(f) - let mutable dict = InlineDelayInit<_>(fun () -> + let mutable dict = InlineDelayInit<_>(fun () -> let arr = array.Value let t = Dictionary<_, _>() - for i = arr.Length - 1 downto 0 do + for i = arr.Length - 1 downto 0 do let y = arr.[i] let key = y.Name - match t.TryGetValue(key) with + match t.TryGetValue key with | true, m -> t.[key] <- y :: m | _ -> t.[key] <- [y] t) - interface IEnumerable with + interface IEnumerable with member x.GetEnumerator() = ((x :> IEnumerable).GetEnumerator() :> IEnumerator) - interface IEnumerable with + interface IEnumerable with member x.GetEnumerator() = (array.Value :> IEnumerable).GetEnumerator() member x.AsArray = array.Value member x.AsList = array.Value|> Array.toList - member x.FindByName(nm) = - match dict.Value.TryGetValue(nm) with + member x.FindByName nm = + match dict.Value.TryGetValue nm with | true, m -> m | _ -> [] member x.FindByNameAndArity (nm, arity) = x.FindByName nm |> List.filter (fun x -> List.length x.Parameters = arity) [] -type ILEventDef(eventType: ILType option, name: string, attributes: EventAttributes, - addMethod: ILMethodRef, removeMethod: ILMethodRef, fireMethod: ILMethodRef option, +type ILEventDef(eventType: ILType option, name: string, attributes: EventAttributes, + addMethod: ILMethodRef, removeMethod: ILMethodRef, fireMethod: ILMethodRef option, otherMethods: ILMethodRef list, customAttrsStored: ILAttributesStored, metadataIndex: int32) = new (eventType, name, attributes, addMethod, removeMethod, fireMethod, otherMethods, customAttrs) = @@ -1762,7 +1763,7 @@ type ILEventDef(eventType: ILType option, name: string, attributes: EventAttribu member __.MetadataIndex = metadataIndex member x.CustomAttrs = customAttrsStored.GetCustomAttrs x.MetadataIndex - member x.With(?eventType, ?name, ?attributes, ?addMethod, ?removeMethod, ?fireMethod, ?otherMethods, ?customAttrs) = + member x.With(?eventType, ?name, ?attributes, ?addMethod, ?removeMethod, ?fireMethod, ?otherMethods, ?customAttrs) = ILEventDef(eventType= defaultArg eventType x.EventType, name= defaultArg name x.Name, attributes= defaultArg attributes x.Attributes, @@ -1782,7 +1783,7 @@ type ILEventDef(eventType: ILType option, name: string, attributes: EventAttribu override x.ToString() = "event " + x.Name [] -type ILEventDefs = +type ILEventDefs = | ILEvents of LazyOrderedMultiMap member x.AsList = let (ILEvents t) = x in t.Entries() @@ -1790,8 +1791,8 @@ type ILEventDefs = member x.LookupByName s = let (ILEvents t) = x in t.[s] [] -type ILPropertyDef(name: string, attributes: PropertyAttributes, setMethod: ILMethodRef option, - getMethod: ILMethodRef option, callingConv: ILThisConvention, propertyType: ILType, +type ILPropertyDef(name: string, attributes: PropertyAttributes, setMethod: ILMethodRef option, + getMethod: ILMethodRef option, callingConv: ILThisConvention, propertyType: ILType, init: ILFieldInit option, args: ILTypes, customAttrsStored: ILAttributesStored, metadataIndex: int32) = new (name, attributes, setMethod, getMethod, callingConv, propertyType, init, args, customAttrs) = @@ -1809,7 +1810,7 @@ type ILPropertyDef(name: string, attributes: PropertyAttributes, setMethod: ILMe member x.CustomAttrs = customAttrsStored.GetCustomAttrs x.MetadataIndex member x.MetadataIndex = metadataIndex - member x.With(?name, ?attributes, ?setMethod, ?getMethod, ?callingConv, ?propertyType, ?init, ?args, ?customAttrs) = + member x.With(?name, ?attributes, ?setMethod, ?getMethod, ?callingConv, ?propertyType, ?init, ?args, ?customAttrs) = ILPropertyDef(name=defaultArg name x.Name, attributes=defaultArg attributes x.Attributes, setMethod=defaultArg setMethod x.SetMethod, @@ -1829,10 +1830,10 @@ type ILPropertyDef(name: string, attributes: PropertyAttributes, setMethod: ILMe member x.DebugText = x.ToString() override x.ToString() = "property " + x.Name - + // Index table by name. [] -type ILPropertyDefs = +type ILPropertyDefs = | ILProperties of LazyOrderedMultiMap member x.AsList = let (ILProperties t) = x in t.Entries() member x.LookupByName s = let (ILProperties t) = x in t.[s] @@ -1848,11 +1849,11 @@ let convertFieldAccess (ilMemberAccess: ILMemberAccess) = | ILMemberAccess.Public -> FieldAttributes.Public [] -type ILFieldDef(name: string, fieldType: ILType, attributes: FieldAttributes, data: byte[] option, - literalValue: ILFieldInit option, offset: int32 option, marshal: ILNativeType option, - customAttrsStored: ILAttributesStored, metadataIndex: int32) = +type ILFieldDef(name: string, fieldType: ILType, attributes: FieldAttributes, data: byte[] option, + literalValue: ILFieldInit option, offset: int32 option, marshal: ILNativeType option, + customAttrsStored: ILAttributesStored, metadataIndex: int32) = - new (name, fieldType, attributes, data, literalValue, offset, marshal, customAttrs) = + new (name, fieldType, attributes, data, literalValue, offset, marshal, customAttrs) = ILFieldDef(name, fieldType, attributes, data, literalValue, offset, marshal, storeILCustomAttrs customAttrs, NoMetadataIdx) member __.Name=name member __.FieldType = fieldType @@ -1865,7 +1866,7 @@ type ILFieldDef(name: string, fieldType: ILType, attributes: FieldAttributes, da member x.CustomAttrs = customAttrsStored.GetCustomAttrs x.MetadataIndex member x.MetadataIndex = metadataIndex - member x.With(?name: string, ?fieldType: ILType, ?attributes: FieldAttributes, ?data: byte[] option, ?literalValue: ILFieldInit option, ?offset: int32 option, ?marshal: ILNativeType option, ?customAttrs: ILAttributes) = + member x.With(?name: string, ?fieldType: ILType, ?attributes: FieldAttributes, ?data: byte[] option, ?literalValue: ILFieldInit option, ?offset: int32 option, ?marshal: ILNativeType option, ?customAttrs: ILAttributes) = ILFieldDef(name=defaultArg name x.Name, fieldType=defaultArg fieldType x.FieldType, attributes=defaultArg attributes x.Attributes, @@ -1880,17 +1881,16 @@ type ILFieldDef(name: string, fieldType: ILType, attributes: FieldAttributes, da member x.NotSerialized = x.Attributes &&& FieldAttributes.NotSerialized <> enum 0 member x.IsInitOnly = x.Attributes &&& FieldAttributes.InitOnly <> enum 0 member x.Access = memberAccessOfFlags (int x.Attributes) - member x.WithAccess(access) = x.With(attributes = (x.Attributes &&& ~~~FieldAttributes.FieldAccessMask ||| convertFieldAccess access)) - member x.WithInitOnly(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition FieldAttributes.InitOnly)) - member x.WithStatic(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition FieldAttributes.Static)) - member x.WithSpecialName(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition (FieldAttributes.SpecialName ||| FieldAttributes.RTSpecialName))) - member x.WithNotSerialized(condition) = x.With(attributes = (x.Attributes |> conditionalAdd condition FieldAttributes.NotSerialized)) - member x.WithLiteralDefaultValue(literal) = x.With(literalValue = literal, attributes = (x.Attributes |> conditionalAdd literal.IsSome (FieldAttributes.Literal ||| FieldAttributes.HasDefault))) - member x.WithFieldMarshal(marshal) = x.With(marshal = marshal, attributes = (x.Attributes |> conditionalAdd marshal.IsSome FieldAttributes.HasFieldMarshal)) - + member x.WithAccess access = x.With(attributes = (x.Attributes &&& ~~~FieldAttributes.FieldAccessMask ||| convertFieldAccess access)) + member x.WithInitOnly condition = x.With(attributes = (x.Attributes |> conditionalAdd condition FieldAttributes.InitOnly)) + member x.WithStatic condition = x.With(attributes = (x.Attributes |> conditionalAdd condition FieldAttributes.Static)) + member x.WithSpecialName condition = x.With(attributes = (x.Attributes |> conditionalAdd condition (FieldAttributes.SpecialName ||| FieldAttributes.RTSpecialName))) + member x.WithNotSerialized condition = x.With(attributes = (x.Attributes |> conditionalAdd condition FieldAttributes.NotSerialized)) + member x.WithLiteralDefaultValue literal = x.With(literalValue = literal, attributes = (x.Attributes |> conditionalAdd literal.IsSome (FieldAttributes.Literal ||| FieldAttributes.HasDefault))) + member x.WithFieldMarshal marshal = x.With(marshal = marshal, attributes = (x.Attributes |> conditionalAdd marshal.IsSome FieldAttributes.HasFieldMarshal)) // Index table by name. Keep a canonical list to make sure field order is not disturbed for binary manipulation. -type ILFieldDefs = +type ILFieldDefs = | ILFields of LazyOrderedMultiMap member x.AsList = let (ILFields t) = x in t.Entries() @@ -1901,8 +1901,8 @@ type ILMethodImplDef = { Overrides: ILOverridesSpec OverrideBy: ILMethodSpec } -// Index table by name and arity. -type ILMethodImplDefs = +// Index table by name and arity. +type ILMethodImplDefs = | ILMethodImpls of Lazy member x.AsList = let (ILMethodImpls ltab) = x in Map.foldBack (fun _x y r -> y@r) (ltab.Force()) [] @@ -1917,7 +1917,7 @@ type ILTypeDefLayout = and ILTypeDefLayoutInfo = { Size: int32 option - Pack: uint16 option } + Pack: uint16 option } [] type ILTypeInit = @@ -1931,25 +1931,25 @@ type ILDefaultPInvokeEncoding = | Unicode type ILTypeDefAccess = - | Public + | Public | Private - | Nested of ILMemberAccess + | Nested of ILMemberAccess let typeAccessOfFlags flags = let f = (flags &&& 0x00000007) - if f = 0x00000001 then ILTypeDefAccess.Public - elif f = 0x00000002 then ILTypeDefAccess.Nested ILMemberAccess.Public - elif f = 0x00000003 then ILTypeDefAccess.Nested ILMemberAccess.Private - elif f = 0x00000004 then ILTypeDefAccess.Nested ILMemberAccess.Family - elif f = 0x00000006 then ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly - elif f = 0x00000007 then ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly - elif f = 0x00000005 then ILTypeDefAccess.Nested ILMemberAccess.Assembly + if f = 0x00000001 then ILTypeDefAccess.Public + elif f = 0x00000002 then ILTypeDefAccess.Nested ILMemberAccess.Public + elif f = 0x00000003 then ILTypeDefAccess.Nested ILMemberAccess.Private + elif f = 0x00000004 then ILTypeDefAccess.Nested ILMemberAccess.Family + elif f = 0x00000006 then ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly + elif f = 0x00000007 then ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly + elif f = 0x00000005 then ILTypeDefAccess.Nested ILMemberAccess.Assembly else ILTypeDefAccess.Private -let typeEncodingOfFlags flags = +let typeEncodingOfFlags flags = let f = (flags &&& 0x00030000) - if f = 0x00020000 then ILDefaultPInvokeEncoding.Auto - elif f = 0x00010000 then ILDefaultPInvokeEncoding.Unicode + if f = 0x00020000 then ILDefaultPInvokeEncoding.Auto + elif f = 0x00010000 then ILDefaultPInvokeEncoding.Unicode else ILDefaultPInvokeEncoding.Ansi [] @@ -1957,28 +1957,28 @@ type ILTypeDefKind = | Class | ValueType | Interface - | Enum + | Enum | Delegate let typeKindOfFlags nm _mdefs _fdefs (super: ILType option) flags = - if (flags &&& 0x00000020) <> 0x0 then ILTypeDefKind.Interface - else - let isEnum, isDelegate, isMulticastDelegate, isValueType = - match super with + if (flags &&& 0x00000020) <> 0x0 then ILTypeDefKind.Interface + else + let isEnum, isDelegate, isMulticastDelegate, isValueType = + match super with | None -> false, false, false, false - | Some ty -> + | Some ty -> ty.TypeSpec.Name = "System.Enum", ty.TypeSpec.Name = "System.Delegate", ty.TypeSpec.Name = "System.MulticastDelegate", ty.TypeSpec.Name = "System.ValueType" && nm <> "System.Enum" let selfIsMulticastDelegate = nm = "System.MulticastDelegate" - if isEnum then ILTypeDefKind.Enum + if isEnum then ILTypeDefKind.Enum elif (isDelegate && not selfIsMulticastDelegate) || isMulticastDelegate then ILTypeDefKind.Delegate - elif isValueType then ILTypeDefKind.ValueType - else ILTypeDefKind.Class + elif isValueType then ILTypeDefKind.ValueType + else ILTypeDefKind.Class -let convertTypeAccessFlags access = - match access with +let convertTypeAccessFlags access = + match access with | ILTypeDefAccess.Public -> TypeAttributes.Public | ILTypeDefAccess.Private -> TypeAttributes.NotPublic | ILTypeDefAccess.Nested ILMemberAccess.Public -> TypeAttributes.NestedPublic @@ -2018,20 +2018,20 @@ let convertToNestedTypeAccess (ilMemberAccess: ILMemberAccess) = | ILMemberAccess.Family -> TypeAttributes.NestedFamily | ILMemberAccess.Private -> TypeAttributes.NestedPrivate | ILMemberAccess.Public -> TypeAttributes.NestedPublic - + let convertInitSemantics (init: ILTypeInit) = - match init with + match init with | ILTypeInit.BeforeField -> TypeAttributes.BeforeFieldInit | ILTypeInit.OnAny -> enum 0 [] type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout, implements: ILTypes, genericParams: ILGenericParameterDefs, extends: ILType option, methods: ILMethodDefs, nestedTypes: ILTypeDefs, fields: ILFieldDefs, methodImpls: ILMethodImplDefs, - events: ILEventDefs, properties: ILPropertyDefs, securityDeclsStored: ILSecurityDeclsStored, customAttrsStored: ILAttributesStored, metadataIndex: int32) = + events: ILEventDefs, properties: ILPropertyDefs, securityDeclsStored: ILSecurityDeclsStored, customAttrsStored: ILAttributesStored, metadataIndex: int32) = let mutable customAttrsStored = customAttrsStored - new (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, securityDecls, customAttrs) = + new (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, securityDecls, customAttrs) = ILTypeDef (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, storeILSecurityDecls securityDecls, storeILCustomAttrs customAttrs, NoMetadataIdx) member __.Name = name @@ -2050,7 +2050,7 @@ type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout member __.CustomAttrsStored = customAttrsStored member __.MetadataIndex = metadataIndex - member x.With(?name, ?attributes, ?layout, ?implements, ?genericParams, ?extends, ?methods, ?nestedTypes, ?fields, ?methodImpls, ?events, ?properties, ?customAttrs, ?securityDecls) = + member x.With(?name, ?attributes, ?layout, ?implements, ?genericParams, ?extends, ?methods, ?nestedTypes, ?fields, ?methodImpls, ?events, ?properties, ?customAttrs, ?securityDecls) = ILTypeDef(name=defaultArg name x.Name, attributes=defaultArg attributes x.Attributes, layout=defaultArg layout x.Layout, @@ -2066,13 +2066,13 @@ type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout properties = defaultArg properties x.Properties, customAttrs = defaultArg customAttrs x.CustomAttrs) - member x.CustomAttrs = - match customAttrsStored with + member x.CustomAttrs = + match customAttrsStored with | ILAttributesStored.Reader f -> let res = ILAttributes(f x.MetadataIndex) customAttrsStored <- ILAttributesStored.Given res - res - | ILAttributesStored.Given res -> + res + | ILAttributesStored.Given res -> res member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex @@ -2082,36 +2082,36 @@ type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout member x.IsInterface = (typeKindOfFlags x.Name x.Methods x.Fields x.Extends (int x.Attributes)) = ILTypeDefKind.Interface member x.IsEnum = (typeKindOfFlags x.Name x.Methods x.Fields x.Extends (int x.Attributes)) = ILTypeDefKind.Enum member x.IsDelegate = (typeKindOfFlags x.Name x.Methods x.Fields x.Extends (int x.Attributes)) = ILTypeDefKind.Delegate - member x.Access = typeAccessOfFlags (int x.Attributes) + member x.Access = typeAccessOfFlags (int x.Attributes) member x.IsAbstract = x.Attributes &&& TypeAttributes.Abstract <> enum 0 member x.IsSealed = x.Attributes &&& TypeAttributes.Sealed <> enum 0 member x.IsSerializable = x.Attributes &&& TypeAttributes.Serializable <> enum 0 - member x.IsComInterop = x.Attributes &&& TypeAttributes.Import <> enum 0 (* Class or interface generated for COM interop *) + member x.IsComInterop = x.Attributes &&& TypeAttributes.Import <> enum 0 (* Class or interface generated for COM interop *) member x.IsSpecialName = x.Attributes &&& TypeAttributes.SpecialName <> enum 0 member x.HasSecurity = x.Attributes &&& TypeAttributes.HasSecurity <> enum 0 member x.Encoding = typeEncodingOfFlags (int x.Attributes) member x.IsStructOrEnum = x.IsStruct || x.IsEnum - member x.WithAccess(access) = x.With(attributes=(x.Attributes &&& ~~~TypeAttributes.VisibilityMask ||| convertTypeAccessFlags access)) - member x.WithNestedAccess(access) = x.With(attributes=(x.Attributes &&& ~~~TypeAttributes.VisibilityMask ||| convertToNestedTypeAccess access)) - member x.WithSealed(condition) = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.Sealed)) - member x.WithSerializable(condition) = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.Serializable)) - member x.WithAbstract(condition) = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.Abstract)) - member x.WithImport(condition) = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.Import)) - member x.WithHasSecurity(condition) = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.HasSecurity)) - member x.WithLayout(layout) = x.With(attributes=(x.Attributes ||| convertLayout layout), layout = layout) - member x.WithKind(kind) = x.With(attributes=(x.Attributes ||| convertTypeKind kind), extends = match kind with ILTypeDefKind.Interface -> None | _ -> x.Extends) - member x.WithEncoding(encoding) = x.With(attributes=(x.Attributes &&& ~~~TypeAttributes.StringFormatMask ||| convertEncoding encoding)) - member x.WithSpecialName(condition) = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.SpecialName)) - member x.WithInitSemantics(init) = x.With(attributes=(x.Attributes ||| convertInitSemantics init)) + member x.WithAccess access = x.With(attributes=(x.Attributes &&& ~~~TypeAttributes.VisibilityMask ||| convertTypeAccessFlags access)) + member x.WithNestedAccess access = x.With(attributes=(x.Attributes &&& ~~~TypeAttributes.VisibilityMask ||| convertToNestedTypeAccess access)) + member x.WithSealed condition = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.Sealed)) + member x.WithSerializable condition = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.Serializable)) + member x.WithAbstract condition = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.Abstract)) + member x.WithImport condition = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.Import)) + member x.WithHasSecurity condition = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.HasSecurity)) + member x.WithLayout layout = x.With(attributes=(x.Attributes ||| convertLayout layout), layout = layout) + member x.WithKind kind = x.With(attributes=(x.Attributes ||| convertTypeKind kind), extends = match kind with ILTypeDefKind.Interface -> None | _ -> x.Extends) + member x.WithEncoding encoding = x.With(attributes=(x.Attributes &&& ~~~TypeAttributes.StringFormatMask ||| convertEncoding encoding)) + member x.WithSpecialName condition = x.With(attributes=(x.Attributes |> conditionalAdd condition TypeAttributes.SpecialName)) + member x.WithInitSemantics init = x.With(attributes=(x.Attributes ||| convertInitSemantics init)) and [] ILTypeDefs(f : unit -> ILPreTypeDef[]) = let mutable array = InlineDelayInit<_>(f) - let mutable dict = InlineDelayInit<_>(fun () -> + let mutable dict = InlineDelayInit<_>(fun () -> let arr = array.Value let t = Dictionary<_, _>(HashIdentity.Structural) - for pre in arr do + for pre in arr do let key = pre.Namespace, pre.Name t.[key] <- pre t) @@ -2120,41 +2120,41 @@ and [] ILTypeDefs(f : unit -> ILPreTypeDef[]) = member x.AsList = [ for pre in array.Value -> pre.GetTypeDef() ] - interface IEnumerable with + interface IEnumerable with member x.GetEnumerator() = ((x :> IEnumerable).GetEnumerator() :> IEnumerator) - interface IEnumerable with - member x.GetEnumerator() = + interface IEnumerable with + member x.GetEnumerator() = (seq { for pre in array.Value -> pre.GetTypeDef() }).GetEnumerator() - + member x.AsArrayOfPreTypeDefs = array.Value - member x.FindByName nm = + member x.FindByName nm = let ns, n = splitILTypeName nm dict.Value.[(ns, n)].GetTypeDef() /// This is a memory-critical class. Very many of these objects get allocated and held to represent the contents of .NET assemblies. -and [] ILPreTypeDef(nameSpace: string list, name: string, metadataIndex: int32, storage: ILTypeDefStored) = +and [] ILPreTypeDef(nameSpace: string list, name: string, metadataIndex: int32, storage: ILTypeDefStored) = let mutable store : ILTypeDef = Unchecked.defaultof<_> member __.Namespace = nameSpace member __.Name = name member __.MetadataIndex = metadataIndex - member x.GetTypeDef() = - match box store with - | null -> - match storage with - | ILTypeDefStored.Given td -> + member x.GetTypeDef() = + match box store with + | null -> + match storage with + | ILTypeDefStored.Given td -> store <- td td - | ILTypeDefStored.Computed f -> - System.Threading.LazyInitializer.EnsureInitialized(&store, System.Func<_>(fun () -> f())) - | ILTypeDefStored.Reader f -> - System.Threading.LazyInitializer.EnsureInitialized(&store, System.Func<_>(fun () -> f x.MetadataIndex)) + | ILTypeDefStored.Computed f -> + LazyInitializer.EnsureInitialized(&store, Func<_>(fun () -> f())) + | ILTypeDefStored.Reader f -> + LazyInitializer.EnsureInitialized(&store, Func<_>(fun () -> f x.MetadataIndex)) | _ -> store - -and ILTypeDefStored = + +and ILTypeDefStored = | Given of ILTypeDef | Reader of (int32 -> ILTypeDef) | Computed of (unit -> ILTypeDef) @@ -2165,12 +2165,12 @@ type ILNestedExportedType = { Name: string Access: ILMemberAccess Nested: ILNestedExportedTypes - CustomAttrsStored: ILAttributesStored - MetadataIndex: int32 } + CustomAttrsStored: ILAttributesStored + MetadataIndex: int32 } member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex -and ILNestedExportedTypes = +and ILNestedExportedTypes = | ILNestedExportedTypes of Lazy> member x.AsList = let (ILNestedExportedTypes ltab) = x in Map.foldBack (fun _x y r -> y::r) (ltab.Force()) [] @@ -2181,24 +2181,24 @@ and [] Name: string Attributes: TypeAttributes Nested: ILNestedExportedTypes - CustomAttrsStored: ILAttributesStored - MetadataIndex: int32 } + CustomAttrsStored: ILAttributesStored + MetadataIndex: int32 } - member x.Access = typeAccessOfFlags (int x.Attributes) + member x.Access = typeAccessOfFlags (int x.Attributes) member x.IsForwarder = x.Attributes &&& enum(0x00200000) <> enum 0 member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex -and ILExportedTypesAndForwarders = +and ILExportedTypesAndForwarders = | ILExportedTypesAndForwarders of Lazy> member x.AsList = let (ILExportedTypesAndForwarders ltab) = x in Map.foldBack (fun _x y r -> y::r) (ltab.Force()) [] [] -type ILResourceAccess = - | Public - | Private +type ILResourceAccess = + | Public + | Private [] type ILResourceLocation = @@ -2211,27 +2211,27 @@ type ILResource = { Name: string Location: ILResourceLocation Access: ILResourceAccess - CustomAttrsStored: ILAttributesStored + CustomAttrsStored: ILAttributesStored MetadataIndex: int32 } /// Read the bytes from a resource local to an assembly - member r.GetBytes() = + member r.GetBytes() = match r.Location with - | ILResourceLocation.LocalIn (file, start, len) -> + | ILResourceLocation.LocalIn (file, start, len) -> File.ReadBinaryChunk(file, start, len) | ILResourceLocation.LocalOut bytes -> bytes | _ -> failwith "GetBytes" member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex -type ILResources = +type ILResources = | ILResources of ILResource list member x.AsList = let (ILResources ltab) = x in ltab -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // One module in the "current" assembly -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- [] type ILAssemblyLongevity = @@ -2242,7 +2242,7 @@ type ILAssemblyLongevity = | PlatformSystem -type ILAssemblyManifest = +type ILAssemblyManifest = { Name: string AuxModuleHashAlgorithm: int32 SecurityDeclsStored: ILSecurityDeclsStored @@ -2251,30 +2251,30 @@ type ILAssemblyManifest = Locale: Locale option CustomAttrsStored: ILAttributesStored - AssemblyLongevity: ILAssemblyLongevity + AssemblyLongevity: ILAssemblyLongevity DisableJitOptimizations: bool JitTracking: bool IgnoreSymbolStoreSequencePoints: bool Retargetable: bool - /// Records the types implemented by other modules. + /// Records the types implemented by other modules. ExportedTypes: ILExportedTypesAndForwarders - /// Records whether the entrypoint resides in another module. - EntrypointElsewhere: ILModuleRef option + /// Records whether the entrypoint resides in another module. + EntrypointElsewhere: ILModuleRef option MetadataIndex: int32 - } + } member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex [] -type ILNativeResource = +type ILNativeResource = | In of fileName: string * linkedResourceBase: int * linkedResourceStart: int * linkedResourceLength: int | Out of unlinkedResource: byte[] -type ILModuleDef = +type ILModuleDef = { Manifest: ILAssemblyManifest option Name: string TypeDefs: ILTypeDefs @@ -2294,24 +2294,24 @@ type ILModuleDef = MetadataVersion: string Resources: ILResources /// e.g. win32 resources - NativeResources: ILNativeResource list + NativeResources: ILNativeResource list CustomAttrsStored: ILAttributesStored MetadataIndex: int32 } - member x.ManifestOfAssembly = - match x.Manifest with + member x.ManifestOfAssembly = + match x.Manifest with | Some m -> m | None -> failwith "no manifest" - member m.HasManifest = + member m.HasManifest = match m.Manifest with None -> false | _ -> true member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Add fields and types to tables, with decent error messages // when clashes occur... -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let mkILEmptyGenericParams = ([]: ILGenericParameterDefs) @@ -2319,26 +2319,26 @@ let emptyILGenericArgsList = ([]: ILType list) // -------------------------------------------------------------------- // Make ILTypeRefs etc. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let mkILNestedTyRef (scope, l, nm) = ILTypeRef.Create(scope, l, nm) +let mkILNestedTyRef (scope, l, nm) = ILTypeRef.Create (scope, l, nm) let mkILTyRef (scope, nm) = mkILNestedTyRef (scope, [], nm) type ILGenericArgsList = ILType list -let mkILTySpec (tref, inst) = ILTypeSpec.Create(tref, inst) +let mkILTySpec (tref, inst) = ILTypeSpec.Create (tref, inst) let mkILNonGenericTySpec tref = mkILTySpec (tref, []) -let mkILTyRefInTyRef (tref: ILTypeRef, nm) = +let mkILTyRefInTyRef (tref: ILTypeRef, nm) = mkILNestedTyRef (tref.Scope, tref.Enclosing@[tref.Name], nm) -let mkILTy boxed tspec = +let mkILTy boxed tspec = match boxed with AsObject -> mkILBoxedType tspec | _ -> ILType.Value tspec -let mkILNamedTy vc tref tinst = mkILTy vc (ILTypeSpec.Create(tref, tinst)) +let mkILNamedTy vc tref tinst = mkILTy vc (ILTypeSpec.Create (tref, tinst)) let mkILValueTy tref tinst = mkILNamedTy AsValue tref tinst @@ -2348,31 +2348,31 @@ let mkILNonGenericValueTy tref = mkILNamedTy AsValue tref [] let mkILNonGenericBoxedTy tref = mkILNamedTy AsObject tref [] -let mkSimpleAssemblyRef n = - ILAssemblyRef.Create(n, None, None, false, None, None) +let mkSimpleAssemblyRef n = + ILAssemblyRef.Create (n, None, None, false, None, None) -let mkSimpleModRef n = - ILModuleRef.Create(n, true, None) +let mkSimpleModRef n = + ILModuleRef.Create (n, true, None) // -------------------------------------------------------------------- // The toplevel class of a module is called "" -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let typeNameForGlobalFunctions = "" -let mkILTypeForGlobalFunctions scoref = mkILBoxedType (mkILNonGenericTySpec (ILTypeRef.Create(scoref, [], typeNameForGlobalFunctions))) +let mkILTypeForGlobalFunctions scoref = mkILBoxedType (mkILNonGenericTySpec (ILTypeRef.Create (scoref, [], typeNameForGlobalFunctions))) let isTypeNameForGlobalFunctions d = (d = typeNameForGlobalFunctions) let mkILMethRef (tref, callconv, nm, gparams, args, rty) = - { mrefParent=tref + { mrefParent=tref mrefCallconv=callconv mrefGenericArity=gparams mrefName=nm mrefArgs=args mrefReturn=rty} -let mkILMethSpecForMethRefInTy (mref, ty, minst) = +let mkILMethSpecForMethRefInTy (mref, ty, minst) = { mspecMethodRef=mref mspecDeclaringType=ty mspecMethodInst=minst } @@ -2385,7 +2385,7 @@ let mkILMethSpecInTypeRef (tref, vc, cc, nm, args, rty, tinst, minst) = let mkILMethSpecInTy (ty: ILType, cc, nm, args, rty, minst: ILGenericArgs) = mkILMethSpecForMethRefInTy (mkILMethRef (ty.TypeRef, cc, nm, minst.Length, args, rty), ty, minst) -let mkILNonGenericMethSpecInTy (ty, cc, nm, args, rty) = +let mkILNonGenericMethSpecInTy (ty, cc, nm, args, rty) = mkILMethSpecInTy (ty, cc, nm, args, rty, []) let mkILInstanceMethSpecInTy (ty: ILType, nm, args, rty, minst) = @@ -2400,48 +2400,48 @@ let mkILStaticMethSpecInTy (ty, nm, args, rty, minst) = let mkILNonGenericStaticMethSpecInTy (ty, nm, args, rty) = mkILStaticMethSpecInTy (ty, nm, args, rty, []) -let mkILCtorMethSpec (tref, args, cinst) = - mkILMethSpecInTypeRef(tref, AsObject, ILCallingConv.Instance, ".ctor", args, ILType.Void, cinst, []) +let mkILCtorMethSpec (tref, args, cinst) = + mkILMethSpecInTypeRef (tref, AsObject, ILCallingConv.Instance, ".ctor", args, ILType.Void, cinst, []) -let mkILCtorMethSpecForTy (ty, args) = - mkILMethSpecInTy(ty, ILCallingConv.Instance, ".ctor", args, ILType.Void, []) +let mkILCtorMethSpecForTy (ty, args) = + mkILMethSpecInTy (ty, ILCallingConv.Instance, ".ctor", args, ILType.Void, []) -let mkILNonGenericCtorMethSpec (tref, args) = +let mkILNonGenericCtorMethSpec (tref, args) = mkILCtorMethSpec (tref, args, []) // -------------------------------------------------------------------- // Make references to fields -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let mkILFieldRef(tref, nm, ty) = { DeclaringTypeRef=tref; Name=nm; Type=ty} +let mkILFieldRef (tref, nm, ty) = { DeclaringTypeRef=tref; Name=nm; Type=ty} let mkILFieldSpec (tref, ty) = { FieldRef= tref; DeclaringType=ty } -let mkILFieldSpecInTy (ty: ILType, nm, fty) = +let mkILFieldSpecInTy (ty: ILType, nm, fty) = mkILFieldSpec (mkILFieldRef (ty.TypeRef, nm, fty), ty) - -let andTailness x y = + +let andTailness x y = match x with Tailcall when y -> Tailcall | _ -> Normalcall -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Basic operations on code. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let formatCodeLabel (x: int) = "L"+string x // ++GLOBAL MUTABLE STATE (concurrency safe) let codeLabelCount = ref 0 -let generateCodeLabel() = System.Threading.Interlocked.Increment(codeLabelCount) +let generateCodeLabel() = Interlocked.Increment codeLabelCount -let instrIsRet i = - match i with +let instrIsRet i = + match i with | I_ret -> true | _ -> false -let nonBranchingInstrsToCode instrs : ILCode = +let nonBranchingInstrsToCode instrs : ILCode = let instrs = Array.ofList instrs - let instrs = + let instrs = if instrs.Length <> 0 && instrIsRet (Array.last instrs) then instrs else Array.append instrs [| I_ret |] @@ -2451,9 +2451,9 @@ let nonBranchingInstrsToCode instrs : ILCode = Locals = [] } -// -------------------------------------------------------------------- -// -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- +// +// -------------------------------------------------------------------- let mkILTyvarTy tv = ILType.TypeVar tv @@ -2473,29 +2473,29 @@ let mkILFormalTypars (x: ILGenericArgsList) = List.map gparam_of_gactual x let mkILFormalGenericArgs numtypars (gparams: ILGenericParameterDefs) = List.mapi (fun n _gf -> mkILTyvarTy (uint16 (numtypars + n))) gparams - + let mkILFormalBoxedTy tref gparams = mkILBoxedTy tref (mkILFormalGenericArgs 0 gparams) let mkILFormalNamedTy bx tref gparams = mkILNamedTy bx tref (mkILFormalGenericArgs 0 gparams) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Operations on class etc. defs. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let mkRefForNestedILTypeDef scope (enc: ILTypeDef list, td: ILTypeDef) = - mkILNestedTyRef(scope, (enc |> List.map (fun etd -> etd.Name)), td.Name) +let mkRefForNestedILTypeDef scope (enc: ILTypeDef list, td: ILTypeDef) = + mkILNestedTyRef (scope, (enc |> List.map (fun etd -> etd.Name)), td.Name) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Operations on type tables. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let mkILPreTypeDef (td: ILTypeDef) = +let mkILPreTypeDef (td: ILTypeDef) = let ns, n = splitILTypeName td.Name - ILPreTypeDef(ns, n, NoMetadataIdx, ILTypeDefStored.Given td) + ILPreTypeDef (ns, n, NoMetadataIdx, ILTypeDefStored.Given td) let mkILPreTypeDefComputed (ns, n, f) = - ILPreTypeDef(ns, n, NoMetadataIdx, ILTypeDefStored.Computed f) + ILPreTypeDef (ns, n, NoMetadataIdx, ILTypeDefStored.Computed f) let mkILPreTypeDefRead (ns, n, idx, f) = - ILPreTypeDef(ns, n, idx, f) + ILPreTypeDef (ns, n, idx, f) let addILTypeDef td (tdefs: ILTypeDefs) = ILTypeDefs (fun () -> [| yield mkILPreTypeDef td; yield! tdefs.AsArrayOfPreTypeDefs |]) @@ -2504,42 +2504,45 @@ let mkILTypeDefs l = mkILTypeDefsFromArray (Array.ofList l) let mkILTypeDefsComputed f = ILTypeDefs f let emptyILTypeDefs = mkILTypeDefsFromArray [| |] -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Operations on method tables. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let mkILMethodsFromArray xs = ILMethodDefs (fun () -> xs) let mkILMethods xs = xs |> Array.ofList |> mkILMethodsFromArray let mkILMethodsComputed f = ILMethodDefs f let emptyILMethods = mkILMethodsFromArray [| |] -let filterILMethodDefs f (mdefs: ILMethodDefs) = +let filterILMethodDefs f (mdefs: ILMethodDefs) = ILMethodDefs (fun () -> mdefs.AsArray |> Array.filter f) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Operations and defaults for modules, assemblies etc. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let defaultSubSystem = 3 (* this is what comes out of ILDASM on 30/04/2001 *) let defaultPhysAlignment = 512 (* this is what comes out of ILDASM on 30/04/2001 *) let defaultVirtAlignment = 0x2000 (* this is what comes out of ILDASM on 30/04/2001 *) let defaultImageBase = 0x034f0000 (* this is what comes out of ILDASM on 30/04/2001 *) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Array types -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let mkILArrTy (ty, shape) = ILType.Array(shape, ty) +let mkILArrTy (ty, shape) = ILType.Array (shape, ty) let mkILArr1DTy ty = mkILArrTy (ty, ILArrayShape.SingleDimensional) let isILArrTy ty = match ty with ILType.Array _ -> true| _ -> false -let destILArrTy ty = match ty with ILType.Array(shape, ty) -> (shape, ty) | _ -> failwith "destILArrTy" +let destILArrTy ty = + match ty with + | ILType.Array (shape, ty) -> (shape, ty) + | _ -> failwith "destILArrTy" -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Sigs of special types built-in -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- [] let tname_Object = "System.Object" @@ -2597,9 +2600,9 @@ let tname_UIntPtr = "System.UIntPtr" [] // This data structure needs an entirely delayed implementation -type ILGlobals(primaryScopeRef) = - - let m_mkSysILTypeRef nm = mkILTyRef(primaryScopeRef, nm) +type ILGlobals(primaryScopeRef) = + + let m_mkSysILTypeRef nm = mkILTyRef (primaryScopeRef, nm) let m_typ_Object = mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Object)) let m_typ_String = mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_String)) @@ -2626,9 +2629,9 @@ type ILGlobals(primaryScopeRef) = member x.typ_String = m_typ_String member x.typ_Array = m_typ_Array member x.typ_Type = m_typ_Type - member x.typ_IntPtr = m_typ_IntPtr + member x.typ_IntPtr = m_typ_IntPtr member x.typ_UIntPtr = m_typ_UIntPtr - member x.typ_Byte = m_typ_Byte + member x.typ_Byte = m_typ_Byte member x.typ_Int16 = m_typ_Int16 member x.typ_Int32 = m_typ_Int32 member x.typ_Int64 = m_typ_Int64 @@ -2686,13 +2689,13 @@ let tname_CompilerGeneratedAttribute = "System.Runtime.CompilerServices.Compiler let tname_DebuggableAttribute = "System.Diagnostics.DebuggableAttribute" (* NOTE: ecma_ prefix refers to the standard "mscorlib" *) -let ecmaPublicKey = PublicKeyToken (Bytes.ofInt32Array [|0xde; 0xad; 0xbe; 0xef; 0xca; 0xfe; 0xfa; 0xce |]) - +let ecmaPublicKey = PublicKeyToken (Bytes.ofInt32Array [|0xde; 0xad; 0xbe; 0xef; 0xca; 0xfe; 0xfa; 0xce |]) + let isILBoxedTy = function ILType.Boxed _ -> true | _ -> false let isILValueTy = function ILType.Value _ -> true | _ -> false -let isPrimaryAssemblyTySpec (tspec: ILTypeSpec) n = +let isPrimaryAssemblyTySpec (tspec: ILTypeSpec) n = let tref = tspec.TypeRef let scoref = tref.Scope (tref.Name = n) && @@ -2701,12 +2704,12 @@ let isPrimaryAssemblyTySpec (tspec: ILTypeSpec) n = | ILScopeRef.Module _ -> false | ILScopeRef.Local -> true -let isILBoxedPrimaryAssemblyTy (ty: ILType) n = +let isILBoxedPrimaryAssemblyTy (ty: ILType) n = isILBoxedTy ty && isPrimaryAssemblyTySpec ty.TypeSpec n -let isILValuePrimaryAssemblyTy (ty: ILType) n = +let isILValuePrimaryAssemblyTy (ty: ILType) n = isILValueTy ty && isPrimaryAssemblyTySpec ty.TypeSpec n - + let isILObjectTy ty = isILBoxedPrimaryAssemblyTy ty tname_Object let isILStringTy ty = isILBoxedPrimaryAssemblyTy ty tname_String @@ -2741,67 +2744,67 @@ let isILSingleTy ty = isILValuePrimaryAssemblyTy ty tname_Single let isILDoubleTy ty = isILValuePrimaryAssemblyTy ty tname_Double -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Rescoping -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let rescopeILScopeRef scoref scoref1 = - match scoref, scoref1 with - | _, ILScopeRef.Local -> scoref +let rescopeILScopeRef scoref scoref1 = + match scoref, scoref1 with + | _, ILScopeRef.Local -> scoref | ILScopeRef.Local, _ -> scoref1 | _, ILScopeRef.Module _ -> scoref | ILScopeRef.Module _, _ -> scoref1 | _ -> scoref1 -let rescopeILTypeRef scoref (tref1: ILTypeRef) = - let scoref1 = tref1.Scope +let rescopeILTypeRef scoref (tref1: ILTypeRef) = + let scoref1 = tref1.Scope let scoref2 = rescopeILScopeRef scoref scoref1 if scoref1 === scoref2 then tref1 - else ILTypeRef.Create(scoref2, tref1.Enclosing, tref1.Name) + else ILTypeRef.Create (scoref2, tref1.Enclosing, tref1.Name) // ORIGINAL IMPLEMENTATION (too many allocations // { tspecTypeRef=rescopeILTypeRef scoref tref -// tspecInst=rescopeILTypes scoref tinst } -let rec rescopeILTypeSpec scoref (tspec1: ILTypeSpec) = +// tspecInst=rescopeILTypes scoref tinst } +let rec rescopeILTypeSpec scoref (tspec1: ILTypeSpec) = let tref1 = tspec1.TypeRef let tinst1 = tspec1.GenericArgs let tref2 = rescopeILTypeRef scoref tref1 - // avoid reallocation in the common case - if tref1 === tref2 then + // avoid reallocation in the common case + if tref1 === tref2 then if isNil tinst1 then tspec1 else let tinst2 = rescopeILTypes scoref tinst1 - if tinst1 === tinst2 then tspec1 else + if tinst1 === tinst2 then tspec1 else ILTypeSpec.Create (tref2, tinst2) else let tinst2 = rescopeILTypes scoref tinst1 ILTypeSpec.Create (tref2, tinst2) -and rescopeILType scoref ty = - match ty with +and rescopeILType scoref ty = + match ty with | ILType.Ptr t -> ILType.Ptr (rescopeILType scoref t) | ILType.FunctionPointer t -> ILType.FunctionPointer (rescopeILCallSig scoref t) | ILType.Byref t -> ILType.Byref (rescopeILType scoref t) - | ILType.Boxed cr1 -> + | ILType.Boxed cr1 -> let cr2 = rescopeILTypeSpec scoref cr1 - if cr1 === cr2 then ty else + if cr1 === cr2 then ty else mkILBoxedType cr2 - | ILType.Array (s, ety1) -> + | ILType.Array (s, ety1) -> let ety2 = rescopeILType scoref ety1 - if ety1 === ety2 then ty else + if ety1 === ety2 then ty else ILType.Array (s, ety2) - | ILType.Value cr1 -> - let cr2 = rescopeILTypeSpec scoref cr1 - if cr1 === cr2 then ty else + | ILType.Value cr1 -> + let cr2 = rescopeILTypeSpec scoref cr1 + if cr1 === cr2 then ty else ILType.Value cr2 - | ILType.Modified(b, tref, ty) -> ILType.Modified(b, rescopeILTypeRef scoref tref, rescopeILType scoref ty) + | ILType.Modified (b, tref, ty) -> ILType.Modified (b, rescopeILTypeRef scoref tref, rescopeILType scoref ty) | x -> x -and rescopeILTypes scoref i = +and rescopeILTypes scoref i = if isNil i then i else List.mapq (rescopeILType scoref) i -and rescopeILCallSig scoref csig = +and rescopeILCallSig scoref csig = mkILCallSig (csig.CallingConv, rescopeILTypes scoref csig.ArgTypes, rescopeILType scoref csig.ReturnType) let rescopeILMethodRef scoref (x: ILMethodRef) = @@ -2812,46 +2815,46 @@ let rescopeILMethodRef scoref (x: ILMethodRef) = mrefArgs = rescopeILTypes scoref x.mrefArgs mrefReturn= rescopeILType scoref x.mrefReturn } -let rescopeILFieldRef scoref x = +let rescopeILFieldRef scoref x = { DeclaringTypeRef = rescopeILTypeRef scoref x.DeclaringTypeRef Name= x.Name Type= rescopeILType scoref x.Type } -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Instantiate polymorphism in types -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let rec instILTypeSpecAux numFree inst (tspec: ILTypeSpec) = - ILTypeSpec.Create(tspec.TypeRef, instILGenericArgsAux numFree inst tspec.GenericArgs) - -and instILTypeAux numFree (inst: ILGenericArgs) ty = - match ty with +let rec instILTypeSpecAux numFree inst (tspec: ILTypeSpec) = + ILTypeSpec.Create (tspec.TypeRef, instILGenericArgsAux numFree inst tspec.GenericArgs) + +and instILTypeAux numFree (inst: ILGenericArgs) ty = + match ty with | ILType.Ptr t -> ILType.Ptr (instILTypeAux numFree inst t) | ILType.FunctionPointer t -> ILType.FunctionPointer (instILCallSigAux numFree inst t) | ILType.Array (a, t) -> ILType.Array (a, instILTypeAux numFree inst t) | ILType.Byref t -> ILType.Byref (instILTypeAux numFree inst t) | ILType.Boxed cr -> mkILBoxedType (instILTypeSpecAux numFree inst cr) | ILType.Value cr -> ILType.Value (instILTypeSpecAux numFree inst cr) - | ILType.TypeVar v -> + | ILType.TypeVar v -> let v = int v let top = inst.Length if v < numFree then ty else - if v - numFree >= top then - ILType.TypeVar (uint16 (v - top)) - else + if v - numFree >= top then + ILType.TypeVar (uint16 (v - top)) + else List.item (v - numFree) inst | x -> x - + and instILGenericArgsAux numFree inst i = List.map (instILTypeAux numFree inst) i -and instILCallSigAux numFree inst csig = +and instILCallSigAux numFree inst csig = mkILCallSig (csig.CallingConv, List.map (instILTypeAux numFree inst) csig.ArgTypes, instILTypeAux numFree inst csig.ReturnType) let instILType i t = instILTypeAux 0 i t // -------------------------------------------------------------------- // MS-IL: Parameters, Return types and Locals -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let mkILParam (name, ty) : ILParameter = { Name=name @@ -2868,40 +2871,40 @@ let mkILParamNamed (s, ty) = mkILParam (Some s, ty) let mkILParamAnon ty = mkILParam (None, ty) -let mkILReturn ty : ILReturn = +let mkILReturn ty : ILReturn = { Marshal=None Type=ty CustomAttrsStored=storeILCustomAttrs emptyILCustomAttrs MetadataIndex = NoMetadataIdx } -let mkILLocal ty dbgInfo : ILLocal = +let mkILLocal ty dbgInfo : ILLocal = { IsPinned=false Type=ty DebugInfo=dbgInfo } type ILFieldSpec with - member fr.ActualType = + member fr.ActualType = let env = fr.DeclaringType.GenericArgs instILType env fr.FormalType -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Make a method mbody -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let mkILMethodBody (zeroinit, locals, maxstack, code, tag) : ILMethodBody = +let mkILMethodBody (zeroinit, locals, maxstack, code, tag) : ILMethodBody = { IsZeroInit=zeroinit MaxStack=maxstack NoInlining=false AggressiveInlining=false - Locals= locals + Locals= locals Code= code SourceMarker=tag } let mkMethodBody (zeroinit, locals, maxstack, code, tag) = MethodBody.IL (mkILMethodBody (zeroinit, locals, maxstack, code, tag)) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Make a constructor -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let mkILVoidReturn = mkILReturn ILType.Void @@ -2911,7 +2914,7 @@ let methBodyAbstract = mkMethBodyAux MethodBody.Abstract let methBodyNative = mkMethBodyAux MethodBody.Native -let mkILCtor (access, args, impl) = +let mkILCtor (access, args, impl) = ILMethodDef(name=".ctor", attributes=(convertMemberAccess access ||| MethodAttributes.SpecialName ||| MethodAttributes.RTSpecialName), implAttributes=MethodImplAttributes.Managed, @@ -2924,9 +2927,9 @@ let mkILCtor (access, args, impl) = genericParams=mkILEmptyGenericParams, customAttrs = emptyILCustomAttrs) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Do-nothing ctor, just pass on to monomorphic superclass -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let mkCallBaseConstructor (ty, args: ILType list) = [ mkLdarg0 ] @ @@ -2943,20 +2946,20 @@ let mkNormalLdfld fspec = I_ldfld (Aligned, Nonvolatile, fspec) let mkNormalLdflda fspec = I_ldflda fspec -let mkNormalLdobj dt = I_ldobj(Aligned, Nonvolatile, dt) +let mkNormalLdobj dt = I_ldobj (Aligned, Nonvolatile, dt) -let mkNormalStobj dt = I_stobj(Aligned, Nonvolatile, dt) +let mkNormalStobj dt = I_stobj (Aligned, Nonvolatile, dt) -let mkILNonGenericEmptyCtor tag superTy = +let mkILNonGenericEmptyCtor tag superTy = let ctor = mkCallBaseConstructor (superTy, []) - mkILCtor(ILMemberAccess.Public, [], mkMethodBody(false, [], 8, nonBranchingInstrsToCode ctor, tag)) + mkILCtor (ILMemberAccess.Public, [], mkMethodBody (false, [], 8, nonBranchingInstrsToCode ctor, tag)) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Make a static, top level monomophic method - very useful for // creating helper ILMethodDefs for internal use. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let mkILStaticMethod (genparams, nm, access, args, ret, impl) = +let mkILStaticMethod (genparams, nm, access, args, ret, impl) = ILMethodDef(genericParams=genparams, name=nm, attributes=(convertMemberAccess access ||| MethodAttributes.Static), @@ -2969,10 +2972,10 @@ let mkILStaticMethod (genparams, nm, access, args, ret, impl) = customAttrs = emptyILCustomAttrs, body= mkMethBodyAux impl) -let mkILNonGenericStaticMethod (nm, access, args, ret, impl) = +let mkILNonGenericStaticMethod (nm, access, args, ret, impl) = mkILStaticMethod (mkILEmptyGenericParams, nm, access, args, ret, impl) -let mkILClassCtor impl = +let mkILClassCtor impl = ILMethodDef(name=".cctor", attributes=(MethodAttributes.Private ||| MethodAttributes.Static ||| MethodAttributes.SpecialName ||| MethodAttributes.RTSpecialName), implAttributes=MethodImplAttributes.Managed, @@ -2985,19 +2988,19 @@ let mkILClassCtor impl = customAttrs=emptyILCustomAttrs, body= mkMethBodyAux impl) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Make a virtual method, where the overriding is simply the default // (i.e. overrides by name/signature) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let mk_ospec (ty: ILType, callconv, nm, genparams, formal_args, formal_ret) = OverridesSpec (mkILMethRef (ty.TypeRef, callconv, nm, genparams, formal_args, formal_ret), ty) -let mkILGenericVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = +let mkILGenericVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = ILMethodDef(name=nm, - attributes= + attributes= (convertMemberAccess access ||| - MethodAttributes.CheckAccessOnOverride ||| + MethodAttributes.CheckAccessOnOverride ||| (match impl with MethodBody.Abstract -> MethodAttributes.Abstract ||| MethodAttributes.Virtual | _ -> MethodAttributes.Virtual)), implAttributes=MethodImplAttributes.Managed, genericParams=genparams, @@ -3008,11 +3011,11 @@ let mkILGenericVirtualMethod (nm, access, genparams, actual_args, actual_ret, im securityDecls=emptyILSecurityDecls, customAttrs = emptyILCustomAttrs, body= mkMethBodyAux impl) - -let mkILNonGenericVirtualMethod (nm, access, args, ret, impl) = + +let mkILNonGenericVirtualMethod (nm, access, args, ret, impl) = mkILGenericVirtualMethod (nm, access, mkILEmptyGenericParams, args, ret, impl) -let mkILGenericNonVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = +let mkILGenericNonVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = ILMethodDef(name=nm, attributes=(convertMemberAccess access ||| MethodAttributes.HideBySig), implAttributes=MethodImplAttributes.Managed, @@ -3024,67 +3027,67 @@ let mkILGenericNonVirtualMethod (nm, access, genparams, actual_args, actual_ret, securityDecls=emptyILSecurityDecls, customAttrs = emptyILCustomAttrs, body= mkMethBodyAux impl) - -let mkILNonGenericInstanceMethod (nm, access, args, ret, impl) = + +let mkILNonGenericInstanceMethod (nm, access, args, ret, impl) = mkILGenericNonVirtualMethod (nm, access, mkILEmptyGenericParams, args, ret, impl) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Add some code to the end of the .cctor for a type. Create a .cctor // if one doesn't exist already. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- let ilmbody_code2code f (il: ILMethodBody) = {il with Code = f il.Code} let mdef_code2code f (md: ILMethodDef) = - let il = - match md.Body.Contents with - | MethodBody.IL il-> il + let il = + match md.Body.Contents with + | MethodBody.IL il-> il | _ -> failwith "mdef_code2code - method not IL" let b = MethodBody.IL (ilmbody_code2code f il) - md.With(body= mkMethBodyAux b) + md.With(body = mkMethBodyAux b) -let prependInstrsToCode (instrs: ILInstr list) (c2: ILCode) = +let prependInstrsToCode (instrs: ILInstr list) (c2: ILCode) = let instrs = Array.ofList instrs let n = instrs.Length - match c2.Instrs.[0] with + match c2.Instrs.[0] with // If there is a sequence point as the first instruction then keep it at the front | I_seqpoint _ as i0 -> - let labels = + let labels = let dict = Dictionary.newWithSize c2.Labels.Count - for kvp in c2.Labels do dict.Add(kvp.Key, if kvp.Value = 0 then 0 else kvp.Value + n) + for kvp in c2.Labels do dict.Add (kvp.Key, if kvp.Value = 0 then 0 else kvp.Value + n) dict { c2 with Labels = labels Instrs = Array.concat [| [|i0|] ; instrs ; c2.Instrs.[1..] |] } | _ -> let labels = let dict = Dictionary.newWithSize c2.Labels.Count - for kvp in c2.Labels do dict.Add(kvp.Key, kvp.Value + n) + for kvp in c2.Labels do dict.Add (kvp.Key, kvp.Value + n) dict { c2 with Labels = labels Instrs = Array.append instrs c2.Instrs } -let prependInstrsToMethod new_code md = +let prependInstrsToMethod new_code md = mdef_code2code (prependInstrsToCode new_code) md -// Creates cctor if needed -let cdef_cctorCode2CodeOrCreate tag f (cd: ILTypeDef) = +// Creates cctor if needed +let cdef_cctorCode2CodeOrCreate tag f (cd: ILTypeDef) = let mdefs = cd.Methods - let cctor = - match mdefs.FindByName ".cctor" with + let cctor = + match mdefs.FindByName ".cctor" with | [mdef] -> mdef | [] -> mkILClassCtor (mkMethodBody (false, [], 1, nonBranchingInstrsToCode [ ], tag)) | _ -> failwith "bad method table: more than one .cctor found" - + let methods = ILMethodDefs (fun () -> [| yield f cctor; for md in mdefs do if md.Name <> ".cctor" then yield md |]) cd.With(methods = methods) -let code_of_mdef (md: ILMethodDef) = - match md.Code with +let code_of_mdef (md: ILMethodDef) = + match md.Code with | Some x -> x - | None -> failwith "code_of_mdef: not IL" + | None -> failwith "code_of_mdef: not IL" let mkRefToILMethod (tref, md: ILMethodDef) = mkILMethRef (tref, md.CallingConv, md.Name, md.GenericParams.Length, md.ParameterTypes, md.Return.Type) @@ -3095,16 +3098,16 @@ let mkRefForILMethod scope (tdefs, tdef) mdef = mkRefToILMethod (mkRefForNestedI let mkRefForILField scope (tdefs, tdef) (fdef: ILFieldDef) = mkILFieldRef (mkRefForNestedILTypeDef scope (tdefs, tdef), fdef.Name, fdef.FieldType) -// Creates cctor if needed -let prependInstrsToClassCtor instrs tag cd = - cdef_cctorCode2CodeOrCreate tag (prependInstrsToMethod instrs) cd +// Creates cctor if needed +let prependInstrsToClassCtor instrs tag cd = + cdef_cctorCode2CodeOrCreate tag (prependInstrsToMethod instrs) cd let mkILField (isStatic, nm, ty, (init: ILFieldInit option), (at: byte [] option), access, isLiteral) = ILFieldDef(name=nm, fieldType=ty, attributes= (convertFieldAccess access ||| - (if isStatic then FieldAttributes.Static else enum 0) ||| + (if isStatic then FieldAttributes.Static else enum 0) ||| (if isLiteral then FieldAttributes.Literal else enum 0) ||| (if init.IsSome then FieldAttributes.HasDefault else enum 0) ||| (if at.IsSome then FieldAttributes.HasFieldRVA else enum 0)), @@ -3120,33 +3123,32 @@ let mkILStaticField (nm, ty, init, at, access) = mkILField (true, nm, ty, init, let mkILLiteralField (nm, ty, init, at, access) = mkILField (true, nm, ty, Some init, at, access, true) -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Scopes for allocating new temporary variables. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -type ILLocalsAllocator(numPrealloc: int) = +type ILLocalsAllocator (numPrealloc: int) = let newLocals = ResizeArray() - member tmps.AllocLocal loc = - let locn = uint16(numPrealloc + newLocals.Count) + member tmps.AllocLocal loc = + let locn = uint16 (numPrealloc + newLocals.Count) newLocals.Add loc locn member tmps.Close() = ResizeArray.toList newLocals - -let mkILFieldsLazy l = ILFields (LazyOrderedMultiMap((fun (f: ILFieldDef) -> f.Name), l)) +let mkILFieldsLazy l = ILFields (LazyOrderedMultiMap ((fun (f: ILFieldDef) -> f.Name), l)) let mkILFields l = mkILFieldsLazy (notlazy l) let emptyILFields = mkILFields [] -let mkILEventsLazy l = ILEvents (LazyOrderedMultiMap((fun (e: ILEventDef) -> e.Name), l)) +let mkILEventsLazy l = ILEvents (LazyOrderedMultiMap ((fun (e: ILEventDef) -> e.Name), l)) let mkILEvents l = mkILEventsLazy (notlazy l) let emptyILEvents = mkILEvents [] -let mkILPropertiesLazy l = ILProperties (LazyOrderedMultiMap((fun (p: ILPropertyDef) -> p.Name), l) ) +let mkILPropertiesLazy l = ILProperties (LazyOrderedMultiMap ((fun (p: ILPropertyDef) -> p.Name), l) ) let mkILProperties l = mkILPropertiesLazy (notlazy l) @@ -3169,10 +3171,10 @@ let mkTypeForwarder scopeRef name nested customAttrs access = CustomAttrsStored=storeILCustomAttrs customAttrs MetadataIndex = NoMetadataIdx } -let mkILNestedExportedTypes l = +let mkILNestedExportedTypes l = ILNestedExportedTypes (notlazy (List.foldBack addNestedExportedTypeToTable l Map.empty)) -let mkILNestedExportedTypesLazy (l: Lazy<_>) = +let mkILNestedExportedTypesLazy (l: Lazy<_>) = ILNestedExportedTypes (lazy (List.foldBack addNestedExportedTypeToTable (l.Force()) Map.empty)) let mkILResources l = ILResources l @@ -3190,42 +3192,42 @@ let emptyILMethodImpls = mkILMethodImpls [] /// Make a constructor that simply takes its arguments and stuffs /// them in fields. preblock is how to call the superclass constructor.... -let mkILStorageCtorWithParamNames(tag, preblock, ty, extraParams, flds, access) = +let mkILStorageCtorWithParamNames (tag, preblock, ty, extraParams, flds, access) = mkILCtor(access, (flds |> List.map (fun (pnm, _, ty) -> mkILParamNamed (pnm, ty))) @ extraParams, mkMethodBody (false, [], 2, nonBranchingInstrsToCode - begin - (match tag with Some x -> [I_seqpoint x] | None -> []) @ + begin + (match tag with Some x -> [I_seqpoint x] | None -> []) @ preblock @ - List.concat (List.mapi (fun n (_pnm, nm, fieldTy) -> + List.concat (List.mapi (fun n (_pnm, nm, fieldTy) -> [ mkLdarg0 mkLdarg (uint16 (n+1)) mkNormalStfld (mkILFieldSpecInTy (ty, nm, fieldTy)) ]) flds) end, tag)) - -let mkILSimpleStorageCtorWithParamNames(tag, baseTySpec, ty, extraParams, flds, access) = - let preblock = - match baseTySpec with + +let mkILSimpleStorageCtorWithParamNames (tag, baseTySpec, ty, extraParams, flds, access) = + let preblock = + match baseTySpec with None -> [] - | Some tspec -> - ([ mkLdarg0 + | Some tspec -> + ([ mkLdarg0 mkNormalCall (mkILCtorMethSpecForTy (mkILBoxedType tspec, [])) ]) - mkILStorageCtorWithParamNames(tag, preblock, ty, extraParams, flds, access) + mkILStorageCtorWithParamNames (tag, preblock, ty, extraParams, flds, access) -let addParamNames flds = +let addParamNames flds = flds |> List.map (fun (nm, ty) -> (nm, nm, ty)) -let mkILSimpleStorageCtor(tag, baseTySpec, ty, extraParams, flds, access) = - mkILSimpleStorageCtorWithParamNames(tag, baseTySpec, ty, extraParams, addParamNames flds, access) +let mkILSimpleStorageCtor (tag, baseTySpec, ty, extraParams, flds, access) = + mkILSimpleStorageCtorWithParamNames (tag, baseTySpec, ty, extraParams, addParamNames flds, access) -let mkILStorageCtor(tag, preblock, ty, flds, access) = mkILStorageCtorWithParamNames(tag, preblock, ty, [], addParamNames flds, access) +let mkILStorageCtor (tag, preblock, ty, flds, access) = mkILStorageCtorWithParamNames (tag, preblock, ty, [], addParamNames flds, access) let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nestedTypes, props, events, attrs, init) = ILTypeDef(name=nm, - attributes=(convertTypeAccessFlags access ||| TypeAttributes.AutoLayout ||| TypeAttributes.Class ||| + attributes=(convertTypeAccessFlags access ||| TypeAttributes.AutoLayout ||| TypeAttributes.Class ||| (match init with | ILTypeInit.BeforeField -> TypeAttributes.BeforeFieldInit | _ -> enum 0) ||| TypeAttributes.AnsiClass), genericParams= genparams, implements = impl, @@ -3239,11 +3241,11 @@ let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nes properties=props, events=events, securityDecls=emptyILSecurityDecls) - + let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm, size, pack) = ILTypeDef(name = nm, genericParams= [], - attributes = (TypeAttributes.NotPublic ||| TypeAttributes.Sealed ||| TypeAttributes.ExplicitLayout ||| + attributes = (TypeAttributes.NotPublic ||| TypeAttributes.Sealed ||| TypeAttributes.ExplicitLayout ||| TypeAttributes.BeforeFieldInit ||| TypeAttributes.AnsiClass), implements = [], extends = Some iltyp_ValueType, @@ -3261,19 +3263,19 @@ let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm, size, pack) = let mkILSimpleClass (ilg: ILGlobals) (nm, access, methods, fields, nestedTypes, props, events, attrs, init) = mkILGenericClass (nm, access, mkILEmptyGenericParams, ilg.typ_Object, [], methods, fields, nestedTypes, props, events, attrs, init) -let mkILTypeDefForGlobalFunctions ilg (methods, fields) = +let mkILTypeDefForGlobalFunctions ilg (methods, fields) = mkILSimpleClass ilg (typeNameForGlobalFunctions, ILTypeDefAccess.Public, methods, fields, emptyILTypeDefs, emptyILProperties, emptyILEvents, emptyILCustomAttrs, ILTypeInit.BeforeField) -let destTypeDefsWithGlobalFunctionsFirst ilg (tdefs: ILTypeDefs) = +let destTypeDefsWithGlobalFunctionsFirst ilg (tdefs: ILTypeDefs) = let l = tdefs.AsList let top, nontop = l |> List.partition (fun td -> td.Name = typeNameForGlobalFunctions) let top2 = if isNil top then [ mkILTypeDefForGlobalFunctions ilg (emptyILMethods, emptyILFields) ] else top top2@nontop -let mkILSimpleModule assemblyName modname dll subsystemVersion useHighEntropyVA tdefs hashalg locale flags exportedTypes metadataVersion = - let manifest = +let mkILSimpleModule assemblyName modname dll subsystemVersion useHighEntropyVA tdefs hashalg locale flags exportedTypes metadataVersion = + let manifest = { Name=assemblyName - AuxModuleHashAlgorithm= match hashalg with | Some(alg) -> alg | _ -> 0x8004 // SHA1 + AuxModuleHashAlgorithm= match hashalg with | Some alg -> alg | _ -> 0x8004 // SHA1 SecurityDeclsStored=emptyILSecurityDeclsStored PublicKey= None Version= None @@ -3285,7 +3287,7 @@ let mkILSimpleModule assemblyName modname dll subsystemVersion useHighEntropyVA IgnoreSymbolStoreSequencePoints = (0 <> (flags &&& 0x2000)) Retargetable = (0 <> (flags &&& 0x100)) ExportedTypes=exportedTypes - EntrypointElsewhere=None + EntrypointElsewhere=None MetadataIndex = NoMetadataIdx } { Manifest= Some manifest CustomAttrsStored=storeILCustomAttrs emptyILCustomAttrs @@ -3307,21 +3309,21 @@ let mkILSimpleModule assemblyName modname dll subsystemVersion useHighEntropyVA ImageBase=defaultImageBase MetadataVersion=metadataVersion Resources=mkILResources [] - MetadataIndex = NoMetadataIdx + MetadataIndex = NoMetadataIdx } //----------------------------------------------------------------------- // [instructions_to_code] makes the basic block structure of code from // a primitive array of instructions. We -// do this be iterating over the instructions, pushing new basic blocks +// do this be iterating over the instructions, pushing new basic blocks // everytime we encounter an address that has been recorded // [bbstartToCodeLabelMap]. //----------------------------------------------------------------------- - + // REVIEW: this function shows up on performance traces. If we eliminated the last ILX->IL rewrites from the -// F# compiler we could get rid of this structured code representation from Abstract IL altogether and +// F# compiler we could get rid of this structured code representation from Abstract IL altogether and // never convert F# code into this form. let buildILCode (_methName: string) lab2pc instrs tryspecs localspecs : ILCode = { Labels = lab2pc @@ -3330,39 +3332,39 @@ let buildILCode (_methName: string) lab2pc instrs tryspecs localspecs : ILCode = Locals = localspecs } -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Detecting Delegates -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -let mkILDelegateMethods (access) (ilg: ILGlobals) (iltyp_AsyncCallback, iltyp_IAsyncResult) (parms, rtv: ILReturn) = +let mkILDelegateMethods (access) (ilg: ILGlobals) (iltyp_AsyncCallback, iltyp_IAsyncResult) (parms, rtv: ILReturn) = let rty = rtv.Type let one nm args ret = let mdef = mkILNonGenericVirtualMethod (nm, access, args, mkILReturn ret, MethodBody.Abstract) mdef.WithAbstract(false).WithHideBySig(true).WithRuntime(true) - let ctor = mkILCtor(access, [ mkILParamNamed("object", ilg.typ_Object); mkILParamNamed("method", ilg.typ_IntPtr) ], MethodBody.Abstract) + let ctor = mkILCtor (access, [ mkILParamNamed("object", ilg.typ_Object); mkILParamNamed("method", ilg.typ_IntPtr) ], MethodBody.Abstract) let ctor = ctor.WithRuntime(true).WithHideBySig(true) [ ctor one "Invoke" parms rty - one "BeginInvoke" (parms @ [mkILParamNamed("callback", iltyp_AsyncCallback); mkILParamNamed("objects", ilg.typ_Object) ] ) iltyp_IAsyncResult - one "EndInvoke" [mkILParamNamed("result", iltyp_IAsyncResult)] rty ] - + one "BeginInvoke" (parms @ [mkILParamNamed ("callback", iltyp_AsyncCallback); mkILParamNamed ("objects", ilg.typ_Object) ] ) iltyp_IAsyncResult + one "EndInvoke" [mkILParamNamed ("result", iltyp_IAsyncResult)] rty ] + let mkCtorMethSpecForDelegate (ilg: ILGlobals) (ty: ILType, useUIntPtr) = - let scoref = ty.TypeRef.Scope + let scoref = ty.TypeRef.Scope mkILInstanceMethSpecInTy (ty, ".ctor", [rescopeILType scoref ilg.typ_Object - rescopeILType scoref (if useUIntPtr then ilg.typ_UIntPtr else ilg.typ_IntPtr)], + rescopeILType scoref (if useUIntPtr then ilg.typ_UIntPtr else ilg.typ_IntPtr)], ILType.Void, emptyILGenericArgsList) type ILEnumInfo = - { enumValues: (string * ILFieldInit) list + { enumValues: (string * ILFieldInit) list enumType: ILType } let getTyOfILEnumInfo info = info.enumType -let computeILEnumInfo (mdName, mdFields: ILFieldDefs) = - match (List.partition (fun (fd: ILFieldDef) -> fd.IsStatic) mdFields.AsList) with - | staticFields, [vfd] -> - { enumType = vfd.FieldType +let computeILEnumInfo (mdName, mdFields: ILFieldDefs) = + match (List.partition (fun (fd: ILFieldDef) -> fd.IsStatic) mdFields.AsList) with + | staticFields, [vfd] -> + { enumType = vfd.FieldType enumValues = staticFields |> List.map (fun fd -> (fd.Name, match fd.LiteralValue with Some i -> i | None -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": static field does not have an default value"))) } | _, [] -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": no non-static field found") | _, _ -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": more than one non-static field found") @@ -3372,42 +3374,42 @@ let computeILEnumInfo (mdName, mdFields: ILFieldDefs) = // pass around an int index //--------------------------------------------------------------------- -let sigptr_get_byte bytes sigptr = +let sigptr_get_byte bytes sigptr = Bytes.get bytes sigptr, sigptr + 1 -let sigptr_get_bool bytes sigptr = +let sigptr_get_bool bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr (b0 = 0x01), sigptr -let sigptr_get_u8 bytes sigptr = +let sigptr_get_u8 bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr byte b0, sigptr -let sigptr_get_i8 bytes sigptr = +let sigptr_get_i8 bytes sigptr = let i, sigptr = sigptr_get_u8 bytes sigptr sbyte i, sigptr -let sigptr_get_u16 bytes sigptr = +let sigptr_get_u16 bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr let b1, sigptr = sigptr_get_byte bytes sigptr uint16 (b0 ||| (b1 <<< 8)), sigptr -let sigptr_get_i16 bytes sigptr = +let sigptr_get_i16 bytes sigptr = let u, sigptr = sigptr_get_u16 bytes sigptr int16 u, sigptr -let sigptr_get_i32 bytes sigptr = +let sigptr_get_i32 bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr let b1, sigptr = sigptr_get_byte bytes sigptr let b2, sigptr = sigptr_get_byte bytes sigptr let b3, sigptr = sigptr_get_byte bytes sigptr b0 ||| (b1 <<< 8) ||| (b2 <<< 16) ||| (b3 <<< 24), sigptr -let sigptr_get_u32 bytes sigptr = +let sigptr_get_u32 bytes sigptr = let u, sigptr = sigptr_get_i32 bytes sigptr uint32 u, sigptr -let sigptr_get_i64 bytes sigptr = +let sigptr_get_i64 bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr let b1, sigptr = sigptr_get_byte bytes sigptr let b2, sigptr = sigptr_get_byte bytes sigptr @@ -3420,80 +3422,80 @@ let sigptr_get_i64 bytes sigptr = (int64 b4 <<< 32) ||| (int64 b5 <<< 40) ||| (int64 b6 <<< 48) ||| (int64 b7 <<< 56), sigptr -let sigptr_get_u64 bytes sigptr = +let sigptr_get_u64 bytes sigptr = let u, sigptr = sigptr_get_i64 bytes sigptr uint64 u, sigptr -let float32_of_bits (x: int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) +let float32_of_bits (x: int32) = BitConverter.ToSingle (BitConverter.GetBytes x, 0) -let float_of_bits (x: int64) = System.BitConverter.Int64BitsToDouble(x) +let float_of_bits (x: int64) = BitConverter.Int64BitsToDouble x -let sigptr_get_ieee32 bytes sigptr = +let sigptr_get_ieee32 bytes sigptr = let u, sigptr = sigptr_get_i32 bytes sigptr float32_of_bits u, sigptr -let sigptr_get_ieee64 bytes sigptr = +let sigptr_get_ieee64 bytes sigptr = let u, sigptr = sigptr_get_i64 bytes sigptr float_of_bits u, sigptr -let sigptr_get_intarray n (bytes: byte[]) sigptr = +let sigptr_get_intarray n (bytes: byte[]) sigptr = let res = Bytes.zeroCreate n - for i = 0 to n - 1 do + for i = 0 to n - 1 do res.[i] <- bytes.[sigptr + i] res, sigptr + n -let sigptr_get_string n bytes sigptr = +let sigptr_get_string n bytes sigptr = let intarray, sigptr = sigptr_get_intarray n bytes sigptr - System.Text.Encoding.UTF8.GetString(intarray, 0, intarray.Length), sigptr - -let sigptr_get_z_i32 bytes sigptr = + Encoding.UTF8.GetString (intarray, 0, intarray.Length), sigptr + +let sigptr_get_z_i32 bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr if b0 <= 0x7F then b0, sigptr - elif b0 <= 0xbf then + elif b0 <= 0xbf then let b0 = b0 &&& 0x7f let b1, sigptr = sigptr_get_byte bytes sigptr (b0 <<< 8) ||| b1, sigptr - else + else let b0 = b0 &&& 0x3f let b1, sigptr = sigptr_get_byte bytes sigptr let b2, sigptr = sigptr_get_byte bytes sigptr let b3, sigptr = sigptr_get_byte bytes sigptr (b0 <<< 24) ||| (b1 <<< 16) ||| (b2 <<< 8) ||| b3, sigptr -let sigptr_get_serstring bytes sigptr = - let len, sigptr = sigptr_get_z_i32 bytes sigptr - sigptr_get_string ( len) bytes sigptr - -let sigptr_get_serstring_possibly_null bytes sigptr = - let b0, new_sigptr = sigptr_get_byte bytes sigptr +let sigptr_get_serstring bytes sigptr = + let len, sigptr = sigptr_get_z_i32 bytes sigptr + sigptr_get_string ( len) bytes sigptr + +let sigptr_get_serstring_possibly_null bytes sigptr = + let b0, new_sigptr = sigptr_get_byte bytes sigptr if b0 = 0xFF then // null case None, new_sigptr else // throw away new_sigptr, getting length & text advance - let len, sigptr = sigptr_get_z_i32 bytes sigptr + let len, sigptr = sigptr_get_z_i32 bytes sigptr let s, sigptr = sigptr_get_string len bytes sigptr - Some(s), sigptr - + Some s, sigptr + //--------------------------------------------------------------------- // Get the public key token from the public key. //--------------------------------------------------------------------- -let mkRefToILAssembly (m: ILAssemblyManifest) = - ILAssemblyRef.Create(m.Name, None, (match m.PublicKey with Some k -> Some (PublicKey.KeyAsToken(k)) | None -> None), m.Retargetable, m.Version, m.Locale) +let mkRefToILAssembly (m: ILAssemblyManifest) = + ILAssemblyRef.Create (m.Name, None, (match m.PublicKey with Some k -> Some (PublicKey.KeyAsToken k) | None -> None), m.Retargetable, m.Version, m.Locale) -let z_unsigned_int_size n = +let z_unsigned_int_size n = if n <= 0x7F then 1 elif n <= 0x3FFF then 2 else 3 -let z_unsigned_int n = - if n >= 0 && n <= 0x7F then [| byte n |] - elif n >= 0x80 && n <= 0x3FFF then [| byte (0x80 ||| (n >>>& 8)); byte (n &&& 0xFF) |] +let z_unsigned_int n = + if n >= 0 && n <= 0x7F then [| byte n |] + elif n >= 0x80 && n <= 0x3FFF then [| byte (0x80 ||| (n >>>& 8)); byte (n &&& 0xFF) |] else [| byte (0xc0 ||| (n >>>& 24)) - byte ((n >>>& 16) &&& 0xFF) - byte ((n >>>& 8) &&& 0xFF) + byte ((n >>>& 16) &&& 0xFF) + byte ((n >>>& 8) &&& 0xFF) byte (n &&& 0xFF) |] -let string_as_utf8_bytes (s: string) = System.Text.Encoding.UTF8.GetBytes s +let string_as_utf8_bytes (s: string) = Encoding.UTF8.GetBytes s (* Little-endian encoding of int64 *) let dw7 n = byte ((n >>> 56) &&& 0xFFL) @@ -3528,9 +3530,9 @@ let u32AsBytes (i: uint32) = i32AsBytes (int32 i) let u64AsBytes (i: uint64) = i64AsBytes (int64 i) -let bits_of_float32 (x: float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x), 0) +let bits_of_float32 (x: float32) = BitConverter.ToInt32 (BitConverter.GetBytes x, 0) -let bits_of_float (x: float) = System.BitConverter.DoubleToInt64Bits(x) +let bits_of_float (x: float) = BitConverter.DoubleToInt64Bits x let ieee32AsBytes i = i32AsBytes (bits_of_float32 i) @@ -3570,11 +3572,11 @@ let et_CMOD_OPT = 0x20uy let formatILVersion (version: ILVersionInfo) = sprintf "%d.%d.%d.%d" (int version.Major) (int version.Minor) (int version.Build) (int version.Revision) -let encodeCustomAttrString s = +let encodeCustomAttrString s = let arr = string_as_utf8_bytes s - Array.concat [ z_unsigned_int arr.Length; arr ] + Array.concat [ z_unsigned_int arr.Length; arr ] -let rec encodeCustomAttrElemType x = +let rec encodeCustomAttrElemType x = match x with | ILType.Value tspec when tspec.Name = tname_SByte -> [| et_I1 |] | ILType.Value tspec when tspec.Name = tname_Byte -> [| et_U1 |] @@ -3589,15 +3591,15 @@ let rec encodeCustomAttrElemType x = | ILType.Value tspec when tspec.Name = tname_Char -> [| et_CHAR |] | ILType.Value tspec when tspec.Name = tname_Bool -> [| et_BOOLEAN |] | ILType.Boxed tspec when tspec.Name = tname_String -> [| et_STRING |] - | ILType.Boxed tspec when tspec.Name = tname_Object -> [| 0x51uy |] + | ILType.Boxed tspec when tspec.Name = tname_Object -> [| 0x51uy |] | ILType.Boxed tspec when tspec.Name = tname_Type -> [| 0x50uy |] | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedName) - | ILType.Array (shape, elemType) when shape = ILArrayShape.SingleDimensional -> + | ILType.Array (shape, elemType) when shape = ILArrayShape.SingleDimensional -> Array.append [| et_SZARRAY |] (encodeCustomAttrElemType elemType) | _ -> failwith "encodeCustomAttrElemType: unrecognized custom element type" /// Given a custom attribute element, work out the type of the .NET argument for that element. -let rec encodeCustomAttrElemTypeForObject x = +let rec encodeCustomAttrElemTypeForObject x = match x with | ILAttribElem.String _ -> [| et_STRING |] | ILAttribElem.Bool _ -> [| et_BOOLEAN |] @@ -3617,7 +3619,7 @@ let rec encodeCustomAttrElemTypeForObject x = | ILAttribElem.Double _ -> [| et_R8 |] | ILAttribElem.Array (elemTy, _) -> [| yield et_SZARRAY; yield! encodeCustomAttrElemType elemTy |] -let rec decodeCustomAttrElemType (ilg: ILGlobals) bytes sigptr x = +let rec decodeCustomAttrElemType (ilg: ILGlobals) bytes sigptr x = match x with | x when x = et_I1 -> ilg.typ_SByte, sigptr | x when x = et_U1 -> ilg.typ_Byte, sigptr @@ -3633,8 +3635,8 @@ let rec decodeCustomAttrElemType (ilg: ILGlobals) bytes sigptr x = | x when x = et_BOOLEAN -> ilg.typ_Bool, sigptr | x when x = et_STRING -> ilg.typ_String, sigptr | x when x = et_OBJECT -> ilg.typ_Object, sigptr - | x when x = et_SZARRAY -> - let et, sigptr = sigptr_get_u8 bytes sigptr + | x when x = et_SZARRAY -> + let et, sigptr = sigptr_get_u8 bytes sigptr let elemTy, sigptr = decodeCustomAttrElemType ilg bytes sigptr et mkILArr1DTy elemTy, sigptr | x when x = 0x50uy -> ilg.typ_Type, sigptr @@ -3642,8 +3644,8 @@ let rec decodeCustomAttrElemType (ilg: ILGlobals) bytes sigptr x = /// Given a custom attribute element, encode it to a binary representation according to the rules in Ecma 335 Partition II. -let rec encodeCustomAttrPrimValue ilg c = - match c with +let rec encodeCustomAttrPrimValue ilg c = + match c with | ILAttribElem.Bool b -> [| (if b then 0x01uy else 0x00uy) |] | ILAttribElem.String None | ILAttribElem.Type None @@ -3663,22 +3665,22 @@ let rec encodeCustomAttrPrimValue ilg c = | ILAttribElem.Double x -> ieee64AsBytes x | ILAttribElem.Type (Some ty) -> encodeCustomAttrString ty.QualifiedName | ILAttribElem.TypeRef (Some tref) -> encodeCustomAttrString tref.QualifiedName - | ILAttribElem.Array (_, elems) -> + | ILAttribElem.Array (_, elems) -> [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrPrimValue ilg elem |] -and encodeCustomAttrValue ilg ty c = - match ty, c with - | ILType.Boxed tspec, _ when tspec.Name = tname_Object -> +and encodeCustomAttrValue ilg ty c = + match ty, c with + | ILType.Boxed tspec, _ when tspec.Name = tname_Object -> [| yield! encodeCustomAttrElemTypeForObject c; yield! encodeCustomAttrPrimValue ilg c |] - | ILType.Array (shape, _), ILAttribElem.Null when shape = ILArrayShape.SingleDimensional -> + | ILType.Array (shape, _), ILAttribElem.Null when shape = ILArrayShape.SingleDimensional -> [| yield! i32AsBytes 0xFFFFFFFF |] - | ILType.Array (shape, elemType), ILAttribElem.Array (_, elems) when shape = ILArrayShape.SingleDimensional -> + | ILType.Array (shape, elemType), ILAttribElem.Array (_, elems) when shape = ILArrayShape.SingleDimensional -> [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrValue ilg elemType elem |] - | _ -> + | _ -> encodeCustomAttrPrimValue ilg c -let encodeCustomAttrNamedArg ilg (nm, ty, prop, elem) = - [| yield (if prop then 0x54uy else 0x53uy) +let encodeCustomAttrNamedArg ilg (nm, ty, prop, elem) = + [| yield (if prop then 0x54uy else 0x53uy) yield! encodeCustomAttrElemType ty yield! encodeCustomAttrString nm yield! encodeCustomAttrValue ilg ty elem |] @@ -3708,7 +3710,7 @@ let getCustomAttrData (ilg: ILGlobals) cattr = | ILAttribute.Decoded (mspec, fixedArgs, namedArgs) -> encodeCustomAttrArgs ilg mspec fixedArgs namedArgs -let MscorlibScopeRef = ILScopeRef.Assembly (ILAssemblyRef.Create("mscorlib", None, Some ecmaPublicKey, true, None, None)) +let MscorlibScopeRef = ILScopeRef.Assembly (ILAssemblyRef.Create ("mscorlib", None, Some ecmaPublicKey, true, None, None)) let EcmaMscorlibILGlobals = mkILGlobals MscorlibScopeRef @@ -3720,23 +3722,23 @@ let EcmaMscorlibILGlobals = mkILGlobals MscorlibScopeRef // as a compressed int to indicate the size followed by an array of UTF8 characters.) // - A set of properties, encoded as the named arguments to a custom attribute would be (as // in §23.3, beginning with NumNamed). -let mkPermissionSet (ilg: ILGlobals) (action, attributes: list<(ILTypeRef * (string * ILType * ILAttribElem) list)>) = - let bytes = +let mkPermissionSet (ilg: ILGlobals) (action, attributes: list<(ILTypeRef * (string * ILType * ILAttribElem) list)>) = + let bytes = [| yield (byte '.') yield! z_unsigned_int attributes.Length - for (tref: ILTypeRef, props) in attributes do + for (tref: ILTypeRef, props) in attributes do yield! encodeCustomAttrString tref.QualifiedName - let bytes = + let bytes = [| yield! z_unsigned_int props.Length - for (nm, ty, value) in props do + for (nm, ty, value) in props do yield! encodeCustomAttrNamedArg ilg (nm, ty, true, value)|] yield! z_unsigned_int bytes.Length yield! bytes |] - - ILSecurityDecl.ILSecurityDecl(action, bytes) + + ILSecurityDecl.ILSecurityDecl (action, bytes) // Parse an IL type signature argument within a custom attribute blob -type ILTypeSigParser(tstring : string) = +type ILTypeSigParser (tstring : string) = let mutable startPos = 0 let mutable currentPos = 0 @@ -3746,7 +3748,7 @@ type ILTypeSigParser(tstring : string) = // take a look at the next value, but don't advance let peek() = if currentPos < (tstring.Length-1) then tstring.[currentPos+1] else nil - let peekN(skip) = if currentPos < (tstring.Length - skip) then tstring.[currentPos+skip] else nil + let peekN skip = if currentPos < (tstring.Length - skip) then tstring.[currentPos+skip] else nil // take a look at the current value, but don't advance let here() = if currentPos < tstring.Length then tstring.[currentPos] else nil // move on to the next character @@ -3756,7 +3758,7 @@ type ILTypeSigParser(tstring : string) = // ignore the current lexeme, advance let drop() = skip() ; step() ; skip() // return the current lexeme, advance - let take() = + let take() = let s = if currentPos < tstring.Length then tstring.[startPos..currentPos] else "" drop() s @@ -3770,7 +3772,7 @@ type ILTypeSigParser(tstring : string) = // dev.virtualearth.net.webservices.v1.search.CategorySpecificPropertySet], // mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" // - // Note that + // Note that // Since we're only reading valid IL, we assume that the signature is properly formed // For type parameters, if the type is non-local, it will be wrapped in brackets ([]) // Still needs testing with jagged arrays and byref parameters @@ -3779,22 +3781,22 @@ 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() - + // 1. Iterate over beginning of type, grabbing the type name and determining if it's generic or an array - let typeName = + let typeName = while (peek() <> '`') && (peek() <> '[') && (peek() <> ']') && (peek() <> ',') && (peek() <> nil) do step() take() - + // 2. Classify the type // Is the type generic? - let typeName, specializations = + let typeName, specializations = if here() = '`' then drop() // step to the number // fetch the arity - let arity = + let arity = while (int(here()) >= (int('0'))) && (int(here()) <= ((int('9')))) && (int(peek()) >= (int('0'))) && (int(peek()) <= ((int('9')))) do step() - System.Int32.Parse(take()) + Int32.Parse(take()) // skip the '[' drop() // get the specializations @@ -3803,7 +3805,7 @@ type ILTypeSigParser(tstring : string) = typeName, None // Is the type an array? - let rank = + let rank = if here() = '[' then let mutable rank = 0 @@ -3817,8 +3819,8 @@ type ILTypeSigParser(tstring : string) = None // Is there a scope? - let scope = - if (here() = ',' || here() = ' ') && (peek() <> '[' && peekN(2) <> '[') then + let scope = + if (here() = ',' || here() = ' ') && (peek() <> '[' && peekN 2 <> '[') then let grabScopeComponent() = if here() = ',' then drop() // ditch the ',' if here() = ' ' then drop() // ditch the ' ' @@ -3832,7 +3834,7 @@ type ILTypeSigParser(tstring : string) = yield grabScopeComponent() // culture yield grabScopeComponent() // public key token ] |> String.concat "," - ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(System.Reflection.AssemblyName(scope))) + ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(AssemblyName scope)) else ILScopeRef.Local @@ -3841,13 +3843,13 @@ type ILTypeSigParser(tstring : string) = if (here() = ',') then drop() // build the IL type - let tref = mkILTyRef(scope, typeName) - let genericArgs = + let tref = mkILTyRef (scope, typeName) + let genericArgs = match specializations with | None -> [] - | Some(genericArgs) -> genericArgs - let tspec = ILTypeSpec.Create(tref, genericArgs) - let ilty = + | Some genericArgs -> genericArgs + let tspec = ILTypeSpec.Create (tref, genericArgs) + let ilty = match tspec.Name with | "System.SByte" | "System.Byte" @@ -3860,20 +3862,20 @@ type ILTypeSigParser(tstring : string) = | "System.Char" | "System.Double" | "System.Single" - | "System.Boolean" -> ILType.Value(tspec) - | _ -> ILType.Boxed(tspec) + | "System.Boolean" -> ILType.Value tspec + | _ -> ILType.Boxed tspec // if it's an array, wrap it - otherwise, just return the IL type match rank with - | Some(r) -> ILType.Array(r, ilty) + | Some r -> ILType.Array (r, ilty) | _ -> ilty - + member x.ParseTypeSpec() = reset() let ilty = x.ParseType() - ILAttribElem.Type(Some(ilty)) + ILAttribElem.Type (Some ilty) -let decodeILAttribData (ilg: ILGlobals) (ca: ILAttribute) = +let decodeILAttribData (ilg: ILGlobals) (ca: ILAttribute) = match ca with | ILAttribute.Decoded (_, fixedArgs, namedArgs) -> fixedArgs, namedArgs | ILAttribute.Encoded (_, bytes, _) -> @@ -3883,133 +3885,133 @@ let decodeILAttribData (ilg: ILGlobals) (ca: ILAttribute) = let bb1, sigptr = sigptr_get_byte bytes sigptr if not (bb0 = 0x01 && bb1 = 0x00) then failwith "decodeILAttribData: invalid data" - let rec parseVal argty sigptr = - match argty with - | ILType.Value tspec when tspec.Name = "System.SByte" -> + let rec parseVal argty sigptr = + match argty with + | ILType.Value tspec when tspec.Name = "System.SByte" -> let n, sigptr = sigptr_get_i8 bytes sigptr ILAttribElem.SByte n, sigptr - | ILType.Value tspec when tspec.Name = "System.Byte" -> + | ILType.Value tspec when tspec.Name = "System.Byte" -> let n, sigptr = sigptr_get_u8 bytes sigptr ILAttribElem.Byte n, sigptr - | ILType.Value tspec when tspec.Name = "System.Int16" -> + | ILType.Value tspec when tspec.Name = "System.Int16" -> let n, sigptr = sigptr_get_i16 bytes sigptr ILAttribElem.Int16 n, sigptr - | ILType.Value tspec when tspec.Name = "System.UInt16" -> + | ILType.Value tspec when tspec.Name = "System.UInt16" -> let n, sigptr = sigptr_get_u16 bytes sigptr ILAttribElem.UInt16 n, sigptr - | ILType.Value tspec when tspec.Name = "System.Int32" -> + | ILType.Value tspec when tspec.Name = "System.Int32" -> let n, sigptr = sigptr_get_i32 bytes sigptr ILAttribElem.Int32 n, sigptr - | ILType.Value tspec when tspec.Name = "System.UInt32" -> + | ILType.Value tspec when tspec.Name = "System.UInt32" -> let n, sigptr = sigptr_get_u32 bytes sigptr ILAttribElem.UInt32 n, sigptr - | ILType.Value tspec when tspec.Name = "System.Int64" -> + | ILType.Value tspec when tspec.Name = "System.Int64" -> let n, sigptr = sigptr_get_i64 bytes sigptr ILAttribElem.Int64 n, sigptr - | ILType.Value tspec when tspec.Name = "System.UInt64" -> + | ILType.Value tspec when tspec.Name = "System.UInt64" -> let n, sigptr = sigptr_get_u64 bytes sigptr ILAttribElem.UInt64 n, sigptr - | ILType.Value tspec when tspec.Name = "System.Double" -> + | ILType.Value tspec when tspec.Name = "System.Double" -> let n, sigptr = sigptr_get_ieee64 bytes sigptr ILAttribElem.Double n, sigptr - | ILType.Value tspec when tspec.Name = "System.Single" -> + | ILType.Value tspec when tspec.Name = "System.Single" -> let n, sigptr = sigptr_get_ieee32 bytes sigptr ILAttribElem.Single n, sigptr - | ILType.Value tspec when tspec.Name = "System.Char" -> + | ILType.Value tspec when tspec.Name = "System.Char" -> let n, sigptr = sigptr_get_u16 bytes sigptr ILAttribElem.Char (char (int32 n)), sigptr - | ILType.Value tspec when tspec.Name = "System.Boolean" -> + | ILType.Value tspec when tspec.Name = "System.Boolean" -> let n, sigptr = sigptr_get_byte bytes sigptr ILAttribElem.Bool (not (n = 0)), sigptr - | ILType.Boxed tspec when tspec.Name = "System.String" -> + | ILType.Boxed tspec when tspec.Name = "System.String" -> let n, sigptr = sigptr_get_serstring_possibly_null bytes sigptr ILAttribElem.String n, sigptr - | ILType.Boxed tspec when tspec.Name = "System.Type" -> + | ILType.Boxed tspec when tspec.Name = "System.Type" -> let nOpt, sigptr = sigptr_get_serstring_possibly_null bytes sigptr match nOpt with - | None -> ILAttribElem.TypeRef(None), sigptr - | Some n -> + | None -> ILAttribElem.TypeRef None, sigptr + | Some n -> try - let parser = ILTypeSigParser(n) + let parser = ILTypeSigParser n parser.ParseTypeSpec(), sigptr with e -> failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" e.Message) - | ILType.Boxed tspec when tspec.Name = "System.Object" -> + | ILType.Boxed tspec when tspec.Name = "System.Object" -> let et, sigptr = sigptr_get_u8 bytes sigptr - if et = 0xFFuy then + if et = 0xFFuy then ILAttribElem.Null, sigptr else - let ty, sigptr = decodeCustomAttrElemType ilg bytes sigptr et - parseVal ty sigptr - | ILType.Array(shape, elemTy) when shape = ILArrayShape.SingleDimensional -> + let ty, sigptr = decodeCustomAttrElemType ilg bytes sigptr et + parseVal ty sigptr + | ILType.Array (shape, elemTy) when shape = ILArrayShape.SingleDimensional -> let n, sigptr = sigptr_get_i32 bytes sigptr if n = 0xFFFFFFFF then ILAttribElem.Null, sigptr else - let rec parseElems acc n sigptr = + let rec parseElems acc n sigptr = if n = 0 then List.rev acc, sigptr else let v, sigptr = parseVal elemTy sigptr parseElems (v ::acc) (n-1) sigptr - let elems, sigptr = parseElems [] n sigptr - ILAttribElem.Array(elemTy, elems), sigptr + let elems, sigptr = parseElems [] n sigptr + ILAttribElem.Array (elemTy, elems), sigptr | ILType.Value _ -> (* assume it is an enumeration *) let n, sigptr = sigptr_get_i32 bytes sigptr ILAttribElem.Int32 n, sigptr | _ -> failwith "decodeILAttribData: attribute data involves an enum or System.Type value" - let rec parseFixed argtys sigptr = - match argtys with + let rec parseFixed argtys sigptr = + match argtys with [] -> [], sigptr - | h::t -> + | h::t -> let nh, sigptr = parseVal h sigptr let nt, sigptr = parseFixed t sigptr nh ::nt, sigptr let fixedArgs, sigptr = parseFixed ca.Method.FormalArgTypes sigptr let nnamed, sigptr = sigptr_get_u16 bytes sigptr - let rec parseNamed acc n sigptr = + let rec parseNamed acc n sigptr = if n = 0 then List.rev acc else let isPropByte, sigptr = sigptr_get_u8 bytes sigptr let isProp = (int isPropByte = 0x54) let et, sigptr = sigptr_get_u8 bytes sigptr - // We have a named value - let ty, sigptr = + // We have a named value + let ty, sigptr = if ( (* 0x50 = (int et) || *) 0x55 = (int et)) then let qualified_tname, sigptr = sigptr_get_serstring bytes sigptr - let unqualified_tname, rest = - let pieces = qualified_tname.Split(',') - if pieces.Length > 1 then + let unqualified_tname, rest = + let pieces = qualified_tname.Split (',') + if pieces.Length > 1 then pieces.[0], Some (String.concat "," pieces.[1..]) - else + else pieces.[0], None - let scoref = - match rest with - | Some aname -> ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(System.Reflection.AssemblyName(aname))) + let scoref = + match rest with + | Some aname -> ILScopeRef.Assembly (ILAssemblyRef.FromAssemblyName (AssemblyName aname)) | None -> ilg.primaryAssemblyScopeRef let tref = mkILTyRef (scoref, unqualified_tname) let tspec = mkILNonGenericTySpec tref - ILType.Value(tspec), sigptr + ILType.Value tspec, sigptr else decodeCustomAttrElemType ilg bytes sigptr et let nm, sigptr = sigptr_get_serstring bytes sigptr let v, sigptr = parseVal ty sigptr parseNamed ((nm, ty, isProp, v) :: acc) (n-1) sigptr let named = parseNamed [] (int nnamed) sigptr - fixedArgs, named + fixedArgs, named -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- // Functions to collect up all the references in a full module or // assembly manifest. The process also allocates // a unique name to each unique internal assembly reference. -// -------------------------------------------------------------------- +// -------------------------------------------------------------------- -type ILReferences = - { AssemblyReferences: ILAssemblyRef list +type ILReferences = + { AssemblyReferences: ILAssemblyRef list ModuleReferences: ILModuleRef list } -type ILReferencesAccumulator = - { refsA: HashSet +type ILReferencesAccumulator = + { refsA: HashSet refsM: HashSet } -let emptyILRefs = +let emptyILRefs = { AssemblyReferences=[] ModuleReferences = [] } @@ -4017,23 +4019,23 @@ let emptyILRefs = let refs_of_assemblyRef (s: ILReferencesAccumulator) x = s.refsA.Add x |> ignore let refs_of_modref (s: ILReferencesAccumulator) x = s.refsM.Add x |> ignore - -let refs_of_scoref s x = - match x with - | ILScopeRef.Local -> () + +let refs_of_scoref s x = + match x with + | ILScopeRef.Local -> () | ILScopeRef.Assembly assemblyRef -> refs_of_assemblyRef s assemblyRef - | ILScopeRef.Module modref -> refs_of_modref s modref + | ILScopeRef.Module modref -> refs_of_modref s modref let refs_of_tref s (x: ILTypeRef) = refs_of_scoref s x.Scope - -let rec refs_of_typ s x = + +let rec refs_of_typ s x = match x with | ILType.Void | ILType.TypeVar _ -> () - | ILType.Modified(_, ty1, ty2) -> refs_of_tref s ty1; refs_of_typ s ty2 + | ILType.Modified (_, ty1, ty2) -> refs_of_tref s ty1; refs_of_typ s ty2 | ILType.Array (_, ty) - | ILType.Ptr ty | ILType.Byref ty -> refs_of_typ s ty + | ILType.Ptr ty | ILType.Byref ty -> refs_of_typ s ty | ILType.Value tr | ILType.Boxed tr -> refs_of_tspec s tr - | ILType.FunctionPointer mref -> refs_of_callsig s mref + | ILType.FunctionPointer mref -> refs_of_callsig s mref and refs_of_inst s i = refs_of_tys s i @@ -4044,19 +4046,19 @@ and refs_of_callsig s csig = refs_of_tys s csig.ArgTypes; refs_of_typ s csig.Ret and refs_of_genparam s x = refs_of_tys s x.Constraints and refs_of_genparams s b = List.iter (refs_of_genparam s) b - + and refs_of_dloc s ts = refs_of_tref s ts - -and refs_of_mref s (x: ILMethodRef) = + +and refs_of_mref s (x: ILMethodRef) = refs_of_dloc s x.DeclaringTypeRef refs_of_tys s x.mrefArgs refs_of_typ s x.mrefReturn - + and refs_of_fref s x = refs_of_tref s x.DeclaringTypeRef; refs_of_typ s x.Type -and refs_of_ospec s (OverridesSpec(mref, ty)) = refs_of_mref s mref; refs_of_typ s ty +and refs_of_ospec s (OverridesSpec (mref, ty)) = refs_of_mref s mref; refs_of_typ s ty -and refs_of_mspec s (x: ILMethodSpec) = +and refs_of_mspec s (x: ILMethodSpec) = refs_of_mref s x.MethodRef refs_of_typ s x.DeclaringType refs_of_inst s x.GenericArgs @@ -4066,117 +4068,117 @@ and refs_of_fspec s x = refs_of_typ s x.DeclaringType and refs_of_tys s l = List.iter (refs_of_typ s) l - -and refs_of_token s x = + +and refs_of_token s x = match x with | ILToken.ILType ty -> refs_of_typ s ty | ILToken.ILMethod mr -> refs_of_mspec s mr | ILToken.ILField fr -> refs_of_fspec s fr and refs_of_custom_attr s (cattr: ILAttribute) = refs_of_mspec s cattr.Method - + and refs_of_custom_attrs s (cas : ILAttributes) = Array.iter (refs_of_custom_attr s) cas.AsArray -and refs_of_varargs s tyso = Option.iter (refs_of_tys s) tyso +and refs_of_varargs s tyso = Option.iter (refs_of_tys s) tyso -and refs_of_instr s x = +and refs_of_instr s x = match x with | I_call (_, mr, varargs) | I_newobj (mr, varargs) | I_callvirt (_, mr, varargs) -> refs_of_mspec s mr refs_of_varargs s varargs - | I_callconstraint (_, tr, mr, varargs) -> + | I_callconstraint (_, tr, mr, varargs) -> refs_of_typ s tr refs_of_mspec s mr refs_of_varargs s varargs - | I_calli (_, callsig, varargs) -> - refs_of_callsig s callsig; refs_of_varargs s varargs - | I_jmp mr | I_ldftn mr | I_ldvirtftn mr -> + | I_calli (_, callsig, varargs) -> + refs_of_callsig s callsig; refs_of_varargs s varargs + | I_jmp mr | I_ldftn mr | I_ldvirtftn mr -> refs_of_mspec s mr - | I_ldsfld (_, fr) | I_ldfld (_, _, fr) | I_ldsflda fr | I_ldflda fr | I_stsfld (_, fr) | I_stfld (_, _, fr) -> + | I_ldsfld (_, fr) | I_ldfld (_, _, fr) | I_ldsflda fr | I_ldflda fr | I_stsfld (_, fr) | I_stfld (_, _, fr) -> refs_of_fspec s fr - | I_isinst ty | I_castclass ty | I_cpobj ty | I_initobj ty | I_ldobj (_, _, ty) + | I_isinst ty | I_castclass ty | I_cpobj ty | I_initobj ty | I_ldobj (_, _, ty) | I_stobj (_, _, ty) | I_box ty |I_unbox ty | I_unbox_any ty | I_sizeof ty | I_ldelem_any (_, ty) | I_ldelema (_, _, _, ty) |I_stelem_any (_, ty) | I_newarr (_, ty) - | I_mkrefany ty | I_refanyval ty - | EI_ilzero ty -> refs_of_typ s ty - | I_ldtoken token -> refs_of_token s token + | I_mkrefany ty | I_refanyval ty + | EI_ilzero ty -> refs_of_typ s ty + | I_ldtoken token -> refs_of_token s token | I_stelem _|I_ldelem _|I_ldstr _|I_switch _|I_stloc _|I_stind _ | I_starg _|I_ldloca _|I_ldloc _|I_ldind _ | I_ldarga _|I_ldarg _|I_leave _|I_br _ - | I_brcmp _|I_rethrow|I_refanytype|I_ldlen|I_throw|I_initblk _ |I_cpblk _ + | I_brcmp _|I_rethrow|I_refanytype|I_ldlen|I_throw|I_initblk _ |I_cpblk _ | I_localloc|I_ret |I_endfilter|I_endfinally|I_arglist | I_break - | AI_add | AI_add_ovf | AI_add_ovf_un | AI_and | AI_div | AI_div_un | AI_ceq | AI_cgt | AI_cgt_un | AI_clt - | AI_clt_un | AI_conv _ | AI_conv_ovf _ | AI_conv_ovf_un _ | AI_mul | AI_mul_ovf | AI_mul_ovf_un | AI_rem | AI_rem_un - | AI_shl | AI_shr | AI_shr_un | AI_sub | AI_sub_ovf | AI_sub_ovf_un | AI_xor | AI_or | AI_neg | AI_not + | AI_add | AI_add_ovf | AI_add_ovf_un | AI_and | AI_div | AI_div_un | AI_ceq | AI_cgt | AI_cgt_un | AI_clt + | AI_clt_un | AI_conv _ | AI_conv_ovf _ | AI_conv_ovf_un _ | AI_mul | AI_mul_ovf | AI_mul_ovf_un | AI_rem | AI_rem_un + | AI_shl | AI_shr | AI_shr_un | AI_sub | AI_sub_ovf | AI_sub_ovf_un | AI_xor | AI_or | AI_neg | AI_not | AI_ldnull | AI_dup | AI_pop | AI_ckfinite | AI_nop | AI_ldc _ | I_seqpoint _ | EI_ldlen_multi _ -> () - -and refs_of_il_code s (c: ILCode) = - c.Instrs |> Array.iter (refs_of_instr s) - c.Exceptions |> List.iter (fun e -> e.Clause |> (function + +and refs_of_il_code s (c: ILCode) = + c.Instrs |> Array.iter (refs_of_instr s) + c.Exceptions |> List.iter (fun e -> e.Clause |> (function | ILExceptionClause.TypeCatch (ilty, _) -> refs_of_typ s ilty | _ -> ())) -and refs_of_ilmbody s (il: ILMethodBody) = +and refs_of_ilmbody s (il: ILMethodBody) = List.iter (refs_of_local s) il.Locals - refs_of_il_code s il.Code - + refs_of_il_code s il.Code + and refs_of_local s loc = refs_of_typ s loc.Type - -and refs_of_mbody s x = - match x with + +and refs_of_mbody s x = + match x with | MethodBody.IL il -> refs_of_ilmbody s il | MethodBody.PInvoke (attr) -> refs_of_modref s attr.Where | _ -> () -and refs_of_mdef s (md: ILMethodDef) = +and refs_of_mdef s (md: ILMethodDef) = List.iter (refs_of_param s) md.Parameters refs_of_return s md.Return refs_of_mbody s md.Body.Contents refs_of_custom_attrs s md.CustomAttrs refs_of_genparams s md.GenericParams - -and refs_of_param s p = refs_of_typ s p.Type + +and refs_of_param s p = refs_of_typ s p.Type and refs_of_return s (rt: ILReturn) = refs_of_typ s rt.Type and refs_of_mdefs s x = Seq.iter (refs_of_mdef s) x - -and refs_of_event_def s (ed: ILEventDef) = + +and refs_of_event_def s (ed: ILEventDef) = Option.iter (refs_of_typ s) ed.EventType refs_of_mref s ed.AddMethod refs_of_mref s ed.RemoveMethod Option.iter (refs_of_mref s) ed.FireMethod List.iter (refs_of_mref s) ed.OtherMethods refs_of_custom_attrs s ed.CustomAttrs - + and refs_of_events s (x: ILEventDefs) = List.iter (refs_of_event_def s) x.AsList - -and refs_of_property_def s (pd: ILPropertyDef) = + +and refs_of_property_def s (pd: ILPropertyDef) = Option.iter (refs_of_mref s) pd.SetMethod Option.iter (refs_of_mref s) pd.GetMethod refs_of_typ s pd.PropertyType refs_of_tys s pd.Args refs_of_custom_attrs s pd.CustomAttrs - + and refs_of_properties s (x: ILPropertyDefs) = List.iter (refs_of_property_def s) x.AsList - -and refs_of_fdef s (fd: ILFieldDef) = + +and refs_of_fdef s (fd: ILFieldDef) = refs_of_typ s fd.FieldType refs_of_custom_attrs s fd.CustomAttrs and refs_of_fields s fields = List.iter (refs_of_fdef s) fields - + and refs_of_method_impls s mimpls = List.iter (refs_of_method_impl s) mimpls - -and refs_of_method_impl s m = + +and refs_of_method_impl s m = refs_of_ospec s m.Overrides refs_of_mspec s m.OverrideBy and refs_of_tdef_kind _s _k = () - -and refs_of_tdef s (td : ILTypeDef) = + +and refs_of_tdef s (td : ILTypeDef) = refs_of_types s td.NestedTypes refs_of_genparams s td.GenericParams refs_of_tys s td.Implements @@ -4192,76 +4194,75 @@ and refs_of_tdef s (td : ILTypeDef) = and refs_of_string _s _ = () and refs_of_types s (types: ILTypeDefs) = Seq.iter (refs_of_tdef s) types - -and refs_of_exported_type s (c: ILExportedTypeOrForwarder) = + +and refs_of_exported_type s (c: ILExportedTypeOrForwarder) = refs_of_custom_attrs s c.CustomAttrs - + and refs_of_exported_types s (tab: ILExportedTypesAndForwarders) = List.iter (refs_of_exported_type s) tab.AsList - -and refs_of_resource_where s x = - match x with + +and refs_of_resource_where s x = + match x with | ILResourceLocation.LocalIn _ -> () | ILResourceLocation.LocalOut _ -> () | ILResourceLocation.File (mref, _) -> refs_of_modref s mref | ILResourceLocation.Assembly aref -> refs_of_assemblyRef s aref -and refs_of_resource s x = +and refs_of_resource s x = refs_of_resource_where s x.Location refs_of_custom_attrs s x.CustomAttrs - + and refs_of_resources s (tab: ILResources) = List.iter (refs_of_resource s) tab.AsList - -and refs_of_modul s m = + +and refs_of_modul s m = refs_of_types s m.TypeDefs refs_of_resources s m.Resources Option.iter (refs_of_manifest s) m.Manifest - -and refs_of_manifest s (m: ILAssemblyManifest) = + +and refs_of_manifest s (m: ILAssemblyManifest) = refs_of_custom_attrs s m.CustomAttrs refs_of_exported_types s m.ExportedTypes -let computeILRefs modul = - let s = - { refsA = HashSet<_>(HashIdentity.Structural) +let computeILRefs modul = + let s = + { refsA = HashSet<_>(HashIdentity.Structural) refsM = HashSet<_>(HashIdentity.Structural) } refs_of_modul s modul { AssemblyReferences = Seq.fold (fun acc x -> x::acc) [] s.refsA ModuleReferences = Seq.fold (fun acc x -> x::acc) [] s.refsM } -let tspan = System.TimeSpan(System.DateTime.UtcNow.Ticks - System.DateTime(2000, 1, 1).Ticks) +let tspan = TimeSpan (DateTime.UtcNow.Ticks - DateTime (2000, 1, 1).Ticks) -let parseILVersion (vstr : string) = +let parseILVersion (vstr : string) = // matches "v1.2.3.4" or "1.2.3.4". Note, if numbers are missing, returns -1 (not 0). - let mutable vstr = vstr.TrimStart [|'v'|] + let mutable vstr = vstr.TrimStart [|'v'|] // if the version string contains wildcards, replace them - let versionComponents = vstr.Split([|'.'|]) - + let versionComponents = vstr.Split ([|'.'|]) + // account for wildcards if versionComponents.Length > 2 then - let defaultBuild = (uint16)tspan.Days % System.UInt16.MaxValue - 1us - let defaultRevision = (uint16)(System.DateTime.UtcNow.TimeOfDay.TotalSeconds / 2.0) % System.UInt16.MaxValue - 1us + let defaultBuild = (uint16)tspan.Days % UInt16.MaxValue - 1us + let defaultRevision = (uint16)(DateTime.UtcNow.TimeOfDay.TotalSeconds / 2.0) % UInt16.MaxValue - 1us if versionComponents.[2] = "*" then if versionComponents.Length > 3 then failwith "Invalid version format" else // set the build number to the number of days since Jan 1, 2000 - versionComponents.[2] <- defaultBuild.ToString() + versionComponents.[2] <- defaultBuild.ToString() // Set the revision number to number of seconds today / 2 - vstr <- System.String.Join(".", versionComponents) + "." + defaultRevision.ToString() + vstr <- String.Join (".", versionComponents) + "." + defaultRevision.ToString() elif versionComponents.Length > 3 && versionComponents.[3] = "*" then // Set the revision number to number of seconds today / 2 - versionComponents.[3] <- defaultRevision.ToString() - vstr <- System.String.Join(".", versionComponents) - - let version = System.Version(vstr) - let zero32 n = if n < 0 then 0us else uint16(n) - // since the minor revision will be -1 if none is specified, we need to truncate to 0 to not break existing code - let minorRevision = if version.Revision = -1 then 0us else uint16(version.MinorRevision) - ILVersionInfo(zero32 version.Major, zero32 version.Minor, zero32 version.Build, minorRevision) + versionComponents.[3] <- defaultRevision.ToString() + vstr <- String.Join (".", versionComponents) + let version = System.Version vstr + let zero32 n = if n < 0 then 0us else uint16 n + // since the minor revision will be -1 if none is specified, we need to truncate to 0 to not break existing code + let minorRevision = if version.Revision = -1 then 0us else uint16 version.MinorRevision + ILVersionInfo (zero32 version.Major, zero32 version.Minor, zero32 version.Build, minorRevision) -let compareILVersions (version1 : ILVersionInfo) (version2 : ILVersionInfo) = +let compareILVersions (version1 : ILVersionInfo) (version2 : ILVersionInfo) = let c = compare version1.Major version2.Major if c <> 0 then c else let c = compare version1.Minor version2.Minor @@ -4272,33 +4273,33 @@ let compareILVersions (version1 : ILVersionInfo) (version2 : ILVersionInfo) = if c <> 0 then c else 0 -let unscopeILTypeRef (x: ILTypeRef) = ILTypeRef.Create(ILScopeRef.Local, x.Enclosing, x.Name) +let unscopeILTypeRef (x: ILTypeRef) = ILTypeRef.Create (ILScopeRef.Local, x.Enclosing, x.Name) -let rec unscopeILTypeSpec (tspec: ILTypeSpec) = +let rec unscopeILTypeSpec (tspec: ILTypeSpec) = let tref = tspec.TypeRef let tinst = tspec.GenericArgs let tref = unscopeILTypeRef tref ILTypeSpec.Create (tref, unscopeILTypes tinst) -and unscopeILType ty = - match ty with +and unscopeILType ty = + match ty with | ILType.Ptr t -> ILType.Ptr (unscopeILType t) | ILType.FunctionPointer t -> ILType.FunctionPointer (unscopeILCallSig t) | ILType.Byref t -> ILType.Byref (unscopeILType t) | ILType.Boxed cr -> mkILBoxedType (unscopeILTypeSpec cr) | ILType.Array (s, ty) -> ILType.Array (s, unscopeILType ty) | ILType.Value cr -> ILType.Value (unscopeILTypeSpec cr) - | ILType.Modified(b, tref, ty) -> ILType.Modified(b, unscopeILTypeRef tref, unscopeILType ty) + | ILType.Modified (b, tref, ty) -> ILType.Modified (b, unscopeILTypeRef tref, unscopeILType ty) | x -> x -and unscopeILTypes i = +and unscopeILTypes i = if List.isEmpty i then i else List.map unscopeILType i -and unscopeILCallSig csig = +and unscopeILCallSig csig = mkILCallSig (csig.CallingConv, unscopeILTypes csig.ArgTypes, unscopeILType csig.ReturnType) -let resolveILMethodRefWithRescope r (td: ILTypeDef) (mref: ILMethodRef) = +let resolveILMethodRefWithRescope r (td: ILTypeDef) (mref: ILMethodRef) = let args = mref.ArgTypes let nargs = args.Length let nm = mref.Name @@ -4306,27 +4307,27 @@ let resolveILMethodRefWithRescope r (td: ILTypeDef) (mref: ILMethodRef) = if isNil possibles then failwith ("no method named " + nm + " found in type " + td.Name) let argTypes = mref.ArgTypes |> List.map r let retType : ILType = r mref.ReturnType - match - possibles |> List.filter (fun md -> + 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 + // 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 "+nm+" with appropriate argument types found in type "+td.Name) | [mdef] -> mdef | _ -> failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name) - + let resolveILMethodRef td mref = resolveILMethodRefWithRescope id td mref let mkRefToILModule m = - ILModuleRef.Create(m.Name, true, None) + ILModuleRef.Create (m.Name, true, None) type ILEventRef = { erA: ILTypeRef erB: string } - static member Create(a, b) = {erA=a;erB=b} + static member Create (a, b) = {erA=a;erB=b} member x.DeclaringTypeRef = x.erA diff --git a/src/absil/illib.fs b/src/absil/illib.fs index b05bcab56..0459a6cfb 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -495,10 +495,10 @@ module ValueOptionInternal = let inline bind f x = match x with ValueSome x -> f x | ValueNone -> ValueNone type String with - member inline x.StartsWithOrdinal(value) = + member inline x.StartsWithOrdinal value = x.StartsWith(value, StringComparison.Ordinal) - member inline x.EndsWithOrdinal(value) = + member inline x.EndsWithOrdinal value = x.EndsWith(value, StringComparison.Ordinal) module String = @@ -508,7 +508,7 @@ module String = let sub (s: string) (start: int) (len: int) = s.Substring(start, len) - let contains (s: string) (c: char) = s.IndexOf(c) <> -1 + let contains (s: string) (c: char) = s.IndexOf c <> -1 let order = LanguagePrimitives.FastGenericComparer @@ -543,7 +543,7 @@ module String = | None -> str | Some c -> strArr.[0] <- Char.ToLower c - String (strArr) + String strArr let extractTrailingIndex (str: string) = match str with @@ -569,7 +569,7 @@ module String = let (|StartsWith|_|) pattern value = if String.IsNullOrWhiteSpace value then None - elif value.StartsWithOrdinal(pattern) then + elif value.StartsWithOrdinal pattern then Some() else None @@ -583,14 +583,14 @@ module String = let getLines (str: string) = use reader = new StringReader(str) [| - let line = ref (reader.ReadLine()) - while not (isNull !line) do - yield !line - line := reader.ReadLine() - if str.EndsWithOrdinal("\n") then - // last trailing space not returned - // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak - yield String.Empty + let line = ref (reader.ReadLine()) + while not (isNull !line) do + yield !line + line := reader.ReadLine() + if str.EndsWithOrdinal("\n") then + // last trailing space not returned + // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak + yield String.Empty |] module Dictionary = @@ -810,9 +810,9 @@ type CancellableBuilder() = member x.Bind(e, k) = Cancellable.bind k e - member x.Return(v) = Cancellable.ret v + member x.Return v = Cancellable.ret v - member x.ReturnFrom(v) = v + member x.ReturnFrom v = v member x.Combine(e1, e2) = e1 |> Cancellable.bind (fun () -> e2) @@ -822,7 +822,7 @@ type CancellableBuilder() = member x.TryFinally(e, compensation) = Cancellable.tryFinally e compensation - member x.Delay(f) = Cancellable.delay f + member x.Delay f = Cancellable.delay f member x.Zero() = Cancellable.ret () @@ -850,12 +850,12 @@ module Eventually = let rec box e = match e with | Done x -> Done (Operators.box x) - | NotYetDone (work) -> NotYetDone (fun ctok -> box (work ctok)) + | NotYetDone work -> NotYetDone (fun ctok -> box (work ctok)) let rec forceWhile ctok check e = match e with - | Done x -> Some(x) - | NotYetDone (work) -> + | Done x -> Some x + | NotYetDone work -> if not(check()) then None else forceWhile ctok check (work ctok) @@ -918,7 +918,7 @@ module Eventually = let delay (f: unit -> Eventually<'T>) = NotYetDone (fun _ctok -> f()) let tryFinally e compensation = - catch (e) + catch e |> bind (fun res -> compensation() match res with @@ -937,9 +937,9 @@ type EventuallyBuilder() = member x.Bind(e, k) = Eventually.bind k e - member x.Return(v) = Eventually.Done v + member x.Return v = Eventually.Done v - member x.ReturnFrom(v) = v + member x.ReturnFrom v = v member x.Combine(e1, e2) = e1 |> Eventually.bind (fun () -> e2) @@ -947,7 +947,7 @@ type EventuallyBuilder() = member x.TryFinally(e, compensation) = Eventually.tryFinally e compensation - member x.Delay(f) = Eventually.delay f + member x.Delay f = Eventually.delay f member x.Zero() = Eventually.Done () @@ -966,7 +966,7 @@ type UniqueStampGenerator<'T when 'T : equality>() = let encodeTab = new Dictionary<'T, int>(HashIdentity.Structural) let mutable nItems = 0 let encode str = - match encodeTab.TryGetValue(str) with + match encodeTab.TryGetValue str with | true, idx -> idx | _ -> let idx = nItems @@ -974,7 +974,7 @@ type UniqueStampGenerator<'T when 'T : equality>() = nItems <- nItems + 1 idx - member this.Encode(str) = encode str + member this.Encode str = encode str member this.Table = encodeTab.Keys @@ -983,7 +983,7 @@ type MemoizationTable<'T, 'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer< let table = new Dictionary<'T, 'U>(keyComparer) - member t.Apply(x) = + member t.Apply x = if (match canMemoize with None -> true | Some f -> f x) then let mutable res = Unchecked.defaultof<'U> let ok = table.TryGetValue(x, &res) @@ -1044,13 +1044,13 @@ type LazyWithContext<'T, 'ctxt> = | null -> x.value | _ -> // Enter the lock in case another thread is in the process of evaluating the result - Monitor.Enter(x); + Monitor.Enter x; try - x.UnsynchronizedForce(ctxt) + x.UnsynchronizedForce ctxt finally - Monitor.Exit(x) + Monitor.Exit x - member x.UnsynchronizedForce(ctxt) = + member x.UnsynchronizedForce ctxt = match x.funcOrException with | null -> x.value | :? LazyWithContextFailure as res -> @@ -1104,15 +1104,15 @@ module IPartialEqualityComparer = let partialDistinctBy (per: IPartialEqualityComparer<'T>) seq = let wper = { new IPartialEqualityComparer> with - member __.InEqualityRelation (Wrap x) = per.InEqualityRelation (x) + member __.InEqualityRelation (Wrap x) = per.InEqualityRelation x member __.Equals(Wrap x, Wrap y) = per.Equals(x, y) - member __.GetHashCode (Wrap x) = per.GetHashCode(x) } + member __.GetHashCode (Wrap x) = per.GetHashCode x } // Wrap a Wrap _ around all keys in case the key type is itself a type using null as a representation let dict = Dictionary, obj>(wper) seq |> List.filter (fun v -> - let key = Wrap(v) - if (per.InEqualityRelation(v)) then - if dict.ContainsKey(key) then false else (dict.[key] <- null; true) + let key = Wrap v + if (per.InEqualityRelation v) then + if dict.ContainsKey key then false else (dict.[key] <- null; true) else true) //------------------------------------------------------------------------- @@ -1350,18 +1350,18 @@ module Shim = member __.IsInvalidPathShim(path: string) = let isInvalidPath(p: string) = - String.IsNullOrEmpty(p) || p.IndexOfAny(Path.GetInvalidPathChars()) <> -1 + String.IsNullOrEmpty p || p.IndexOfAny(Path.GetInvalidPathChars()) <> -1 let isInvalidFilename(p: string) = - String.IsNullOrEmpty(p) || p.IndexOfAny(Path.GetInvalidFileNameChars()) <> -1 + String.IsNullOrEmpty p || p.IndexOfAny(Path.GetInvalidFileNameChars()) <> -1 let isInvalidDirectory(d: string) = d=null || d.IndexOfAny(Path.GetInvalidPathChars()) <> -1 - isInvalidPath (path) || - let directory = Path.GetDirectoryName(path) - let filename = Path.GetFileName(path) - isInvalidDirectory(directory) || isInvalidFilename(filename) + isInvalidPath path || + let directory = Path.GetDirectoryName path + let filename = Path.GetFileName path + isInvalidDirectory directory || isInvalidFilename filename member __.GetTempPathShim() = Path.GetTempPath() @@ -1372,7 +1372,7 @@ module Shim = member __.FileDelete (fileName: string) = File.Delete fileName member __.IsStableFileHeuristic (fileName: string) = - let directory = Path.GetDirectoryName(fileName) + let directory = Path.GetDirectoryName fileName directory.Contains("Reference Assemblies/") || directory.Contains("Reference Assemblies\\") || directory.Contains("packages/") || diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index e2cf38f10..7da0a3515 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -39,8 +39,8 @@ let alwaysMemoryMapFSC = try (System.Environment.GetEnvironmentVariable("FSharp_ let stronglyHeldReaderCacheSizeDefault = 30 let stronglyHeldReaderCacheSize = try (match System.Environment.GetEnvironmentVariable("FSharp_StronglyHeldBinaryReaderCacheSize") with null -> stronglyHeldReaderCacheSizeDefault | s -> int32 s) with _ -> stronglyHeldReaderCacheSizeDefault -let singleOfBits (x: int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) -let doubleOfBits (x: int64) = System.BitConverter.Int64BitsToDouble(x) +let singleOfBits (x: int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes x, 0) +let doubleOfBits (x: int64) = System.BitConverter.Int64BitsToDouble x //--------------------------------------------------------------------- // Utilities. @@ -164,7 +164,7 @@ type RawMemoryView(obj: obj, start: nativeint, len: int) = if nativeint i > nativeint len then failwithf "RawMemoryView overrun, i = %d, obj = %A" i obj let pStart = start + nativeint i let mutable p = start - while Marshal.ReadByte(p) <> 0uy do + while Marshal.ReadByte p <> 0uy do p <- p + 1n int (p - pStart) @@ -258,7 +258,7 @@ type MemoryMapView(start: nativeint) = override m.CountUtf8String i = let pStart = start + nativeint i let mutable p = start - while Marshal.ReadByte(p) <> 0uy do + while Marshal.ReadByte p <> 0uy do p <- p + 1n int (p - pStart) @@ -280,7 +280,7 @@ type MemoryMapFile(fileName: string, view: MemoryMapView, hMap: MemoryMapping.HA failwithf "CreateFile(0x%08x)" (Marshal.GetHRForLastWin32Error()) let protection = 0x00000002 let hMap = MemoryMapping.CreateFileMapping (hFile, IntPtr.Zero, protection, 0, 0, null ) - ignore(MemoryMapping.CloseHandle(hFile)) + ignore(MemoryMapping.CloseHandle hFile) if hMap.Equals(MemoryMapping.NULL_HANDLE) then failwithf "CreateFileMapping(0x%08x)" (Marshal.GetHRForLastWin32Error()) @@ -289,7 +289,7 @@ type MemoryMapFile(fileName: string, view: MemoryMapView, hMap: MemoryMapping.HA if hView.Equals(IntPtr.Zero) then failwithf "MapViewOfFile(0x%08x)" (Marshal.GetHRForLastWin32Error()) - let view = MemoryMapView(hView) + let view = MemoryMapView hView MemoryMapFile(fileName, view, hMap, hView) @@ -338,7 +338,7 @@ type ByteView(bytes: byte[]) = /// A BinaryFile backed by an array of bytes held strongly as managed memory [] type ByteFile(fileName: string, bytes: byte[]) = - let view = ByteView(bytes) + let view = ByteView bytes do stats.byteFileCount <- stats.byteFileCount + 1 member __.FileName = fileName interface BinaryFile with @@ -353,7 +353,7 @@ type WeakByteFile(fileName: string, chunk: (int * int) option) = do stats.weakByteFileCount <- stats.weakByteFileCount + 1 /// Used to check that the file hasn't changed - let fileStamp = FileSystem.GetLastWriteTimeShim(fileName) + let fileStamp = FileSystem.GetLastWriteTimeShim fileName /// The weak handle to the bytes for the file let weakBytes = new WeakReference (null) @@ -367,7 +367,7 @@ type WeakByteFile(fileName: string, chunk: (int * int) option) = let strongBytes = let mutable tg = null if not (weakBytes.TryGetTarget(&tg)) then - if FileSystem.GetLastWriteTimeShim(fileName) <> fileStamp then + if FileSystem.GetLastWriteTimeShim fileName <> fileStamp then error (Error (FSComp.SR.ilreadFileChanged fileName, range0)) let bytes = @@ -381,7 +381,7 @@ type WeakByteFile(fileName: string, chunk: (int * int) option) = tg - (ByteView(strongBytes) :> BinaryView) + (ByteView strongBytes :> BinaryView) let seekReadByte (mdv: BinaryView) addr = mdv.ReadByte addr @@ -671,8 +671,8 @@ let instrs () = i_ldc_i4_s, I_i32_i8_instr (noPrefixes mkLdcInt32) i_ldc_r4, I_r4_instr (noPrefixes (fun x -> (AI_ldc (DT_R4, ILConst.R4 x)))) i_ldc_r8, I_r8_instr (noPrefixes (fun x -> (AI_ldc (DT_R8, ILConst.R8 x)))) - i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_ldfld(x, y, fspec))) - i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_stfld(x, y, fspec))) + i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_ldfld (x, y, fspec))) + i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_stfld (x, y, fspec))) i_ldsfld, I_field_instr (volatilePrefix (fun x fspec -> I_ldsfld (x, fspec))) i_stsfld, I_field_instr (volatilePrefix (fun x fspec -> I_stsfld (x, fspec))) i_ldflda, I_field_instr (noPrefixes I_ldflda) @@ -925,7 +925,7 @@ let mkCacheGeneric lowMem _inbase _nm _sz = | null -> cache := new Dictionary<_, _>(11 (* sz: int *) ) | _ -> () !cache - match cache.TryGetValue(idx) with + match cache.TryGetValue idx with | true, v -> incr count v @@ -1708,7 +1708,7 @@ and seekReadAssemblyRefUncached ctxtH idx = locale = readStringHeapOption ctxt localeIdx) and seekReadModuleRef (ctxt: ILMetadataReader) mdv idx = - let (nameIdx) = seekReadModuleRefRow ctxt mdv idx + let nameIdx = seekReadModuleRefRow ctxt mdv idx ILModuleRef.Create(name = readStringHeap ctxt nameIdx, hasMetadata=true, hash=None) and seekReadFile (ctxt: ILMetadataReader) mdv idx = @@ -2137,7 +2137,7 @@ and sigptrGetArgTys (ctxt: ILMetadataReader) n numtypars bytes sigptr acc = let b0, sigptr2 = sigptrGetByte bytes sigptr if b0 = et_SENTINEL then let varargs, sigptr = sigptrGetVarArgTys ctxt n numtypars bytes sigptr2 - (List.rev acc, Some(varargs)), sigptr + (List.rev acc, Some varargs), sigptr else let x, sigptr = sigptrGetTy ctxt numtypars bytes sigptr sigptrGetArgTys ctxt (n-1) numtypars bytes sigptr (x::acc) @@ -2602,7 +2602,7 @@ and seekReadConstant (ctxt: ILMetadataReader) idx = | x when x = uint16 et_STRING -> let blobHeap = readBlobHeap ctxt vidx let s = System.Text.Encoding.Unicode.GetString(blobHeap, 0, blobHeap.Length) - ILFieldInit.String (s) + ILFieldInit.String s | x when x = uint16 et_BOOLEAN -> ILFieldInit.Bool (readBlobHeapAsBool ctxt vidx) | x when x = uint16 et_CHAR -> ILFieldInit.Char (readBlobHeapAsUInt16 ctxt vidx) | x when x = uint16 et_I1 -> ILFieldInit.Int8 (readBlobHeapAsSByte ctxt vidx) @@ -2676,7 +2676,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start s let labelsOfRawOffsets = new Dictionary<_, _>(sz/2) let ilOffsetsOfLabels = new Dictionary<_, _>(sz/2) let tryRawToLabel rawOffset = - match labelsOfRawOffsets.TryGetValue(rawOffset) with + match labelsOfRawOffsets.TryGetValue rawOffset with | true, v -> Some v | _ -> None @@ -2843,7 +2843,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start s let (tab, idx) = seekReadUncodedToken pev (start + (!curr)) curr := !curr + 4 if tab <> TableNames.UserStrings then dprintn "warning: bad table in user string for ldstr" - f prefixes (readUserStringHeap ctxt (idx)) + f prefixes (readUserStringHeap ctxt idx) | I_conditional_i32_instr f -> let offsDest = (seekReadInt32 pev (start + (!curr))) @@ -3114,7 +3114,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int end let key = (tryStart, tryFinish) - match sehMap.TryGetValue(key) with + match sehMap.TryGetValue key with | true, prev -> sehMap.[key] <- prev @ [clause] | _ -> sehMap.[key] <- [clause]) clauses @@ -3163,24 +3163,24 @@ and sigptrGetILNativeType ctxt bytes sigptr = List.assoc ntbyte (Lazy.force ILNativeTypeMap), sigptr elif ntbyte = 0x0uy then ILNativeType.Empty, sigptr elif ntbyte = nt_CUSTOMMARSHALER then - // reading native type blob (CM1), sigptr= "+string sigptr+ ", bytes.Length = "+string bytes.Length) + // reading native type blob CM1, sigptr= "+string sigptr+ ", bytes.Length = "+string bytes.Length) let guidLen, sigptr = sigptrGetZInt32 bytes sigptr - // reading native type blob (CM2), sigptr= "+string sigptr+", guidLen = "+string ( guidLen)) + // reading native type blob CM2, sigptr= "+string sigptr+", guidLen = "+string ( guidLen)) let guid, sigptr = sigptrGetBytes ( guidLen) bytes sigptr - // reading native type blob (CM3), sigptr= "+string sigptr) + // reading native type blob CM3, sigptr= "+string sigptr) let nativeTypeNameLen, sigptr = sigptrGetZInt32 bytes sigptr - // reading native type blob (CM4), sigptr= "+string sigptr+", nativeTypeNameLen = "+string ( nativeTypeNameLen)) + // reading native type blob CM4, sigptr= "+string sigptr+", nativeTypeNameLen = "+string ( nativeTypeNameLen)) let nativeTypeName, sigptr = sigptrGetString ( nativeTypeNameLen) bytes sigptr - // reading native type blob (CM4), sigptr= "+string sigptr+", nativeTypeName = "+nativeTypeName) - // reading native type blob (CM5), sigptr= "+string sigptr) + // reading native type blob CM4, sigptr= "+string sigptr+", nativeTypeName = "+nativeTypeName) + // reading native type blob CM5, sigptr= "+string sigptr) let custMarshallerNameLen, sigptr = sigptrGetZInt32 bytes sigptr - // reading native type blob (CM6), sigptr= "+string sigptr+", custMarshallerNameLen = "+string ( custMarshallerNameLen)) + // reading native type blob CM6, sigptr= "+string sigptr+", custMarshallerNameLen = "+string ( custMarshallerNameLen)) let custMarshallerName, sigptr = sigptrGetString ( custMarshallerNameLen) bytes sigptr - // reading native type blob (CM7), sigptr= "+string sigptr+", custMarshallerName = "+custMarshallerName) + // reading native type blob CM7, sigptr= "+string sigptr+", custMarshallerName = "+custMarshallerName) let cookieStringLen, sigptr = sigptrGetZInt32 bytes sigptr - // reading native type blob (CM8), sigptr= "+string sigptr+", cookieStringLen = "+string ( cookieStringLen)) + // reading native type blob CM8, sigptr= "+string sigptr+", cookieStringLen = "+string ( cookieStringLen)) let cookieString, sigptr = sigptrGetBytes ( cookieStringLen) bytes sigptr - // reading native type blob (CM9), sigptr= "+string sigptr) + // reading native type blob CM9, sigptr= "+string sigptr) ILNativeType.Custom (guid, nativeTypeName, custMarshallerName, cookieString), sigptr elif ntbyte = nt_FIXEDSYSSTRING then let i, sigptr = sigptrGetZInt32 bytes sigptr @@ -3220,7 +3220,7 @@ and sigptrGetILNativeType ctxt bytes sigptr = let additive, sigptr = if sigptr >= bytes.Length then 0, sigptr else sigptrGetZInt32 bytes sigptr - ILNativeType.Array (Some nt, Some(pnum, Some(additive))), sigptr + ILNativeType.Array (Some nt, Some(pnum, Some additive)), sigptr else (ILNativeType.Empty, sigptr) // Note, pectxtEager and pevEager must not be captured by the results of this function @@ -3320,7 +3320,7 @@ let getPdbReader pdbDirPath fileName = file = url)) let docfun url = - match tab.TryGetValue(url) with + match tab.TryGetValue url with | true, doc -> doc | _ -> failwith ("Document with URL " + url + " not found in list of documents in the PDB file") Some (pdbr, docfun) @@ -3735,7 +3735,7 @@ let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) = optHeaderSize <> 0xf0 then failwith "not a PE file - bad optional header size" let x64adjust = optHeaderSize - 0xe0 let only64 = (optHeaderSize = 0xf0) (* May want to read in the optional header Magic number and check that as well... *) - let platform = match machine with | 0x8664 -> Some(AMD64) | 0x200 -> Some(IA64) | _ -> Some(X86) + let platform = match machine with | 0x8664 -> Some AMD64 | 0x200 -> Some IA64 | _ -> Some X86 let sectionHeadersStartPhysLoc = peOptionalHeaderPhysLoc + optHeaderSize let flags = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 18) @@ -4007,8 +4007,8 @@ let OpenILModuleReader fileName opts = // Pseudo-normalize the paths. let (ILModuleReaderCacheKey (fullPath,writeStamp,_,_,_,_) as key), keyOk = try - let fullPath = FileSystem.GetFullPathShim(fileName) - let writeTime = FileSystem.GetLastWriteTimeShim(fileName) + let fullPath = FileSystem.GetFullPathShim fileName + let writeTime = FileSystem.GetLastWriteTimeShim fileName let key = ILModuleReaderCacheKey (fullPath, writeTime, opts.ilGlobals.primaryAssemblyScopeRef, opts.pdbDirPath.IsSome, opts.reduceMemoryUsage, opts.metadataOnly) key, true with exn -> diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 8c4b895fd..53a43fc00 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -8,6 +8,7 @@ module internal FSharp.Compiler.AbstractIL.ILRuntimeWriter open System +open System.IO open System.Reflection open System.Reflection.Emit open System.Runtime.InteropServices @@ -18,10 +19,10 @@ open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILAsciiWriter open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Range - -open Microsoft.FSharp.Core.Printf +open FSharp.Core.Printf #if FX_RESHAPED_REFLECTION open Microsoft.FSharp.Core.ReflectionAdapters @@ -30,7 +31,6 @@ open Microsoft.FSharp.Core.ReflectionAdapters let codeLabelOrder = ComparisonIdentity.Structural // Convert the output of convCustomAttr -open FSharp.Compiler.AbstractIL.ILAsciiWriter let wrapCustomAttr setCustomAttr (cinfo, bytes) = setCustomAttr(cinfo, bytes) @@ -42,163 +42,163 @@ let wrapCustomAttr setCustomAttr (cinfo, bytes) = let logRefEmitCalls = false type System.Reflection.Emit.AssemblyBuilder with - member asmB.DefineDynamicModuleAndLog(a, b, c) = + member asmB.DefineDynamicModuleAndLog (a, b, c) = #if FX_RESHAPED_REFEMIT ignore b ignore c - let modB = asmB.DefineDynamicModule(a) + let modB = asmB.DefineDynamicModule a #else let modB = asmB.DefineDynamicModule(a, b, c) if logRefEmitCalls then printfn "let moduleBuilder%d = assemblyBuilder%d.DefineDynamicModule(%A, %A, %A)" (abs <| hash modB) (abs <| hash asmB) a b c #endif modB - member asmB.SetCustomAttributeAndLog(cinfo, bytes) = + member asmB.SetCustomAttributeAndLog (cinfo, bytes) = if logRefEmitCalls then printfn "assemblyBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash asmB) cinfo bytes wrapCustomAttr asmB.SetCustomAttribute (cinfo, bytes) #if !FX_RESHAPED_REFEMIT - member asmB.AddResourceFileAndLog(nm1, nm2, attrs) = + member asmB.AddResourceFileAndLog (nm1, nm2, attrs) = if logRefEmitCalls then printfn "assemblyBuilder%d.AddResourceFile(%A, %A, enum %d)" (abs <| hash asmB) nm1 nm2 (LanguagePrimitives.EnumToValue attrs) asmB.AddResourceFile(nm1, nm2, attrs) #endif - member asmB.SetCustomAttributeAndLog(cab) = + member asmB.SetCustomAttributeAndLog cab = if logRefEmitCalls then printfn "assemblyBuilder%d.SetCustomAttribute(%A)" (abs <| hash asmB) cab - asmB.SetCustomAttribute(cab) + asmB.SetCustomAttribute cab type System.Reflection.Emit.ModuleBuilder with - member modB.GetArrayMethodAndLog(aty, nm, flags, rty, tys) = + member modB.GetArrayMethodAndLog (aty, nm, flags, rty, tys) = if logRefEmitCalls then printfn "moduleBuilder%d.GetArrayMethod(%A, %A, %A, %A, %A)" (abs <| hash modB) aty nm flags rty tys modB.GetArrayMethod(aty, nm, flags, rty, tys) #if !FX_RESHAPED_REFEMIT - member modB.DefineDocumentAndLog(file, lang, vendor, doctype) = + member modB.DefineDocumentAndLog (file, lang, vendor, doctype) = let symDoc = modB.DefineDocument(file, lang, vendor, doctype) if logRefEmitCalls then printfn "let docWriter%d = moduleBuilder%d.DefineDocument(@%A, System.Guid(\"%A\"), System.Guid(\"%A\"), System.Guid(\"%A\"))" (abs <| hash symDoc) (abs <| hash modB) file lang vendor doctype symDoc #endif - member modB.GetTypeAndLog(nameInModule, flag1, flag2) = + member modB.GetTypeAndLog (nameInModule, flag1, flag2) = if logRefEmitCalls then printfn "moduleBuilder%d.GetType(%A, %A, %A) |> ignore" (abs <| hash modB) nameInModule flag1 flag2 modB.GetType(nameInModule, flag1, flag2) - member modB.DefineTypeAndLog(name, attrs) = + member modB.DefineTypeAndLog (name, attrs) = let typB = modB.DefineType(name, attrs) if logRefEmitCalls then printfn "let typeBuilder%d = moduleBuilder%d.DefineType(%A, enum %d)" (abs <| hash typB) (abs <| hash modB) name (LanguagePrimitives.EnumToValue attrs) typB #if !FX_RESHAPED_REFEMIT - member modB.DefineManifestResourceAndLog(name, stream, attrs) = + member modB.DefineManifestResourceAndLog (name, stream, attrs) = if logRefEmitCalls then printfn "moduleBuilder%d.DefineManifestResource(%A, %A, enum %d)" (abs <| hash modB) name stream (LanguagePrimitives.EnumToValue attrs) modB.DefineManifestResource(name, stream, attrs) #endif - member modB.SetCustomAttributeAndLog(cinfo, bytes) = + member modB.SetCustomAttributeAndLog (cinfo, bytes) = if logRefEmitCalls then printfn "moduleBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash modB) cinfo bytes wrapCustomAttr modB.SetCustomAttribute (cinfo, bytes) type System.Reflection.Emit.ConstructorBuilder with - member consB.SetImplementationFlagsAndLog(attrs) = + member consB.SetImplementationFlagsAndLog attrs = if logRefEmitCalls then printfn "constructorBuilder%d.SetImplementationFlags(enum %d)" (abs <| hash consB) (LanguagePrimitives.EnumToValue attrs) - consB.SetImplementationFlags(attrs) + consB.SetImplementationFlags attrs - member consB.DefineParameterAndLog(n, attr, nm) = + member consB.DefineParameterAndLog (n, attr, nm) = if logRefEmitCalls then printfn "constructorBuilder%d.DefineParameter(%d, enum %d, %A)" (abs <| hash consB) n (LanguagePrimitives.EnumToValue attr) nm consB.DefineParameter(n, attr, nm) - member consB.GetILGeneratorAndLog() = + member consB.GetILGeneratorAndLog () = let ilG = consB.GetILGenerator() if logRefEmitCalls then printfn "let ilg%d = constructorBuilder%d.GetILGenerator()" (abs <| hash ilG) (abs <| hash consB) ilG type System.Reflection.Emit.MethodBuilder with - member methB.SetImplementationFlagsAndLog(attrs) = + member methB.SetImplementationFlagsAndLog attrs = if logRefEmitCalls then printfn "methodBuilder%d.SetImplementationFlags(enum %d)" (abs <| hash methB) (LanguagePrimitives.EnumToValue attrs) - methB.SetImplementationFlags(attrs) + methB.SetImplementationFlags attrs - member methB.SetSignatureAndLog(returnType, returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers, parameterTypes, parameterTypeRequiredCustomModifiers,parameterTypeOptionalCustomModifiers) = + member methB.SetSignatureAndLog (returnType, returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers, parameterTypes, parameterTypeRequiredCustomModifiers,parameterTypeOptionalCustomModifiers) = if logRefEmitCalls then printfn "methodBuilder%d.SetSignature(...)" (abs <| hash methB) methB.SetSignature(returnType, returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers, parameterTypes, parameterTypeRequiredCustomModifiers,parameterTypeOptionalCustomModifiers) - member methB.DefineParameterAndLog(n, attr, nm) = + member methB.DefineParameterAndLog (n, attr, nm) = if logRefEmitCalls then printfn "methodBuilder%d.DefineParameter(%d, enum %d, %A)" (abs <| hash methB) n (LanguagePrimitives.EnumToValue attr) nm methB.DefineParameter(n, attr, nm) - member methB.DefineGenericParametersAndLog(gps) = + member methB.DefineGenericParametersAndLog gps = if logRefEmitCalls then printfn "let gps%d = methodBuilder%d.DefineGenericParameters(%A)" (abs <| hash methB) (abs <| hash methB) gps - methB.DefineGenericParameters(gps) + methB.DefineGenericParameters gps - member methB.GetILGeneratorAndLog() = + member methB.GetILGeneratorAndLog () = let ilG = methB.GetILGenerator() if logRefEmitCalls then printfn "let ilg%d = methodBuilder%d.GetILGenerator()" (abs <| hash ilG) (abs <| hash methB) ilG - member methB.SetCustomAttributeAndLog(cinfo, bytes) = + member methB.SetCustomAttributeAndLog (cinfo, bytes) = if logRefEmitCalls then printfn "methodBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash methB) cinfo bytes wrapCustomAttr methB.SetCustomAttribute (cinfo, bytes) type System.Reflection.Emit.TypeBuilder with - member typB.CreateTypeAndLog() = + member typB.CreateTypeAndLog () = if logRefEmitCalls then printfn "typeBuilder%d.CreateType()" (abs <| hash typB) #if FX_RESHAPED_REFEMIT typB.CreateTypeInfo().AsType() #else typB.CreateType() #endif - member typB.DefineNestedTypeAndLog(name, attrs) = + member typB.DefineNestedTypeAndLog (name, attrs) = let res = typB.DefineNestedType(name, attrs) if logRefEmitCalls then printfn "let typeBuilder%d = typeBuilder%d.DefineNestedType(\"%s\", enum %d)" (abs <| hash res) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) res - member typB.DefineMethodAndLog(name, attrs, cconv) = + member typB.DefineMethodAndLog (name, attrs, cconv) = let methB = typB.DefineMethod(name, attrs, cconv) if logRefEmitCalls then printfn "let methodBuilder%d = typeBuilder%d.DefineMethod(\"%s\", enum %d, enum %d)" (abs <| hash methB) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) (LanguagePrimitives.EnumToValue cconv) methB - member typB.DefineGenericParametersAndLog(gps) = + member typB.DefineGenericParametersAndLog gps = if logRefEmitCalls then printfn "typeBuilder%d.DefineGenericParameters(%A)" (abs <| hash typB) gps - typB.DefineGenericParameters(gps) + typB.DefineGenericParameters gps - member typB.DefineConstructorAndLog(attrs, cconv, parms) = + member typB.DefineConstructorAndLog (attrs, cconv, parms) = let consB = typB.DefineConstructor(attrs, cconv, parms) if logRefEmitCalls then printfn "let constructorBuilder%d = typeBuilder%d.DefineConstructor(enum %d, CallingConventions.%A, %A)" (abs <| hash consB) (abs <| hash typB) (LanguagePrimitives.EnumToValue attrs) cconv parms consB - member typB.DefineFieldAndLog(nm, ty: System.Type, attrs) = + member typB.DefineFieldAndLog (nm, ty: System.Type, attrs) = let fieldB = typB.DefineField(nm, ty, attrs) if logRefEmitCalls then printfn "let fieldBuilder%d = typeBuilder%d.DefineField(\"%s\", typeof<%s>, enum %d)" (abs <| hash fieldB) (abs <| hash typB) nm ty.FullName (LanguagePrimitives.EnumToValue attrs) fieldB - member typB.DefinePropertyAndLog(nm, attrs, ty: System.Type, args) = + member typB.DefinePropertyAndLog (nm, attrs, ty: System.Type, args) = if logRefEmitCalls then printfn "typeBuilder%d.DefineProperty(\"%A\", enum %d, typeof<%s>, %A)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName args typB.DefineProperty(nm, attrs, ty, args) - member typB.DefineEventAndLog(nm, attrs, ty: System.Type) = + member typB.DefineEventAndLog (nm, attrs, ty: System.Type) = if logRefEmitCalls then printfn "typeBuilder%d.DefineEvent(\"%A\", enum %d, typeof<%A>)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName typB.DefineEvent(nm, attrs, ty) - member typB.SetParentAndLog(ty: System.Type) = + member typB.SetParentAndLog (ty: System.Type) = if logRefEmitCalls then printfn "typeBuilder%d.SetParent(typeof<%s>)" (abs <| hash typB) ty.FullName - typB.SetParent(ty) + typB.SetParent ty - member typB.AddInterfaceImplementationAndLog(ty) = + member typB.AddInterfaceImplementationAndLog ty = if logRefEmitCalls then printfn "typeBuilder%d.AddInterfaceImplementation(%A)" (abs <| hash typB) ty - typB.AddInterfaceImplementation(ty) + typB.AddInterfaceImplementation ty - member typB.InvokeMemberAndLog(nm, _flags, args) = + member typB.InvokeMemberAndLog (nm, _flags, args) = #if FX_RESHAPED_REFEMIT - let t = typB.CreateTypeAndLog() + let t = typB.CreateTypeAndLog () let m = if t <> null then t.GetMethod(nm, (args |> Seq.map(fun x -> x.GetType()) |> Seq.toArray)) else null if m <> null then m.Invoke(null, args) - else raise (MissingMethodException(nm)) + else raise (MissingMethodException nm) #else if logRefEmitCalls then printfn "typeBuilder%d.InvokeMember(\"%s\", enum %d, null, null, %A, Globalization.CultureInfo.InvariantCulture)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue _flags) args typB.InvokeMember(nm, _flags, null, null, args, Globalization.CultureInfo.InvariantCulture) #endif - member typB.SetCustomAttributeAndLog(cinfo, bytes) = + member typB.SetCustomAttributeAndLog (cinfo, bytes) = if logRefEmitCalls then printfn "typeBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash typB) cinfo bytes wrapCustomAttr typB.SetCustomAttribute (cinfo, bytes) @@ -207,51 +207,51 @@ type System.Reflection.Emit.OpCode with member opcode.RefEmitName = (string (System.Char.ToUpper(opcode.Name.[0])) + opcode.Name.[1..]).Replace(".", "_").Replace("_i4", "_I4") type System.Reflection.Emit.ILGenerator with - member ilG.DeclareLocalAndLog(ty: System.Type, isPinned) = + member ilG.DeclareLocalAndLog (ty: System.Type, isPinned) = if logRefEmitCalls then printfn "ilg%d.DeclareLocal(typeof<%s>, %b)" (abs <| hash ilG) ty.FullName isPinned ilG.DeclareLocal(ty, isPinned) - member ilG.MarkLabelAndLog(lab) = + member ilG.MarkLabelAndLog lab = if logRefEmitCalls then printfn "ilg%d.MarkLabel(label%d_%d)" (abs <| hash ilG) (abs <| hash ilG) (abs <| hash lab) - ilG.MarkLabel(lab) + ilG.MarkLabel lab #if !FX_RESHAPED_REFEMIT - member ilG.MarkSequencePointAndLog(symDoc, l1, c1, l2, c2) = + member ilG.MarkSequencePointAndLog (symDoc, l1, c1, l2, c2) = if logRefEmitCalls then printfn "ilg%d.MarkSequencePoint(docWriter%d, %A, %A, %A, %A)" (abs <| hash ilG) (abs <| hash symDoc) l1 c1 l2 c2 ilG.MarkSequencePoint(symDoc, l1, c1, l2, c2) #endif - member ilG.BeginExceptionBlockAndLog() = + member ilG.BeginExceptionBlockAndLog () = if logRefEmitCalls then printfn "ilg%d.BeginExceptionBlock()" (abs <| hash ilG) ilG.BeginExceptionBlock() - member ilG.EndExceptionBlockAndLog() = + member ilG.EndExceptionBlockAndLog () = if logRefEmitCalls then printfn "ilg%d.EndExceptionBlock()" (abs <| hash ilG) ilG.EndExceptionBlock() - member ilG.BeginFinallyBlockAndLog() = + member ilG.BeginFinallyBlockAndLog () = if logRefEmitCalls then printfn "ilg%d.BeginFinallyBlock()" (abs <| hash ilG) ilG.BeginFinallyBlock() - member ilG.BeginCatchBlockAndLog(ty) = + member ilG.BeginCatchBlockAndLog ty = if logRefEmitCalls then printfn "ilg%d.BeginCatchBlock(%A)" (abs <| hash ilG) ty - ilG.BeginCatchBlock(ty) + ilG.BeginCatchBlock ty - member ilG.BeginExceptFilterBlockAndLog() = + member ilG.BeginExceptFilterBlockAndLog () = if logRefEmitCalls then printfn "ilg%d.BeginExceptFilterBlock()" (abs <| hash ilG) ilG.BeginExceptFilterBlock() - member ilG.BeginFaultBlockAndLog() = + member ilG.BeginFaultBlockAndLog () = if logRefEmitCalls then printfn "ilg%d.BeginFaultBlock()" (abs <| hash ilG) ilG.BeginFaultBlock() - member ilG.DefineLabelAndLog() = + member ilG.DefineLabelAndLog () = let lab = ilG.DefineLabel() if logRefEmitCalls then printfn "let label%d_%d = ilg%d.DefineLabel()" (abs <| hash ilG) (abs <| hash lab) (abs <| hash ilG) lab member x.EmitAndLog (op: OpCode) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s)" (abs <| hash x) op.RefEmitName - x.Emit(op) + x.Emit op member x.EmitAndLog (op: OpCode, v: Label) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, label%d_%d)" (abs <| hash x) op.RefEmitName (abs <| hash x) (abs <| hash v) x.Emit(op, v) @@ -287,7 +287,7 @@ let inline flagsIf b x = if b then x else enum 0 module Zmap = let force x m str = match Zmap.tryFind x m with Some y -> y | None -> failwithf "Zmap.force: %s: x = %+A" str x -let equalTypes (s: Type) (t: Type) = s.Equals(t) +let equalTypes (s: Type) (t: Type) = s.Equals t let equalTypeLists ss tt = List.lengthsEqAndForall2 equalTypes ss tt let equalTypeArrays ss tt = Array.lengthsEqAndForall2 equalTypes ss tt @@ -308,14 +308,14 @@ let convAssemblyRef (aref: ILAssemblyRef) = asmName.Name <- aref.Name (match aref.PublicKey with | None -> () - | Some (PublicKey bytes) -> asmName.SetPublicKey(bytes) - | Some (PublicKeyToken bytes) -> asmName.SetPublicKeyToken(bytes)) + | Some (PublicKey bytes) -> asmName.SetPublicKey bytes + | Some (PublicKeyToken bytes) -> asmName.SetPublicKeyToken bytes) let setVersion (version: ILVersionInfo) = asmName.Version <- System.Version (int32 version.Major, int32 version.Minor, int32 version.Build, int32 version.Revision) Option.iter setVersion aref.Version // asmName.ProcessorArchitecture <- System.Reflection.ProcessorArchitecture.MSIL #if !FX_RESHAPED_GLOBALIZATION - //Option.iter (fun name -> asmName.CultureInfo <- System.Globalization.CultureInfo.CreateSpecificCulture(name)) aref.Locale + //Option.iter (fun name -> asmName.CultureInfo <- System.Globalization.CultureInfo.CreateSpecificCulture name) aref.Locale asmName.CultureInfo <- System.Globalization.CultureInfo.InvariantCulture #endif asmName @@ -341,19 +341,19 @@ let convTypeRefAux (cenv: cenv) (tref: ILTypeRef) = let assembly = match cenv.resolveAssemblyRef asmref with | Some (Choice1Of2 path) -> - FileSystem.AssemblyLoadFrom(path) + FileSystem.AssemblyLoadFrom path | Some (Choice2Of2 assembly) -> assembly | None -> let asmName = convAssemblyRef asmref - FileSystem.AssemblyLoad(asmName) - let typT = assembly.GetType(qualifiedName) + FileSystem.AssemblyLoad asmName + let typT = assembly.GetType qualifiedName match typT with | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, asmref.QualifiedName), range0)) | res -> res | ILScopeRef.Module _ | ILScopeRef.Local _ -> - let typT = Type.GetType(qualifiedName) + let typT = Type.GetType qualifiedName match typT with | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, ""), range0)) | res -> res @@ -403,7 +403,7 @@ let envUpdateCreatedTypeRef emEnv (tref: ILTypeRef) = // The (TypeBuilder :> Type) does not implement all the methods that a Type proper does. let typT, typB, typeDef, _createdTypOpt = Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" if typB.IsCreated() then - let ty = typB.CreateTypeAndLog() + let ty = typB.CreateTypeAndLog () #if ENABLE_MONO_SUPPORT // Mono has a bug where executing code that includes an array type // match "match x with :? C[] -> ..." before the full loading of an object of type @@ -413,7 +413,7 @@ let envUpdateCreatedTypeRef emEnv (tref: ILTypeRef) = // a constructor. It is not usable in partial trust code. if runningOnMono && ty.IsClass && not ty.IsAbstract && not ty.IsGenericType && not ty.IsGenericTypeDefinition then try - System.Runtime.Serialization.FormatterServices.GetUninitializedObject(ty) |> ignore + System.Runtime.Serialization.FormatterServices.GetUninitializedObject ty |> ignore with e -> () #endif {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, Some ty) emEnv.emTypMap} @@ -477,7 +477,9 @@ let envGetLabel emEnv name = Zmap.find name emEnv.emLabels let envPushTyvars emEnv tys = {emEnv with emTyvars = tys :: emEnv.emTyvars} + let envPopTyvars emEnv = {emEnv with emTyvars = List.tail emEnv.emTyvars} + let envGetTyvar emEnv u16 = match emEnv.emTyvars with | [] -> failwith "envGetTyvar: not scope of type vars" @@ -491,6 +493,7 @@ let envGetTyvar emEnv u16 = let isEmittedTypeRef emEnv tref = Zmap.mem tref emEnv.emTypMap let envAddEntryPt emEnv mref = {emEnv with emEntryPts = mref::emEnv.emEntryPts} + let envPopEntryPts emEnv = {emEnv with emEntryPts = []}, emEnv.emEntryPts //---------------------------------------------------------------------------- @@ -704,7 +707,7 @@ let convFieldSpec cenv emEnv fspec = // convMethodRef //---------------------------------------------------------------------------- let queryableTypeGetMethodBySearch cenv emEnv parentT (mref: ILMethodRef) = - assert(not (typeIsNotQueryable(parentT))) + assert(not (typeIsNotQueryable parentT)) let cconv = (if mref.CallingConv.IsStatic then BindingFlags.Static else BindingFlags.Instance) let methInfos = parentT.GetMethods(cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic) |> Array.toList (* First, filter on name, if unique, then binding "done" *) @@ -737,12 +740,12 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref: ILMethodRef) = else Array.forall2 satisfiesParameter args ps let select (methInfo: MethodInfo) = - (* mref implied Types *) + // mref implied Types let mtyargTIs = getGenericArgumentsOfMethod methInfo if mtyargTIs.Length <> mref.GenericArity then false (* method generic arity mismatch *) else - (* methInfo implied Types *) + // methInfo implied Types let methodParameters = methInfo.GetParameters() let argTypes = mref.ArgTypes |> List.toArray if argTypes.Length <> methodParameters.Length then false (* method argument length mismatch *) else @@ -776,7 +779,7 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref: ILMethodRef) = | Some methInfo -> methInfo (* return MethodInfo for (generic) type's (generic) method *) let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) = - assert(not (typeIsNotQueryable(parentT))) + assert(not (typeIsNotQueryable parentT)) if mref.GenericArity = 0 then let tyargTs = getGenericArgumentsOfType parentT let argTs, resT = @@ -847,10 +850,7 @@ let convMethodSpec cenv emEnv (mspec: ILMethodSpec) = methInfo methInfo -//---------------------------------------------------------------------------- -// - QueryableTypeGetConstructors: get a constructor on a non-TypeBuilder type -//---------------------------------------------------------------------------- - +/// Get a constructor on a non-TypeBuilder type let queryableTypeGetConstructor cenv emEnv (parentT: Type) (mref: ILMethodRef) = let tyargTs = getGenericArgumentsOfType parentT let reqArgTs = @@ -865,10 +865,7 @@ let queryableTypeGetConstructor cenv emEnv (parentT: Type) (mref: ILMethodRef) = let nonQueryableTypeGetConstructor (parentTI: Type) (consInfo: ConstructorInfo) : ConstructorInfo = if parentTI.IsGenericType then TypeBuilder.GetConstructor(parentTI, consInfo) else consInfo -//---------------------------------------------------------------------------- -// convConstructorSpec (like convMethodSpec) -//---------------------------------------------------------------------------- - +/// convConstructorSpec (like convMethodSpec) let convConstructorSpec cenv emEnv (mspec: ILMethodSpec) = let mref = mspec.MethodRef let parentTI = convType cenv emEnv mspec.DeclaringType @@ -888,38 +885,30 @@ let convConstructorSpec cenv emEnv (mspec: ILMethodSpec) = | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("constructor", "", parentTI.FullName, parentTI.Assembly.FullName), range0)) | _ -> res -//---------------------------------------------------------------------------- -// emitLabelMark -//---------------------------------------------------------------------------- - let emitLabelMark emEnv (ilG: ILGenerator) (label: ILCodeLabel) = let lab = envGetLabel emEnv label - ilG.MarkLabelAndLog(lab) + ilG.MarkLabelAndLog lab -//---------------------------------------------------------------------------- -// emitInstr cenv - I_arith -//---------------------------------------------------------------------------- - ///Emit comparison instructions. let emitInstrCompare emEnv (ilG: ILGenerator) comp targ = match comp with - | BI_beq -> ilG.EmitAndLog(OpCodes.Beq, envGetLabel emEnv targ) - | BI_bge -> ilG.EmitAndLog(OpCodes.Bge, envGetLabel emEnv targ) - | BI_bge_un -> ilG.EmitAndLog(OpCodes.Bge_Un, envGetLabel emEnv targ) - | BI_bgt -> ilG.EmitAndLog(OpCodes.Bgt, envGetLabel emEnv targ) - | BI_bgt_un -> ilG.EmitAndLog(OpCodes.Bgt_Un, envGetLabel emEnv targ) - | BI_ble -> ilG.EmitAndLog(OpCodes.Ble, envGetLabel emEnv targ) - | BI_ble_un -> ilG.EmitAndLog(OpCodes.Ble_Un, envGetLabel emEnv targ) - | BI_blt -> ilG.EmitAndLog(OpCodes.Blt, envGetLabel emEnv targ) - | BI_blt_un -> ilG.EmitAndLog(OpCodes.Blt_Un, envGetLabel emEnv targ) - | BI_bne_un -> ilG.EmitAndLog(OpCodes.Bne_Un, envGetLabel emEnv targ) - | BI_brfalse -> ilG.EmitAndLog(OpCodes.Brfalse, envGetLabel emEnv targ) - | BI_brtrue -> ilG.EmitAndLog(OpCodes.Brtrue, envGetLabel emEnv targ) + | BI_beq -> ilG.EmitAndLog (OpCodes.Beq, envGetLabel emEnv targ) + | BI_bge -> ilG.EmitAndLog (OpCodes.Bge, envGetLabel emEnv targ) + | BI_bge_un -> ilG.EmitAndLog (OpCodes.Bge_Un, envGetLabel emEnv targ) + | BI_bgt -> ilG.EmitAndLog (OpCodes.Bgt, envGetLabel emEnv targ) + | BI_bgt_un -> ilG.EmitAndLog (OpCodes.Bgt_Un, envGetLabel emEnv targ) + | BI_ble -> ilG.EmitAndLog (OpCodes.Ble, envGetLabel emEnv targ) + | BI_ble_un -> ilG.EmitAndLog (OpCodes.Ble_Un, envGetLabel emEnv targ) + | BI_blt -> ilG.EmitAndLog (OpCodes.Blt, envGetLabel emEnv targ) + | BI_blt_un -> ilG.EmitAndLog (OpCodes.Blt_Un, envGetLabel emEnv targ) + | BI_bne_un -> ilG.EmitAndLog (OpCodes.Bne_Un, envGetLabel emEnv targ) + | BI_brfalse -> ilG.EmitAndLog (OpCodes.Brfalse, envGetLabel emEnv targ) + | BI_brtrue -> ilG.EmitAndLog (OpCodes.Brtrue, envGetLabel emEnv targ) /// Emit the volatile. prefix let emitInstrVolatile (ilG: ILGenerator) = function - | Volatile -> ilG.EmitAndLog(OpCodes.Volatile) + | Volatile -> ilG.EmitAndLog (OpCodes.Volatile) | Nonvolatile -> () /// Emit the align. prefix @@ -932,12 +921,12 @@ let emitInstrAlign (ilG: ILGenerator) = function /// Emit the tail. prefix if necessary let emitInstrTail (ilG: ILGenerator) tail emitTheCall = match tail with - | Tailcall -> ilG.EmitAndLog(OpCodes.Tailcall); emitTheCall(); ilG.EmitAndLog(OpCodes.Ret) + | Tailcall -> ilG.EmitAndLog (OpCodes.Tailcall); emitTheCall(); ilG.EmitAndLog (OpCodes.Ret) | Normalcall -> emitTheCall() let emitInstrNewobj cenv emEnv (ilG: ILGenerator) mspec varargs = match varargs with - | None -> ilG.EmitAndLog(OpCodes.Newobj, convConstructorSpec cenv emEnv mspec) + | None -> ilG.EmitAndLog (OpCodes.Newobj, convConstructorSpec cenv emEnv mspec) | Some _varargTys -> failwith "emit: pending new varargs" // XXX - gap let emitSilverlightCheck (ilG: ILGenerator) = @@ -954,7 +943,7 @@ let emitInstrCall cenv emEnv (ilG: ILGenerator) opCall tail (mspec: ILMethodSpec else let minfo = convMethodSpec cenv emEnv mspec match varargs with - | None -> ilG.EmitAndLog(opCall, minfo) + | None -> ilG.EmitAndLog (opCall, minfo) | Some varargTys -> ilG.EmitCall (opCall, minfo, convTypesToArray cenv emEnv varargTys) ) @@ -986,47 +975,47 @@ let setArrayMethInfo n ty = let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = match instr with - | AI_add -> ilG.EmitAndLog(OpCodes.Add) - | AI_add_ovf -> ilG.EmitAndLog(OpCodes.Add_Ovf) - | AI_add_ovf_un -> ilG.EmitAndLog(OpCodes.Add_Ovf_Un) - | AI_and -> ilG.EmitAndLog(OpCodes.And) - | AI_div -> ilG.EmitAndLog(OpCodes.Div) - | AI_div_un -> ilG.EmitAndLog(OpCodes.Div_Un) - | AI_ceq -> ilG.EmitAndLog(OpCodes.Ceq) - | AI_cgt -> ilG.EmitAndLog(OpCodes.Cgt) - | AI_cgt_un -> ilG.EmitAndLog(OpCodes.Cgt_Un) - | AI_clt -> ilG.EmitAndLog(OpCodes.Clt) - | AI_clt_un -> ilG.EmitAndLog(OpCodes.Clt_Un) + | AI_add -> ilG.EmitAndLog (OpCodes.Add) + | AI_add_ovf -> ilG.EmitAndLog (OpCodes.Add_Ovf) + | AI_add_ovf_un -> ilG.EmitAndLog (OpCodes.Add_Ovf_Un) + | AI_and -> ilG.EmitAndLog (OpCodes.And) + | AI_div -> ilG.EmitAndLog (OpCodes.Div) + | AI_div_un -> ilG.EmitAndLog (OpCodes.Div_Un) + | AI_ceq -> ilG.EmitAndLog (OpCodes.Ceq) + | AI_cgt -> ilG.EmitAndLog (OpCodes.Cgt) + | AI_cgt_un -> ilG.EmitAndLog (OpCodes.Cgt_Un) + | AI_clt -> ilG.EmitAndLog (OpCodes.Clt) + | AI_clt_un -> ilG.EmitAndLog (OpCodes.Clt_Un) // conversion | AI_conv dt -> match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Conv_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_I8) - | DT_U -> ilG.EmitAndLog(OpCodes.Conv_U) - | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_U4) - | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_U8) - | DT_R -> ilG.EmitAndLog(OpCodes.Conv_R_Un) - | DT_R4 -> ilG.EmitAndLog(OpCodes.Conv_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Conv_R8) + | DT_I -> ilG.EmitAndLog (OpCodes.Conv_I) + | DT_I1 -> ilG.EmitAndLog (OpCodes.Conv_I1) + | DT_I2 -> ilG.EmitAndLog (OpCodes.Conv_I2) + | DT_I4 -> ilG.EmitAndLog (OpCodes.Conv_I4) + | DT_I8 -> ilG.EmitAndLog (OpCodes.Conv_I8) + | DT_U -> ilG.EmitAndLog (OpCodes.Conv_U) + | DT_U1 -> ilG.EmitAndLog (OpCodes.Conv_U1) + | DT_U2 -> ilG.EmitAndLog (OpCodes.Conv_U2) + | DT_U4 -> ilG.EmitAndLog (OpCodes.Conv_U4) + | DT_U8 -> ilG.EmitAndLog (OpCodes.Conv_U8) + | DT_R -> ilG.EmitAndLog (OpCodes.Conv_R_Un) + | DT_R4 -> ilG.EmitAndLog (OpCodes.Conv_R4) + | DT_R8 -> ilG.EmitAndLog (OpCodes.Conv_R8) | DT_REF -> failwith "AI_conv DT_REF?" // XXX - check // conversion - ovf checks | AI_conv_ovf dt -> match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I8) - | DT_U -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U) - | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U4) - | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U8) + | DT_I -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I) + | DT_I1 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I1) + | DT_I2 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I2) + | DT_I4 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I4) + | DT_I8 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I8) + | DT_U -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U) + | DT_U1 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U1) + | DT_U2 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U2) + | DT_U4 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U4) + | DT_U8 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U8) | DT_R -> failwith "AI_conv_ovf DT_R?" // XXX - check | DT_R4 -> failwith "AI_conv_ovf DT_R4?" // XXX - check | DT_R8 -> failwith "AI_conv_ovf DT_R8?" // XXX - check @@ -1034,92 +1023,92 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = // conversion - ovf checks and unsigned | AI_conv_ovf_un dt -> match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I_Un) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I1_Un) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I2_Un) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I4_Un) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I8_Un) - | DT_U -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U_Un) - | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U1_Un) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U2_Un) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U4_Un) - | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U8_Un) + | DT_I -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I_Un) + | DT_I1 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I1_Un) + | DT_I2 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I2_Un) + | DT_I4 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I4_Un) + | DT_I8 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_I8_Un) + | DT_U -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U_Un) + | DT_U1 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U1_Un) + | DT_U2 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U2_Un) + | DT_U4 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U4_Un) + | DT_U8 -> ilG.EmitAndLog (OpCodes.Conv_Ovf_U8_Un) | DT_R -> failwith "AI_conv_ovf_un DT_R?" // XXX - check | DT_R4 -> failwith "AI_conv_ovf_un DT_R4?" // XXX - check | DT_R8 -> failwith "AI_conv_ovf_un DT_R8?" // XXX - check | DT_REF -> failwith "AI_conv_ovf_un DT_REF?" // XXX - check - | AI_mul -> ilG.EmitAndLog(OpCodes.Mul) - | AI_mul_ovf -> ilG.EmitAndLog(OpCodes.Mul_Ovf) - | AI_mul_ovf_un -> ilG.EmitAndLog(OpCodes.Mul_Ovf_Un) - | AI_rem -> ilG.EmitAndLog(OpCodes.Rem) - | AI_rem_un -> ilG.EmitAndLog(OpCodes.Rem_Un) - | AI_shl -> ilG.EmitAndLog(OpCodes.Shl) - | AI_shr -> ilG.EmitAndLog(OpCodes.Shr) - | AI_shr_un -> ilG.EmitAndLog(OpCodes.Shr_Un) - | AI_sub -> ilG.EmitAndLog(OpCodes.Sub) - | AI_sub_ovf -> ilG.EmitAndLog(OpCodes.Sub_Ovf) - | AI_sub_ovf_un -> ilG.EmitAndLog(OpCodes.Sub_Ovf_Un) - | AI_xor -> ilG.EmitAndLog(OpCodes.Xor) - | AI_or -> ilG.EmitAndLog(OpCodes.Or) - | AI_neg -> ilG.EmitAndLog(OpCodes.Neg) - | AI_not -> ilG.EmitAndLog(OpCodes.Not) - | AI_ldnull -> ilG.EmitAndLog(OpCodes.Ldnull) - | AI_dup -> ilG.EmitAndLog(OpCodes.Dup) - | AI_pop -> ilG.EmitAndLog(OpCodes.Pop) - | AI_ckfinite -> ilG.EmitAndLog(OpCodes.Ckfinite) - | AI_nop -> ilG.EmitAndLog(OpCodes.Nop) - | AI_ldc (DT_I4, ILConst.I4 i32) -> ilG.EmitAndLog(OpCodes.Ldc_I4, i32) + | AI_mul -> ilG.EmitAndLog (OpCodes.Mul) + | AI_mul_ovf -> ilG.EmitAndLog (OpCodes.Mul_Ovf) + | AI_mul_ovf_un -> ilG.EmitAndLog (OpCodes.Mul_Ovf_Un) + | AI_rem -> ilG.EmitAndLog (OpCodes.Rem) + | AI_rem_un -> ilG.EmitAndLog (OpCodes.Rem_Un) + | AI_shl -> ilG.EmitAndLog (OpCodes.Shl) + | AI_shr -> ilG.EmitAndLog (OpCodes.Shr) + | AI_shr_un -> ilG.EmitAndLog (OpCodes.Shr_Un) + | AI_sub -> ilG.EmitAndLog (OpCodes.Sub) + | AI_sub_ovf -> ilG.EmitAndLog (OpCodes.Sub_Ovf) + | AI_sub_ovf_un -> ilG.EmitAndLog (OpCodes.Sub_Ovf_Un) + | AI_xor -> ilG.EmitAndLog (OpCodes.Xor) + | AI_or -> ilG.EmitAndLog (OpCodes.Or) + | AI_neg -> ilG.EmitAndLog (OpCodes.Neg) + | AI_not -> ilG.EmitAndLog (OpCodes.Not) + | AI_ldnull -> ilG.EmitAndLog (OpCodes.Ldnull) + | AI_dup -> ilG.EmitAndLog (OpCodes.Dup) + | AI_pop -> ilG.EmitAndLog (OpCodes.Pop) + | AI_ckfinite -> ilG.EmitAndLog (OpCodes.Ckfinite) + | AI_nop -> ilG.EmitAndLog (OpCodes.Nop) + | AI_ldc (DT_I4, ILConst.I4 i32) -> ilG.EmitAndLog (OpCodes.Ldc_I4, i32) | AI_ldc (DT_I8, ILConst.I8 i64) -> ilG.Emit(OpCodes.Ldc_I8, i64) | AI_ldc (DT_R4, ILConst.R4 r32) -> ilG.Emit(OpCodes.Ldc_R4, r32) | AI_ldc (DT_R8, ILConst.R8 r64) -> ilG.Emit(OpCodes.Ldc_R8, r64) | AI_ldc (_, _ ) -> failwith "emitInstrI_arith (AI_ldc (ty, const)) iltyped" - | I_ldarg u16 -> ilG.EmitAndLog(OpCodes.Ldarg, int16 u16) - | I_ldarga u16 -> ilG.EmitAndLog(OpCodes.Ldarga, int16 u16) + | I_ldarg u16 -> ilG.EmitAndLog (OpCodes.Ldarg, int16 u16) + | I_ldarga u16 -> ilG.EmitAndLog (OpCodes.Ldarga, int16 u16) | I_ldind (align, vol, dt) -> emitInstrAlign ilG align emitInstrVolatile ilG vol match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Ldind_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Ldind_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Ldind_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Ldind_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Ldind_I8) + | DT_I -> ilG.EmitAndLog (OpCodes.Ldind_I) + | DT_I1 -> ilG.EmitAndLog (OpCodes.Ldind_I1) + | DT_I2 -> ilG.EmitAndLog (OpCodes.Ldind_I2) + | DT_I4 -> ilG.EmitAndLog (OpCodes.Ldind_I4) + | DT_I8 -> ilG.EmitAndLog (OpCodes.Ldind_I8) | DT_R -> failwith "emitInstr cenv: ldind R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Ldind_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Ldind_R8) + | DT_R4 -> ilG.EmitAndLog (OpCodes.Ldind_R4) + | DT_R8 -> ilG.EmitAndLog (OpCodes.Ldind_R8) | DT_U -> failwith "emitInstr cenv: ldind U" - | DT_U1 -> ilG.EmitAndLog(OpCodes.Ldind_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Ldind_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Ldind_U4) + | DT_U1 -> ilG.EmitAndLog (OpCodes.Ldind_U1) + | DT_U2 -> ilG.EmitAndLog (OpCodes.Ldind_U2) + | DT_U4 -> ilG.EmitAndLog (OpCodes.Ldind_U4) | DT_U8 -> failwith "emitInstr cenv: ldind U8" - | DT_REF -> ilG.EmitAndLog(OpCodes.Ldind_Ref) - | I_ldloc u16 -> ilG.EmitAndLog(OpCodes.Ldloc, int16 u16) - | I_ldloca u16 -> ilG.EmitAndLog(OpCodes.Ldloca, int16 u16) - | I_starg u16 -> ilG.EmitAndLog(OpCodes.Starg, int16 u16) + | DT_REF -> ilG.EmitAndLog (OpCodes.Ldind_Ref) + | I_ldloc u16 -> ilG.EmitAndLog (OpCodes.Ldloc, int16 u16) + | I_ldloca u16 -> ilG.EmitAndLog (OpCodes.Ldloca, int16 u16) + | I_starg u16 -> ilG.EmitAndLog (OpCodes.Starg, int16 u16) | I_stind (align, vol, dt) -> emitInstrAlign ilG align emitInstrVolatile ilG vol match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Stind_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Stind_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Stind_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Stind_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Stind_I8) + | DT_I -> ilG.EmitAndLog (OpCodes.Stind_I) + | DT_I1 -> ilG.EmitAndLog (OpCodes.Stind_I1) + | DT_I2 -> ilG.EmitAndLog (OpCodes.Stind_I2) + | DT_I4 -> ilG.EmitAndLog (OpCodes.Stind_I4) + | DT_I8 -> ilG.EmitAndLog (OpCodes.Stind_I8) | DT_R -> failwith "emitInstr cenv: stind R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Stind_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Stind_R8) - | DT_U -> ilG.EmitAndLog(OpCodes.Stind_I) // NOTE: unsigned -> int conversion - | DT_U1 -> ilG.EmitAndLog(OpCodes.Stind_I1) // NOTE: follows code ilwrite.fs - | DT_U2 -> ilG.EmitAndLog(OpCodes.Stind_I2) // NOTE: is it ok? - | DT_U4 -> ilG.EmitAndLog(OpCodes.Stind_I4) // NOTE: it is generated by bytearray tests - | DT_U8 -> ilG.EmitAndLog(OpCodes.Stind_I8) // NOTE: unsigned -> int conversion - | DT_REF -> ilG.EmitAndLog(OpCodes.Stind_Ref) - | I_stloc u16 -> ilG.EmitAndLog(OpCodes.Stloc, int16 u16) - | I_br targ -> ilG.EmitAndLog(OpCodes.Br, envGetLabel emEnv targ) - | I_jmp mspec -> ilG.EmitAndLog(OpCodes.Jmp, convMethodSpec cenv emEnv mspec) + | DT_R4 -> ilG.EmitAndLog (OpCodes.Stind_R4) + | DT_R8 -> ilG.EmitAndLog (OpCodes.Stind_R8) + | DT_U -> ilG.EmitAndLog (OpCodes.Stind_I) // NOTE: unsigned -> int conversion + | DT_U1 -> ilG.EmitAndLog (OpCodes.Stind_I1) // NOTE: follows code ilwrite.fs + | DT_U2 -> ilG.EmitAndLog (OpCodes.Stind_I2) // NOTE: is it ok? + | DT_U4 -> ilG.EmitAndLog (OpCodes.Stind_I4) // NOTE: it is generated by bytearray tests + | DT_U8 -> ilG.EmitAndLog (OpCodes.Stind_I8) // NOTE: unsigned -> int conversion + | DT_REF -> ilG.EmitAndLog (OpCodes.Stind_Ref) + | I_stloc u16 -> ilG.EmitAndLog (OpCodes.Stloc, int16 u16) + | I_br targ -> ilG.EmitAndLog (OpCodes.Br, envGetLabel emEnv targ) + | I_jmp mspec -> ilG.EmitAndLog (OpCodes.Jmp, convMethodSpec cenv emEnv mspec) | I_brcmp (comp, targ) -> emitInstrCompare emEnv ilG comp targ | I_switch labels -> ilG.Emit(OpCodes.Switch, Array.ofList (List.map (envGetLabel emEnv) labels)) - | I_ret -> ilG.EmitAndLog(OpCodes.Ret) + | I_ret -> ilG.EmitAndLog (OpCodes.Ret) | I_call (tail, mspec, varargs) -> emitSilverlightCheck ilG @@ -1150,54 +1139,54 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = convTypesToArray cenv emEnv varargTys)) | I_ldftn mspec -> - ilG.EmitAndLog(OpCodes.Ldftn, convMethodSpec cenv emEnv mspec) + ilG.EmitAndLog (OpCodes.Ldftn, convMethodSpec cenv emEnv mspec) | I_newobj (mspec, varargs) -> emitInstrNewobj cenv emEnv ilG mspec varargs - | I_throw -> ilG.EmitAndLog(OpCodes.Throw) - | I_endfinally -> ilG.EmitAndLog(OpCodes.Endfinally) - | I_endfilter -> ilG.EmitAndLog(OpCodes.Endfilter) - | I_leave label -> ilG.EmitAndLog(OpCodes.Leave, envGetLabel emEnv label) - | I_ldsfld (vol, fspec) -> emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldsfld, convFieldSpec cenv emEnv fspec) - | I_ldfld (align, vol, fspec) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldfld, convFieldSpec cenv emEnv fspec) - | I_ldsflda fspec -> ilG.EmitAndLog(OpCodes.Ldsflda, convFieldSpec cenv emEnv fspec) - | I_ldflda fspec -> ilG.EmitAndLog(OpCodes.Ldflda, convFieldSpec cenv emEnv fspec) + | I_throw -> ilG.EmitAndLog (OpCodes.Throw) + | I_endfinally -> ilG.EmitAndLog (OpCodes.Endfinally) + | I_endfilter -> ilG.EmitAndLog (OpCodes.Endfilter) + | I_leave label -> ilG.EmitAndLog (OpCodes.Leave, envGetLabel emEnv label) + | I_ldsfld (vol, fspec) -> emitInstrVolatile ilG vol; ilG.EmitAndLog (OpCodes.Ldsfld, convFieldSpec cenv emEnv fspec) + | I_ldfld (align, vol, fspec) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog (OpCodes.Ldfld, convFieldSpec cenv emEnv fspec) + | I_ldsflda fspec -> ilG.EmitAndLog (OpCodes.Ldsflda, convFieldSpec cenv emEnv fspec) + | I_ldflda fspec -> ilG.EmitAndLog (OpCodes.Ldflda, convFieldSpec cenv emEnv fspec) | I_stsfld (vol, fspec) -> emitInstrVolatile ilG vol - ilG.EmitAndLog(OpCodes.Stsfld, convFieldSpec cenv emEnv fspec) + ilG.EmitAndLog (OpCodes.Stsfld, convFieldSpec cenv emEnv fspec) | I_stfld (align, vol, fspec) -> emitInstrAlign ilG align emitInstrVolatile ilG vol - ilG.EmitAndLog(OpCodes.Stfld, convFieldSpec cenv emEnv fspec) - - | I_ldstr s -> ilG.EmitAndLog(OpCodes.Ldstr, s) - | I_isinst ty -> ilG.EmitAndLog(OpCodes.Isinst, convType cenv emEnv ty) - | I_castclass ty -> ilG.EmitAndLog(OpCodes.Castclass, convType cenv emEnv ty) - | I_ldtoken (ILToken.ILType ty) -> ilG.EmitAndLog(OpCodes.Ldtoken, convTypeOrTypeDef cenv emEnv ty) - | I_ldtoken (ILToken.ILMethod mspec) -> ilG.EmitAndLog(OpCodes.Ldtoken, convMethodSpec cenv emEnv mspec) - | I_ldtoken (ILToken.ILField fspec) -> ilG.EmitAndLog(OpCodes.Ldtoken, convFieldSpec cenv emEnv fspec) - | I_ldvirtftn mspec -> ilG.EmitAndLog(OpCodes.Ldvirtftn, convMethodSpec cenv emEnv mspec) + ilG.EmitAndLog (OpCodes.Stfld, convFieldSpec cenv emEnv fspec) + + | I_ldstr s -> ilG.EmitAndLog (OpCodes.Ldstr, s) + | I_isinst ty -> ilG.EmitAndLog (OpCodes.Isinst, convType cenv emEnv ty) + | I_castclass ty -> ilG.EmitAndLog (OpCodes.Castclass, convType cenv emEnv ty) + | I_ldtoken (ILToken.ILType ty) -> ilG.EmitAndLog (OpCodes.Ldtoken, convTypeOrTypeDef cenv emEnv ty) + | I_ldtoken (ILToken.ILMethod mspec) -> ilG.EmitAndLog (OpCodes.Ldtoken, convMethodSpec cenv emEnv mspec) + | I_ldtoken (ILToken.ILField fspec) -> ilG.EmitAndLog (OpCodes.Ldtoken, convFieldSpec cenv emEnv fspec) + | I_ldvirtftn mspec -> ilG.EmitAndLog (OpCodes.Ldvirtftn, convMethodSpec cenv emEnv mspec) // Value type instructions - | I_cpobj ty -> ilG.EmitAndLog(OpCodes.Cpobj, convType cenv emEnv ty) - | I_initobj ty -> ilG.EmitAndLog(OpCodes.Initobj, convType cenv emEnv ty) + | I_cpobj ty -> ilG.EmitAndLog (OpCodes.Cpobj, convType cenv emEnv ty) + | I_initobj ty -> ilG.EmitAndLog (OpCodes.Initobj, convType cenv emEnv ty) | I_ldobj (align, vol, ty) -> emitInstrAlign ilG align emitInstrVolatile ilG vol - ilG.EmitAndLog(OpCodes.Ldobj, convType cenv emEnv ty) + ilG.EmitAndLog (OpCodes.Ldobj, convType cenv emEnv ty) | I_stobj (align, vol, ty) -> emitInstrAlign ilG align emitInstrVolatile ilG vol - ilG.EmitAndLog(OpCodes.Stobj, convType cenv emEnv ty) + ilG.EmitAndLog (OpCodes.Stobj, convType cenv emEnv ty) - | I_box ty -> ilG.EmitAndLog(OpCodes.Box, convType cenv emEnv ty) - | I_unbox ty -> ilG.EmitAndLog(OpCodes.Unbox, convType cenv emEnv ty) - | I_unbox_any ty -> ilG.EmitAndLog(OpCodes.Unbox_Any, convType cenv emEnv ty) - | I_sizeof ty -> ilG.EmitAndLog(OpCodes.Sizeof, convType cenv emEnv ty) + | I_box ty -> ilG.EmitAndLog (OpCodes.Box, convType cenv emEnv ty) + | I_unbox ty -> ilG.EmitAndLog (OpCodes.Unbox, convType cenv emEnv ty) + | I_unbox_any ty -> ilG.EmitAndLog (OpCodes.Unbox_Any, convType cenv emEnv ty) + | I_sizeof ty -> ilG.EmitAndLog (OpCodes.Sizeof, convType cenv emEnv ty) // Generalized array instructions. // In AbsIL these instructions include @@ -1213,51 +1202,51 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = // The IL writer then reverses this when emitting the binary. | I_ldelem dt -> match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Ldelem_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Ldelem_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Ldelem_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Ldelem_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Ldelem_I8) + | DT_I -> ilG.EmitAndLog (OpCodes.Ldelem_I) + | DT_I1 -> ilG.EmitAndLog (OpCodes.Ldelem_I1) + | DT_I2 -> ilG.EmitAndLog (OpCodes.Ldelem_I2) + | DT_I4 -> ilG.EmitAndLog (OpCodes.Ldelem_I4) + | DT_I8 -> ilG.EmitAndLog (OpCodes.Ldelem_I8) | DT_R -> failwith "emitInstr cenv: ldelem R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Ldelem_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Ldelem_R8) + | DT_R4 -> ilG.EmitAndLog (OpCodes.Ldelem_R4) + | DT_R8 -> ilG.EmitAndLog (OpCodes.Ldelem_R8) | DT_U -> failwith "emitInstr cenv: ldelem U" - | DT_U1 -> ilG.EmitAndLog(OpCodes.Ldelem_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Ldelem_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Ldelem_U4) + | DT_U1 -> ilG.EmitAndLog (OpCodes.Ldelem_U1) + | DT_U2 -> ilG.EmitAndLog (OpCodes.Ldelem_U2) + | DT_U4 -> ilG.EmitAndLog (OpCodes.Ldelem_U4) | DT_U8 -> failwith "emitInstr cenv: ldelem U8" - | DT_REF -> ilG.EmitAndLog(OpCodes.Ldelem_Ref) + | DT_REF -> ilG.EmitAndLog (OpCodes.Ldelem_Ref) | I_stelem dt -> match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Stelem_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Stelem_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Stelem_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Stelem_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Stelem_I8) + | DT_I -> ilG.EmitAndLog (OpCodes.Stelem_I) + | DT_I1 -> ilG.EmitAndLog (OpCodes.Stelem_I1) + | DT_I2 -> ilG.EmitAndLog (OpCodes.Stelem_I2) + | DT_I4 -> ilG.EmitAndLog (OpCodes.Stelem_I4) + | DT_I8 -> ilG.EmitAndLog (OpCodes.Stelem_I8) | DT_R -> failwith "emitInstr cenv: stelem R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Stelem_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Stelem_R8) + | DT_R4 -> ilG.EmitAndLog (OpCodes.Stelem_R4) + | DT_R8 -> ilG.EmitAndLog (OpCodes.Stelem_R8) | DT_U -> failwith "emitInstr cenv: stelem U" | DT_U1 -> failwith "emitInstr cenv: stelem U1" | DT_U2 -> failwith "emitInstr cenv: stelem U2" | DT_U4 -> failwith "emitInstr cenv: stelem U4" | DT_U8 -> failwith "emitInstr cenv: stelem U8" - | DT_REF -> ilG.EmitAndLog(OpCodes.Stelem_Ref) + | DT_REF -> ilG.EmitAndLog (OpCodes.Stelem_Ref) | I_ldelema (ro, _isNativePtr, shape, ty) -> - if (ro = ReadonlyAddress) then ilG.EmitAndLog(OpCodes.Readonly) + if (ro = ReadonlyAddress) then ilG.EmitAndLog (OpCodes.Readonly) if (shape = ILArrayShape.SingleDimensional) - then ilG.EmitAndLog(OpCodes.Ldelema, convType cenv emEnv ty) + then ilG.EmitAndLog (OpCodes.Ldelema, convType cenv emEnv ty) else let aty = convType cenv emEnv (ILType.Array(shape, ty)) let ety = aty.GetElementType() let rty = ety.MakeByRefType() - let meth = modB.GetArrayMethodAndLog(aty, "Address", System.Reflection.CallingConventions.HasThis, rty, Array.create shape.Rank (typeof) ) - ilG.EmitAndLog(OpCodes.Call, meth) + let meth = modB.GetArrayMethodAndLog (aty, "Address", System.Reflection.CallingConventions.HasThis, rty, Array.create shape.Rank (typeof) ) + ilG.EmitAndLog (OpCodes.Call, meth) | I_ldelem_any (shape, ty) -> - if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Ldelem, convType cenv emEnv ty) + if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog (OpCodes.Ldelem, convType cenv emEnv ty) else let aty = convType cenv emEnv (ILType.Array(shape, ty)) let ety = aty.GetElementType() @@ -1268,11 +1257,11 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = getArrayMethInfo shape.Rank ety else #endif - modB.GetArrayMethodAndLog(aty, "Get", System.Reflection.CallingConventions.HasThis, ety, Array.create shape.Rank (typeof) ) - ilG.EmitAndLog(OpCodes.Call, meth) + modB.GetArrayMethodAndLog (aty, "Get", System.Reflection.CallingConventions.HasThis, ety, Array.create shape.Rank (typeof) ) + ilG.EmitAndLog (OpCodes.Call, meth) | I_stelem_any (shape, ty) -> - if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Stelem, convType cenv emEnv ty) + if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog (OpCodes.Stelem, convType cenv emEnv ty) else let aty = convType cenv emEnv (ILType.Array(shape, ty)) let ety = aty.GetElementType() @@ -1283,23 +1272,23 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = setArrayMethInfo shape.Rank ety else #endif - modB.GetArrayMethodAndLog(aty, "Set", System.Reflection.CallingConventions.HasThis, (null: Type), Array.append (Array.create shape.Rank (typeof)) (Array.ofList [ ety ])) - ilG.EmitAndLog(OpCodes.Call, meth) + modB.GetArrayMethodAndLog (aty, "Set", System.Reflection.CallingConventions.HasThis, (null: Type), Array.append (Array.create shape.Rank (typeof)) (Array.ofList [ ety ])) + ilG.EmitAndLog (OpCodes.Call, meth) | I_newarr (shape, ty) -> if (shape = ILArrayShape.SingleDimensional) - then ilG.EmitAndLog(OpCodes.Newarr, convType cenv emEnv ty) + then ilG.EmitAndLog (OpCodes.Newarr, convType cenv emEnv ty) else let aty = convType cenv emEnv (ILType.Array(shape, ty)) - let meth = modB.GetArrayMethodAndLog(aty, ".ctor", System.Reflection.CallingConventions.HasThis, (null: Type), Array.create shape.Rank (typeof)) - ilG.EmitAndLog(OpCodes.Newobj, meth) - - | I_ldlen -> ilG.EmitAndLog(OpCodes.Ldlen) - | I_mkrefany ty -> ilG.EmitAndLog(OpCodes.Mkrefany, convType cenv emEnv ty) - | I_refanytype -> ilG.EmitAndLog(OpCodes.Refanytype) - | I_refanyval ty -> ilG.EmitAndLog(OpCodes.Refanyval, convType cenv emEnv ty) - | I_rethrow -> ilG.EmitAndLog(OpCodes.Rethrow) - | I_break -> ilG.EmitAndLog(OpCodes.Break) + let meth = modB.GetArrayMethodAndLog (aty, ".ctor", System.Reflection.CallingConventions.HasThis, (null: Type), Array.create shape.Rank (typeof)) + ilG.EmitAndLog (OpCodes.Newobj, meth) + + | I_ldlen -> ilG.EmitAndLog (OpCodes.Ldlen) + | I_mkrefany ty -> ilG.EmitAndLog (OpCodes.Mkrefany, convType cenv emEnv ty) + | I_refanytype -> ilG.EmitAndLog (OpCodes.Refanytype) + | I_refanyval ty -> ilG.EmitAndLog (OpCodes.Refanyval, convType cenv emEnv ty) + | I_rethrow -> ilG.EmitAndLog (OpCodes.Rethrow) + | I_break -> ilG.EmitAndLog (OpCodes.Break) | I_seqpoint src -> #if FX_RESHAPED_REFEMIT ignore src @@ -1307,21 +1296,21 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = #else if cenv.generatePdb && not (src.Document.File.EndsWithOrdinal("stdin")) then let guid x = match x with None -> Guid.Empty | Some g -> Guid(g: byte[]) in - let symDoc = modB.DefineDocumentAndLog(src.Document.File, guid src.Document.Language, guid src.Document.Vendor, guid src.Document.DocumentType) - ilG.MarkSequencePointAndLog(symDoc, src.Line, src.Column, src.EndLine, src.EndColumn) + let symDoc = modB.DefineDocumentAndLog (src.Document.File, guid src.Document.Language, guid src.Document.Vendor, guid src.Document.DocumentType) + ilG.MarkSequencePointAndLog (symDoc, src.Line, src.Column, src.EndLine, src.EndColumn) #endif - | I_arglist -> ilG.EmitAndLog(OpCodes.Arglist) - | I_localloc -> ilG.EmitAndLog(OpCodes.Localloc) + | I_arglist -> ilG.EmitAndLog (OpCodes.Arglist) + | I_localloc -> ilG.EmitAndLog (OpCodes.Localloc) | I_cpblk (align, vol) -> emitInstrAlign ilG align emitInstrVolatile ilG vol - ilG.EmitAndLog(OpCodes.Cpblk) + ilG.EmitAndLog (OpCodes.Cpblk) | I_initblk (align, vol) -> emitInstrAlign ilG align emitInstrVolatile ilG vol - ilG.EmitAndLog(OpCodes.Initblk) + ilG.EmitAndLog (OpCodes.Initblk) | EI_ldlen_multi (_, m) -> emitInstr cenv modB emEnv ilG (mkLdcInt32 m) @@ -1335,9 +1324,9 @@ let emitCode cenv modB emEnv (ilG: ILGenerator) (code: ILCode) = let pc2lab = Dictionary() let emEnv = (emEnv, code.Labels) ||> Seq.fold (fun emEnv (KeyValue(label, pc)) -> - let lab = ilG.DefineLabelAndLog() + let lab = ilG.DefineLabelAndLog () pc2lab.[pc] <- - match pc2lab.TryGetValue(pc) with + match pc2lab.TryGetValue pc with | true, labels -> lab :: labels | _ -> [lab] envSetLabel emEnv label lab) @@ -1348,14 +1337,14 @@ let emitCode cenv modB emEnv (ilG: ILGenerator) (code: ILCode) = let add lab action = let pc = lab2pc.[lab] pc2action.[pc] <- - match pc2action.TryGetValue(pc) with + match pc2action.TryGetValue pc with | true, actions -> actions @ [action] | _ -> [action] for e in code.Exceptions do let (startTry, _endTry) = e.Range - add startTry (fun () -> ilG.BeginExceptionBlockAndLog() |> ignore) + add startTry (fun () -> ilG.BeginExceptionBlockAndLog () |> ignore) match e.Clause with | ILExceptionClause.Finally(startHandler, endHandler) -> @@ -1379,16 +1368,16 @@ let emitCode cenv modB emEnv (ilG: ILGenerator) (code: ILCode) = let instrs = code.Instrs for pc = 0 to instrs.Length do - match pc2action.TryGetValue(pc) with + match pc2action.TryGetValue pc with | true, actions -> for action in actions do action() | _ -> () - match pc2lab.TryGetValue(pc) with + match pc2lab.TryGetValue pc with | true, labels -> for lab in labels do - ilG.MarkLabelAndLog(lab) + ilG.MarkLabelAndLog lab | _ -> () if pc < instrs.Length then @@ -1399,7 +1388,7 @@ let emitCode cenv modB emEnv (ilG: ILGenerator) (code: ILCode) = let emitLocal cenv emEnv (ilG: ILGenerator) (local: ILLocal) = let ty = convType cenv emEnv local.Type - let locBuilder = ilG.DeclareLocalAndLog(ty, local.IsPinned) + let locBuilder = ilG.DeclareLocalAndLog (ty, local.IsPinned) #if !FX_NO_PDB_WRITER match local.DebugInfo with | Some(nm, start, finish) -> locBuilder.SetLocalSymInfo(nm, start, finish) @@ -1458,7 +1447,7 @@ let buildGenParamsPass1b cenv emEnv (genArgs: Type array) (gps: ILGenericParamet // set base type constraint (match baseTs with [ ] -> () // Q: should a baseType be set? It is in some samples. Should this be a failure case? - | [ baseT ] -> gpB.SetBaseTypeConstraint(baseT) + | [ baseT ] -> gpB.SetBaseTypeConstraint baseT | _ -> failwith "buildGenParam: multiple base types" ) // set interface constraints (interfaces that instances of gp must meet) @@ -1476,7 +1465,7 @@ let buildGenParamsPass1b cenv emEnv (genArgs: Type array) (gps: ILGenericParamet let flags = if gp.HasNotNullableValueTypeConstraint then flags ||| GenericParameterAttributes.NotNullableValueTypeConstraint else flags let flags = if gp.HasDefaultConstructorConstraint then flags ||| GenericParameterAttributes.DefaultConstructorConstraint else flags - gpB.SetGenericParameterAttributes(flags) + gpB.SetGenericParameterAttributes flags ) //---------------------------------------------------------------------------- // emitParameter @@ -1536,7 +1525,7 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) (* p.NoMangle *) let methB = typB.DefinePInvokeMethod(mdef.Name, p.Where.Name, p.Name, attrs, cconv, rty, null, null, argtys, null, null, pcc, pcs) - methB.SetImplementationFlagsAndLog(implflags) + methB.SetImplementationFlagsAndLog implflags envBindMethodRef emEnv mref methB #endif @@ -1544,12 +1533,12 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) match mdef.Name with | ".cctor" | ".ctor" -> - let consB = typB.DefineConstructorAndLog(attrs, cconv, convTypesToArray cenv emEnv mdef.ParameterTypes) - consB.SetImplementationFlagsAndLog(implflags) + let consB = typB.DefineConstructorAndLog (attrs, cconv, convTypesToArray cenv emEnv mdef.ParameterTypes) + consB.SetImplementationFlagsAndLog implflags envBindConsRef emEnv mref consB | _name -> // The return/argument types may involve the generic parameters - let methB = typB.DefineMethodAndLog(mdef.Name, attrs, cconv) + let methB = typB.DefineMethodAndLog (mdef.Name, attrs, cconv) // Method generic type parameters buildGenParamsPass1 emEnv methB.DefineGenericParametersAndLog mdef.GenericParams @@ -1568,10 +1557,10 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) let returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers = mdef.Return |> convReturnModifiers cenv emEnv let returnType = convType cenv emEnv mdef.Return.Type - methB.SetSignatureAndLog(returnType, returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers, parameterTypes, parameterTypeRequiredCustomModifiers,parameterTypeOptionalCustomModifiers) + methB.SetSignatureAndLog (returnType, returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers, parameterTypes, parameterTypeRequiredCustomModifiers,parameterTypeOptionalCustomModifiers) let emEnv = envPopTyvars emEnv - methB.SetImplementationFlagsAndLog(implflags) + methB.SetImplementationFlagsAndLog implflags envBindMethodRef emEnv mref methB @@ -1591,7 +1580,7 @@ let rec buildMethodPass3 cenv tref modB (typB: TypeBuilder) emEnv (mdef: ILMetho // Constructors can not have generic parameters assert isNil mdef.GenericParams // Value parameters - let defineParameter (i, attr, name) = consB.DefineParameterAndLog(i+1, attr, name) + let defineParameter (i, attr, name) = consB.DefineParameterAndLog (i+1, attr, name) mdef.Parameters |> List.iteri (emitParameter cenv emEnv defineParameter) // Body emitMethodBody cenv modB emEnv consB.GetILGenerator mdef.Name mdef.Body @@ -1605,11 +1594,11 @@ let rec buildMethodPass3 cenv tref modB (typB: TypeBuilder) emEnv (mdef: ILMetho (getGenericArgumentsOfMethod methB)) if not (Array.isEmpty mdef.Return.CustomAttrs.AsArray) then - let retB = methB.DefineParameterAndLog(0, System.Reflection.ParameterAttributes.Retval, null) + let retB = methB.DefineParameterAndLog (0, System.Reflection.ParameterAttributes.Retval, null) emitCustomAttrs cenv emEnv (wrapCustomAttr retB.SetCustomAttribute) mdef.Return.CustomAttrs // Value parameters - let defineParameter (i, attr, name) = methB.DefineParameterAndLog(i+1, attr, name) + let defineParameter (i, attr, name) = methB.DefineParameterAndLog (i+1, attr, name) mdef.Parameters |> List.iteri (fun a b -> emitParameter cenv emEnv defineParameter a b) // Body if not isPInvoke then @@ -1629,7 +1618,7 @@ let buildFieldPass2 cenv tref (typB: TypeBuilder) emEnv (fdef: ILFieldDef) = match fdef.Data with | Some d -> typB.DefineInitializedData(fdef.Name, d, attrs) | None -> - typB.DefineFieldAndLog(fdef.Name, fieldT, attrs) + typB.DefineFieldAndLog (fdef.Name, fieldT, attrs) // set default value let emEnv = @@ -1648,7 +1637,7 @@ let buildFieldPass2 cenv tref (typB: TypeBuilder) emEnv (fdef: ILFieldDef) = // => here we cannot detect if underlying type is already set so as a conservative solution we delay initialization of fields // to the end of pass2 (types and members are already created but method bodies are yet not emitted) { emEnv with delayedFieldInits = (fun() -> fieldB.SetConstant(convFieldInit initial))::emEnv.delayedFieldInits } - fdef.Offset |> Option.iter (fun offset -> fieldB.SetOffset(offset)) + fdef.Offset |> Option.iter (fun offset -> fieldB.SetOffset offset) // custom attributes: done on pass 3 as they may reference attribute constructors generated on // pass 2. let fref = mkILFieldRef (tref, fdef.Name, fdef.FieldType) @@ -1667,7 +1656,7 @@ let buildPropertyPass2 cenv tref (typB: TypeBuilder) emEnv (prop: ILPropertyDef) let attrs = flagsIf prop.IsRTSpecialName PropertyAttributes.RTSpecialName ||| flagsIf prop.IsSpecialName PropertyAttributes.SpecialName - let propB = typB.DefinePropertyAndLog(prop.Name, attrs, convType cenv emEnv prop.PropertyType, convTypesToArray cenv emEnv prop.Args) + let propB = typB.DefinePropertyAndLog (prop.Name, attrs, convType cenv emEnv prop.PropertyType, convTypesToArray cenv emEnv prop.Args) prop.SetMethod |> Option.iter (fun mref -> propB.SetSetMethod(envGetMethB emEnv mref)) prop.GetMethod |> Option.iter (fun mref -> propB.SetGetMethod(envGetMethB emEnv mref)) @@ -1691,7 +1680,7 @@ let buildEventPass3 cenv (typB: TypeBuilder) emEnv (eventDef: ILEventDef) = let attrs = flagsIf eventDef.IsSpecialName EventAttributes.SpecialName ||| flagsIf eventDef.IsRTSpecialName EventAttributes.RTSpecialName assert eventDef.EventType.IsSome - let eventB = typB.DefineEventAndLog(eventDef.Name, attrs, convType cenv emEnv eventDef.EventType.Value) + let eventB = typB.DefineEventAndLog (eventDef.Name, attrs, convType cenv emEnv eventDef.EventType.Value) eventDef.AddMethod |> (fun mref -> eventB.SetAddOnMethod(envGetMethB emEnv mref)) eventDef.RemoveMethod |> (fun mref -> eventB.SetRemoveOnMethod(envGetMethB emEnv mref)) @@ -1789,7 +1778,7 @@ let rec buildTypeDefPass1 cenv emEnv (modB: ModuleBuilder) rootTypeBuilder nesti // Q: would it be ok to use typB :> Type ? // Maybe not, recall TypeBuilder maybe subtype of Type, but it is not THE Type. let nameInModule = tref.QualifiedName - modB.GetTypeAndLog(nameInModule, false, false) + modB.GetTypeAndLog (nameInModule, false, false) let emEnv = envBindTypeRef emEnv tref (typT, typB, tdef) // recurse on nested types @@ -1811,7 +1800,7 @@ let rec buildTypeDefPass1b cenv nesting emEnv (tdef: ILTypeDef) = let genArgs = getGenericArgumentsOfType (typB.AsType()) let emEnv = envPushTyvars emEnv genArgs // Parent may reference types being defined, so has to come after it's Pass1 creation - tdef.Extends |> Option.iter (fun ty -> typB.SetParentAndLog(convType cenv emEnv ty)) + tdef.Extends |> Option.iter (fun ty -> typB.SetParentAndLog (convType cenv emEnv ty)) // build constraints on ILGenericParameterDefs. Constraints may reference types being defined, // so have to come after all types are created buildGenParamsPass1b cenv emEnv genArgs tdef.GenericParams @@ -1828,7 +1817,7 @@ let rec buildTypeDefPass2 cenv nesting emEnv (tdef: ILTypeDef) = let typB = envGetTypB emEnv tref let emEnv = envPushTyvars emEnv (getGenericArgumentsOfType (typB.AsType())) // add interface impls - tdef.Implements |> convTypes cenv emEnv |> List.iter (fun implT -> typB.AddInterfaceImplementationAndLog(implT)) + tdef.Implements |> convTypes cenv emEnv |> List.iter (fun implT -> typB.AddInterfaceImplementationAndLog implT) // add methods, properties let emEnv = Array.fold (buildMethodPass2 cenv tref typB) emEnv tdef.Methods.AsArray let emEnv = List.fold (buildFieldPass2 cenv tref typB) emEnv tdef.Fields.AsList @@ -1975,7 +1964,7 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t if verbose2 then dprintf "- considering reference to type %s\n" typB.FullName // Re-run traverseTypeDef if we've never visited the type. - if not (visited.ContainsKey(tref)) then + if not (visited.ContainsKey tref) then visited.[tref] <- true let tdef = envGetTypeDef emEnv tref if verbose2 then dprintf "- traversing type %s\n" typB.FullName @@ -1994,7 +1983,7 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t match emEnv.emTypMap.TryFind typeRef with | Some(_, tb, _, _) -> if not (tb.IsCreated()) then - tb.CreateTypeAndLog() |> ignore + tb.CreateTypeAndLog () |> ignore tb.Assembly | None -> null ) @@ -2008,10 +1997,10 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t #endif // At this point, we've done everything we can to prepare the type for loading by eagerly forcing the // load of other types. Everything else is up to the implementation of System.Reflection.Emit. - if not (created.ContainsKey(tref)) then + if not (created.ContainsKey tref) then created.[tref] <- true if verbose2 then dprintf "- creating type %s\n" typB.FullName - typB.CreateTypeAndLog() |> ignore + typB.CreateTypeAndLog () |> ignore traverseTypeRef tref @@ -2067,11 +2056,11 @@ let buildModuleFragment cenv emEnv (asmB: AssemblyBuilder) (modB: ModuleBuilder) match r.Location with | ILResourceLocation.LocalIn (file, start, len) -> let bytes = FileSystem.ReadAllBytesShim(file).[start .. start + len - 1] - modB.DefineManifestResourceAndLog(r.Name, new System.IO.MemoryStream(bytes), attribs) + modB.DefineManifestResourceAndLog (r.Name, new MemoryStream(bytes), attribs) | ILResourceLocation.LocalOut bytes -> - modB.DefineManifestResourceAndLog(r.Name, new System.IO.MemoryStream(bytes), attribs) + modB.DefineManifestResourceAndLog (r.Name, new MemoryStream(bytes), attribs) | ILResourceLocation.File (mr, _) -> - asmB.AddResourceFileAndLog(r.Name, mr.Name, attribs) + asmB.AddResourceFileAndLog (r.Name, mr.Name, attribs) | ILResourceLocation.Assembly _ -> failwith "references to resources other assemblies may not be emitted using System.Reflection") #endif @@ -2080,7 +2069,7 @@ let buildModuleFragment cenv emEnv (asmB: AssemblyBuilder) (modB: ModuleBuilder) //---------------------------------------------------------------------------- // test hook //---------------------------------------------------------------------------- -let defineDynamicAssemblyAndLog(asmName, flags, asmDir: string) = +let defineDynamicAssemblyAndLog (asmName, flags, asmDir: string) = #if FX_NO_APP_DOMAINS let asmB = AssemblyBuilder.DefineDynamicAssembly(asmName, flags) #else @@ -2106,14 +2095,14 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) #else else AssemblyBuilderAccess.RunAndSave #endif - let asmB = defineDynamicAssemblyAndLog(asmName, asmAccess, asmDir) + let asmB = defineDynamicAssemblyAndLog (asmName, asmAccess, asmDir) if not optimize then let daType = typeof let daCtor = daType.GetConstructor [| typeof |] let daBuilder = new CustomAttributeBuilder(daCtor, [| System.Diagnostics.DebuggableAttribute.DebuggingModes.DisableOptimizations ||| System.Diagnostics.DebuggableAttribute.DebuggingModes.Default |]) - asmB.SetCustomAttributeAndLog(daBuilder) + asmB.SetCustomAttributeAndLog daBuilder - let modB = asmB.DefineDynamicModuleAndLog(assemblyName, filename, debugInfo) + let modB = asmB.DefineDynamicModuleAndLog (assemblyName, filename, debugInfo) asmB, modB let emitModuleFragment (ilg, emEnv, asmB: AssemblyBuilder, modB: ModuleBuilder, modul: IL.ILModuleDef, debugInfo: bool, resolveAssemblyRef, tryFindSysILTypeRef) = @@ -2128,7 +2117,7 @@ let emitModuleFragment (ilg, emEnv, asmB: AssemblyBuilder, modB: ModuleBuilder, // invoke entry point methods let execEntryPtFun ((typB: TypeBuilder), methodName) () = try - ignore (typB.InvokeMemberAndLog(methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static, [| |])) + ignore (typB.InvokeMemberAndLog (methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static, [| |])) None with | :? System.Reflection.TargetInvocationException as e -> diff --git a/src/absil/ilsign.fs b/src/absil/ilsign.fs index 6b51af598..6fbc1ca45 100644 --- a/src/absil/ilsign.fs +++ b/src/absil/ilsign.fs @@ -11,43 +11,43 @@ open System.Reflection.PortableExecutable open System.Security.Cryptography open System.Runtime.InteropServices - type KeyType = + type KeyType = | Public | KeyPair let ALG_TYPE_RSA = int (2 <<< 9) let ALG_CLASS_KEY_EXCHANGE = int (5 <<< 13) - let ALG_CLASS_SIGNATURE = int(1 <<< 13) - let CALG_RSA_KEYX = int(ALG_CLASS_KEY_EXCHANGE ||| ALG_TYPE_RSA) - let CALG_RSA_SIGN = int(ALG_CLASS_SIGNATURE ||| ALG_TYPE_RSA) - - let ALG_CLASS_HASH = int(4 <<< 13) - let ALG_TYPE_ANY = int(0) - let CALG_SHA1 = int(ALG_CLASS_HASH ||| ALG_TYPE_ANY ||| 4) - let CALG_SHA_256 = int(ALG_CLASS_HASH ||| ALG_TYPE_ANY ||| 12) - let CALG_SHA_384 = int(ALG_CLASS_HASH ||| ALG_TYPE_ANY ||| 13) - let CALG_SHA_512 = int(ALG_CLASS_HASH ||| ALG_TYPE_ANY ||| 14) - - let PUBLICKEYBLOB = int(0x6) - let PRIVATEKEYBLOB = int(0x7) - let BLOBHEADER_CURRENT_BVERSION = int(0x2) - let BLOBHEADER_LENGTH = int(20) - let RSA_PUB_MAGIC = int(0x31415352) - let RSA_PRIV_MAGIC = int(0x32415352) + let ALG_CLASS_SIGNATURE = int (1 <<< 13) + let CALG_RSA_KEYX = int (ALG_CLASS_KEY_EXCHANGE ||| ALG_TYPE_RSA) + let CALG_RSA_SIGN = int (ALG_CLASS_SIGNATURE ||| ALG_TYPE_RSA) + + let ALG_CLASS_HASH = int (4 <<< 13) + let ALG_TYPE_ANY = int 0 + let CALG_SHA1 = int (ALG_CLASS_HASH ||| ALG_TYPE_ANY ||| 4) + let CALG_SHA_256 = int (ALG_CLASS_HASH ||| ALG_TYPE_ANY ||| 12) + let CALG_SHA_384 = int (ALG_CLASS_HASH ||| ALG_TYPE_ANY ||| 13) + let CALG_SHA_512 = int (ALG_CLASS_HASH ||| ALG_TYPE_ANY ||| 14) + + let PUBLICKEYBLOB = int 0x6 + let PRIVATEKEYBLOB = int 0x7 + let BLOBHEADER_CURRENT_BVERSION = int 0x2 + let BLOBHEADER_LENGTH = int 20 + let RSA_PUB_MAGIC = int 0x31415352 + let RSA_PRIV_MAGIC = int 0x32415352 let getResourceString (_, str) = str - [] - type ByteArrayUnion = - struct - [] - val UnderlyingArray: byte[] + [] + type ByteArrayUnion = + [] + val UnderlyingArray: byte[] - []val ImmutableArray: ImmutableArray - new (immutableArray:ImmutableArray) = { UnderlyingArray = Array.empty; ImmutableArray = immutableArray} - end + [] + val ImmutableArray: ImmutableArray - let getUnderlyingArray (array:ImmutableArray) =ByteArrayUnion(array).UnderlyingArray + new (immutableArray: ImmutableArray) = { UnderlyingArray = Array.empty; ImmutableArray = immutableArray} + + let getUnderlyingArray (array: ImmutableArray) =ByteArrayUnion(array).UnderlyingArray // Compute a hash over the elements of an assembly manifest file that should // remain static (skip checksum, Authenticode signatures and strong name signature blob) @@ -64,8 +64,8 @@ open System.Runtime.InteropServices | PEMagic.PE32Plus -> peHeaderOffset + 0x90,0xF0 // offsetof(IMAGE_OPTIONAL_HEADER64, DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY]), sizeof(IMAGE_OPTIONAL_HEADER64) | _ -> raise (BadImageFormatException(getResourceString(FSComp.SR.ilSignInvalidMagicValue()))) - let allHeadersSize = peHeaderOffset + peHeaderSize + int(peHeaders.CoffHeader.NumberOfSections) * 0x28; // sizeof(IMAGE_SECTION_HEADER) - let allHeaders = + let allHeadersSize = peHeaderOffset + peHeaderSize + int (peHeaders.CoffHeader.NumberOfSections) * 0x28; // sizeof(IMAGE_SECTION_HEADER) + let allHeaders = let array:byte[] = Array.zeroCreate allHeadersSize peReader.GetEntireImage().GetContent().CopyTo(0, array, 0, allHeadersSize) array @@ -78,7 +78,7 @@ open System.Runtime.InteropServices // Hash content of all sections let signatureDirectory = peHeaders.CorHeader.StrongNameSignatureDirectory let signatureStart = - match peHeaders.TryGetDirectoryOffset(signatureDirectory) with + match peHeaders.TryGetDirectoryOffset signatureDirectory with | true, value -> value | _ -> raise (BadImageFormatException(getResourceString(FSComp.SR.ilSignBadImageFormat()))) let signatureEnd = signatureStart + signatureDirectory.Size @@ -104,7 +104,7 @@ open System.Runtime.InteropServices () hashAlgorithm.GetHashAndReset() - type BlobReader = + type BlobReader = val mutable _blob:byte[] val mutable _offset:int new (blob:byte[]) = { _blob = blob; _offset = 0; } @@ -112,7 +112,7 @@ open System.Runtime.InteropServices member x.ReadInt32:int = let offset = x._offset x._offset <- offset + 4 - int(x._blob.[offset]) ||| (int (x._blob.[offset + 1]) <<< 8) ||| (int (x._blob.[offset + 2]) <<< 16) ||| (int (x._blob.[offset + 3]) <<< 24) + int (x._blob.[offset]) ||| (int (x._blob.[offset + 1]) <<< 8) ||| (int (x._blob.[offset + 2]) <<< 16) ||| (int (x._blob.[offset + 3]) <<< 24) member x.ReadBigInteger (length:int):byte[] = let arr:byte[] = Array.zeroCreate length @@ -121,35 +121,35 @@ open System.Runtime.InteropServices arr |> Array.rev let RSAParamatersFromBlob (blob:byte[]) keyType = - let mutable reader = BlobReader(blob) + let mutable reader = BlobReader blob if reader.ReadInt32 <> 0x00000207 && keyType = KeyType.KeyPair then raise (CryptographicException(getResourceString(FSComp.SR.ilSignPrivateKeyExpected()))) reader.ReadInt32 |>ignore // ALG_ID if reader.ReadInt32 <> RSA_PRIV_MAGIC then raise (CryptographicException(getResourceString(FSComp.SR.ilSignRsaKeyExpected()))) // 'RSA2' - let byteLen, halfLen = + let byteLen, halfLen = let bitLen = reader.ReadInt32 match bitLen % 16 with | 0 -> (bitLen / 8, bitLen / 16) | _ -> raise (CryptographicException(getResourceString(FSComp.SR.ilSignInvalidBitLen()))) let mutable key = RSAParameters() - key.Exponent <- reader.ReadBigInteger(4) - key.Modulus <- reader.ReadBigInteger(byteLen) - key.P <- reader.ReadBigInteger(halfLen) - key.Q <- reader.ReadBigInteger(halfLen) - key.DP <- reader.ReadBigInteger(halfLen) - key.DQ <- reader.ReadBigInteger(halfLen) - key.InverseQ <- reader.ReadBigInteger(halfLen) - key.D <- reader.ReadBigInteger(byteLen) + key.Exponent <- reader.ReadBigInteger 4 + key.Modulus <- reader.ReadBigInteger byteLen + key.P <- reader.ReadBigInteger halfLen + key.Q <- reader.ReadBigInteger halfLen + key.DP <- reader.ReadBigInteger halfLen + key.DQ <- reader.ReadBigInteger halfLen + key.InverseQ <- reader.ReadBigInteger halfLen + key.D <- reader.ReadBigInteger byteLen key - let toCLRKeyBlob (rsaParameters:RSAParameters) (algId:int) : byte[] = + let toCLRKeyBlob (rsaParameters:RSAParameters) (algId:int) : byte[] = let validateRSAField (field:byte[]) expected (name:string) = - if field <> null && field.Length <> expected then + if field <> null && field.Length <> expected then raise (CryptographicException(String.Format(getResourceString(FSComp.SR.ilSignInvalidRSAParams()), name))) - // The original FCall this helper emulates supports other algId's - however, the only algid we need to support is CALG_RSA_KEYX. We will not port the codepaths dealing with other algid's. + // The original FCall this helper emulates supports other algId's - however, the only algid we need to support is CALG_RSA_KEYX. We will not port the codepaths dealing with other algid's. if algId <> CALG_RSA_KEYX then raise (CryptographicException(getResourceString(FSComp.SR.ilSignInvalidAlgId()))) - // Validate the RSA structure first. + // Validate the RSA structure first. if rsaParameters.Modulus = null then raise (CryptographicException(String.Format(getResourceString(FSComp.SR.ilSignInvalidRSAParams()), "Modulus"))) if rsaParameters.Exponent = null || rsaParameters.Exponent.Length > 4 then raise (CryptographicException(String.Format(getResourceString(FSComp.SR.ilSignInvalidRSAParams()), "Exponent"))) @@ -159,11 +159,11 @@ open System.Runtime.InteropServices // We assume that if P != null, then so are Q, DP, DQ, InverseQ and D and indicate KeyPair RSA Parameters let isPrivate = if rsaParameters.P <> null then - validateRSAField (rsaParameters.P) halfModulusLength "P" - validateRSAField (rsaParameters.Q) halfModulusLength "Q" - validateRSAField (rsaParameters.DP) halfModulusLength "DP" - validateRSAField (rsaParameters.InverseQ) halfModulusLength "InverseQ" - validateRSAField (rsaParameters.D) halfModulusLength "D" + validateRSAField rsaParameters.P halfModulusLength "P" + validateRSAField rsaParameters.Q halfModulusLength "Q" + validateRSAField rsaParameters.DP halfModulusLength "DP" + validateRSAField rsaParameters.InverseQ halfModulusLength "InverseQ" + validateRSAField rsaParameters.D halfModulusLength "D" true else false @@ -171,33 +171,33 @@ open System.Runtime.InteropServices use ms = new MemoryStream() use bw = new BinaryWriter(ms) - bw.Write(int(CALG_RSA_SIGN)) // CLRHeader.aiKeyAlg - bw.Write(int(CALG_SHA1)) // CLRHeader.aiHashAlg - bw.Write(int(modulusLength + BLOBHEADER_LENGTH)) // CLRHeader.KeyLength + bw.Write(int CALG_RSA_SIGN) // CLRHeader.aiKeyAlg + bw.Write(int CALG_SHA1) // CLRHeader.aiHashAlg + bw.Write(int (modulusLength + BLOBHEADER_LENGTH)) // CLRHeader.KeyLength - // Write out the BLOBHEADER - bw.Write(byte(if isPrivate = true then PRIVATEKEYBLOB else PUBLICKEYBLOB)) // BLOBHEADER.bType - bw.Write(byte(BLOBHEADER_CURRENT_BVERSION)) // BLOBHEADER.bVersion - bw.Write(int16(0)) // BLOBHEADER.wReserved - bw.Write(int(CALG_RSA_SIGN)) // BLOBHEADER.aiKeyAlg + // Write out the BLOBHEADER + bw.Write(byte (if isPrivate = true then PRIVATEKEYBLOB else PUBLICKEYBLOB)) // BLOBHEADER.bType + bw.Write(byte BLOBHEADER_CURRENT_BVERSION) // BLOBHEADER.bVersion + bw.Write(int16 0) // BLOBHEADER.wReserved + bw.Write(int CALG_RSA_SIGN) // BLOBHEADER.aiKeyAlg - // Write the RSAPubKey header - bw.Write(int(if isPrivate then RSA_PRIV_MAGIC else RSA_PUB_MAGIC)) // RSAPubKey.magic - bw.Write(int(modulusLength * 8)) // RSAPubKey.bitLen + // Write the RSAPubKey header + bw.Write(int (if isPrivate then RSA_PRIV_MAGIC else RSA_PUB_MAGIC)) // RSAPubKey.magic + bw.Write(int (modulusLength * 8)) // RSAPubKey.bitLen let expAsDword = - let mutable buffer = int(0) + let mutable buffer = int 0 for i in 0 .. rsaParameters.Exponent.Length - 1 do - buffer <- (buffer <<< 8) ||| int(rsaParameters.Exponent.[i]) + buffer <- (buffer <<< 8) ||| int (rsaParameters.Exponent.[i]) buffer - bw.Write(expAsDword) // RSAPubKey.pubExp - bw.Write(rsaParameters.Modulus |> Array.rev) // Copy over the modulus for both public and private + bw.Write expAsDword // RSAPubKey.pubExp + bw.Write(rsaParameters.Modulus |> Array.rev) // Copy over the modulus for both public and private if isPrivate = true then do bw.Write(rsaParameters.P |> Array.rev) - bw.Write(rsaParameters.Q |> Array.rev) - bw.Write(rsaParameters.DP |> Array.rev) - bw.Write(rsaParameters.DQ |> Array.rev) + bw.Write(rsaParameters.Q |> Array.rev) + bw.Write(rsaParameters.DP |> Array.rev) + bw.Write(rsaParameters.DQ |> Array.rev) bw.Write(rsaParameters.InverseQ |> Array.rev) bw.Write(rsaParameters.D |> Array.rev) @@ -216,15 +216,15 @@ open System.Runtime.InteropServices let signatureDirectory = peHeaders.CorHeader.StrongNameSignatureDirectory let signatureOffset = if signatureDirectory.Size > signature.Length then raise (BadImageFormatException(getResourceString(FSComp.SR.ilSignInvalidSignatureSize()))) - match peHeaders.TryGetDirectoryOffset(signatureDirectory) with - | false, _ -> raise (BadImageFormatException(getResourceString(FSComp.SR.ilSignNoSignatureDirectory()))) - | true, signatureOffset -> int64(signatureOffset) + match peHeaders.TryGetDirectoryOffset signatureDirectory with + | false, _ -> raise (BadImageFormatException(getResourceString(FSComp.SR.ilSignNoSignatureDirectory()))) + | true, signatureOffset -> int64 signatureOffset stream.Seek(signatureOffset, SeekOrigin.Begin) |>ignore stream.Write(signature, 0, signature.Length) let corHeaderFlagsOffset = int64(peHeaders.CorHeaderStartOffset + 16) // offsetof(IMAGE_COR20_HEADER, Flags) stream.Seek(corHeaderFlagsOffset, SeekOrigin.Begin) |>ignore - stream.WriteByte((byte)(peHeaders.CorHeader.Flags ||| CorFlags.StrongNameSigned)) + stream.WriteByte (byte (peHeaders.CorHeader.Flags ||| CorFlags.StrongNameSigned)) () let signStream stream keyBlob = @@ -241,11 +241,11 @@ open System.Runtime.InteropServices let signatureSize (pk:byte[]) = if pk.Length < 25 then raise (CryptographicException(getResourceString(FSComp.SR.ilSignInvalidPKBlob()))) - let mutable reader = BlobReader(pk) - reader.ReadBigInteger(12) |> ignore // Skip CLRHeader - reader.ReadBigInteger(8) |> ignore // Skip BlobHeader + let mutable reader = BlobReader pk + reader.ReadBigInteger 12 |> ignore // Skip CLRHeader + reader.ReadBigInteger 8 |> ignore // Skip BlobHeader let magic = reader.ReadInt32 // Read magic - if not (magic = RSA_PRIV_MAGIC || magic = RSA_PUB_MAGIC) then // RSAPubKey.magic + if not (magic = RSA_PRIV_MAGIC || magic = RSA_PUB_MAGIC) then // RSAPubKey.magic raise (CryptographicException(getResourceString(FSComp.SR.ilSignInvalidPKBlob()))) let x = reader.ReadInt32 / 8 x @@ -254,5 +254,5 @@ open System.Runtime.InteropServices let getPublicKeyForKeyPair keyBlob = use rsa = RSA.Create() rsa.ImportParameters(RSAParamatersFromBlob keyBlob KeyType.KeyPair) - let rsaParameters = rsa.ExportParameters(false) + let rsaParameters = rsa.ExportParameters false toCLRKeyBlob rsaParameters CALG_RSA_KEYX diff --git a/src/absil/ilsupp.fs b/src/absil/ilsupp.fs index 5f9932662..e77519f43 100644 --- a/src/absil/ilsupp.fs +++ b/src/absil/ilsupp.fs @@ -2,10 +2,6 @@ module internal FSharp.Compiler.AbstractIL.Internal.Support - -let DateTime1970Jan01 = new System.DateTime(1970,1,1,0,0,0,System.DateTimeKind.Utc) (* ECMA Spec (Oct2002), Part II, 24.2.2 PE File Header. *) -let absilWriteGetTimeStamp () = (System.DateTime.UtcNow - DateTime1970Jan01).TotalSeconds |> int - open Internal.Utilities open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.Internal @@ -26,6 +22,9 @@ open System.Diagnostics.SymbolStore open System.Runtime.InteropServices open System.Runtime.CompilerServices +let DateTime1970Jan01 = new DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) (* ECMA Spec (Oct2002), Part II, 24.2.2 PE File Header. *) +let absilWriteGetTimeStamp () = (DateTime.UtcNow - DateTime1970Jan01).TotalSeconds |> int + #if !FX_NO_LINKEDRESOURCES // Force inline, so GetLastWin32Error calls are immediately after interop calls as seen by FxCop under Debug build. let inline ignore _x = () @@ -34,26 +33,28 @@ let inline ignore _x = () type IStream = System.Runtime.InteropServices.ComTypes.IStream #endif -let check _action (hresult) = - if uint32 hresult >= 0x80000000ul then - System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(hresult) +let check _action (hresult) = + if uint32 hresult >= 0x80000000ul then + System.Runtime.InteropServices.Marshal.ThrowExceptionForHR hresult //printf "action = %s, hresult = 0x%nx \n" action hresult - + type PEFileType = X86 | X64 let MAX_PATH = 260 let E_FAIL = 0x80004005 -let bytesToWord ((b0: byte), (b1: byte)) = - (int16)b0 ||| ((int16)b1 <<< 8) -let bytesToDWord ((b0: byte), (b1: byte), (b2: byte), (b3: byte)) = - (int)b0 ||| ((int)b1 <<< 8) ||| ((int)b2 <<< 16) ||| ((int)b3 <<< 24) +let bytesToWord ((b0: byte), (b1: byte)) = + int16 b0 ||| (int16 b1 <<< 8) + +let bytesToDWord ((b0: byte), (b1: byte), (b2: byte), (b3: byte)) = + int b0 ||| (int b1 <<< 8) ||| (int b2 <<< 16) ||| (int b3 <<< 24) + let bytesToQWord ((b0: byte), (b1: byte), (b2: byte), (b3: byte), (b4: byte), (b5: byte), (b6: byte), (b7: byte)) = - (int64)b0 ||| ((int64)b1 <<< 8) ||| ((int64)b2 <<< 16) ||| ((int64)b3 <<< 24) ||| ((int64)b4 <<< 32) ||| ((int64)b5 <<< 40) ||| ((int64)b6 <<< 48) ||| ((int64)b7 <<< 56) - -let dwToBytes n = [| (byte)(n &&& 0xff) ; (byte)((n >>> 8) &&& 0xff) ; (byte)((n >>> 16) &&& 0xff) ; (byte)((n >>> 24) &&& 0xff) |], 4 -let wToBytes (n: int16) = [| (byte)(n &&& 0xffs) ; (byte)((n >>> 8) &&& 0xffs) |], 2 + int64 b0 ||| (int64 b1 <<< 8) ||| (int64 b2 <<< 16) ||| (int64 b3 <<< 24) ||| (int64 b4 <<< 32) ||| (int64 b5 <<< 40) ||| (int64 b6 <<< 48) ||| (int64 b7 <<< 56) + +let dwToBytes n = [| byte (n &&& 0xff) ; byte ((n >>> 8) &&& 0xff) ; byte ((n >>> 16) &&& 0xff) ; byte ((n >>> 24) &&& 0xff) |], 4 +let wToBytes (n: int16) = [| byte (n &&& 0xffs) ; byte ((n >>> 8) &&& 0xffs) |], 2 #if !FX_NO_LINKEDRESOURCES // REVIEW: factor these classes under one hierarchy, use reflection for creation from buffer and toBytes() @@ -66,47 +67,47 @@ type IMAGE_FILE_HEADER (m: int16, secs: int16, tds: int32, ptst: int32, nos: int let mutable numberOfSymbols = nos let mutable sizeOfOptionalHeader = soh let mutable characteristics = c - + member x.Machine with get() = machine - and set(value) = machine <- value - + and set value = machine <- value + member x.NumberOfSections with get() = numberOfSections - and set(value) = numberOfSections <- value - + and set value = numberOfSections <- value + member x.TimeDateStamp with get() = timeDateStamp - and set(value) = timeDateStamp <- value - + and set value = timeDateStamp <- value + member x.PointerToSymbolTable with get() = pointerToSymbolTable - and set(value) = pointerToSymbolTable <- value - + and set value = pointerToSymbolTable <- value + member x.NumberOfSymbols with get() = numberOfSymbols - and set(value) = numberOfSymbols <- value - - member x.SizeOfOptionalHeader + and set value = numberOfSymbols <- value + + member x.SizeOfOptionalHeader with get() = sizeOfOptionalHeader - and set(value) = sizeOfOptionalHeader <- value - + and set value = sizeOfOptionalHeader <- value + member x.Characteristics with get() = characteristics - and set(value) = characteristics <- value - - static member Width + and set value = characteristics <- value + + static member Width with get() = 20 - + member x.toBytes () = let buf = ByteBuffer.Create IMAGE_FILE_HEADER.Width - buf.EmitUInt16 ((uint16)machine) - buf.EmitUInt16 ((uint16)numberOfSections) + buf.EmitUInt16 (uint16 machine) + buf.EmitUInt16 (uint16 numberOfSections) buf.EmitInt32 timeDateStamp buf.EmitInt32 pointerToSymbolTable buf.EmitInt32 numberOfSymbols - buf.EmitUInt16 ((uint16)sizeOfOptionalHeader) - buf.EmitUInt16 ((uint16)characteristics) + buf.EmitUInt16 (uint16 sizeOfOptionalHeader) + buf.EmitUInt16 (uint16 characteristics) buf.Close() let bytesToIFH (buffer: byte[]) (offset: int) = @@ -131,54 +132,54 @@ type IMAGE_SECTION_HEADER(n: int64, ai: int32, va: int32, srd: int32, prd: int32 let mutable numberOfRelocations = nr let mutable numberOfLineNumbers = nl let mutable characteristics = c - + member x.Name with get() = name - and set(value) = name <- value - + and set value = name <- value + member x.PhysicalAddress with get() = addressInfo - and set(value) = addressInfo <- value - + and set value = addressInfo <- value + member x.VirtualSize with get() = addressInfo - and set(value) = addressInfo <- value - + and set value = addressInfo <- value + member x.VirtualAddress with get() = virtualAddress - and set(value) = virtualAddress <- value - + and set value = virtualAddress <- value + member x.SizeOfRawData with get() = sizeOfRawData - and set(value) = sizeOfRawData <- value - + and set value = sizeOfRawData <- value + member x.PointerToRawData with get() = pointerToRawData - and set(value) = pointerToRawData <- value - + and set value = pointerToRawData <- value + member x.PointerToRelocations with get() = pointerToRelocations - and set(value) = pointerToRelocations <- value - + and set value = pointerToRelocations <- value + member x.PointerToLineNumbers with get() = pointerToLineNumbers - and set(value) = pointerToLineNumbers <- value - + and set value = pointerToLineNumbers <- value + member x.NumberOfRelocations with get() = numberOfRelocations - and set(value) = numberOfRelocations <- value - + and set value = numberOfRelocations <- value + member x.NumberOfLineNumbers with get() = numberOfLineNumbers - and set(value) = numberOfLineNumbers <- value - + and set value = numberOfLineNumbers <- value + member x.Characteristics with get() = characteristics - and set(value) = characteristics <- value - - static member Width + and set value = characteristics <- value + + static member Width with get() = 40 - + member x.toBytes () = let buf = ByteBuffer.Create IMAGE_SECTION_HEADER.Width buf.EmitInt64 name @@ -188,11 +189,11 @@ type IMAGE_SECTION_HEADER(n: int64, ai: int32, va: int32, srd: int32, prd: int32 buf.EmitInt32 pointerToRawData buf.EmitInt32 pointerToRelocations buf.EmitInt32 pointerToLineNumbers - buf.EmitUInt16 ((uint16)numberOfRelocations) - buf.EmitUInt16 ((uint16)numberOfLineNumbers) + buf.EmitUInt16 (uint16 numberOfRelocations) + buf.EmitUInt16 (uint16 numberOfLineNumbers) buf.EmitInt32 characteristics buf.Close() - + let bytesToISH (buffer: byte[]) (offset: int) = if (buffer.Length - offset) < IMAGE_SECTION_HEADER.Width then @@ -215,40 +216,40 @@ type IMAGE_SYMBOL(n: int64, v: int32, sn: int16, t: int16, sc: byte, nas: byte) let mutable stype = t let mutable storageClass = sc let mutable numberOfAuxSymbols = nas - + member x.Name with get() = name - and set(v) = name <- v - + and set v = name <- v + member x.Value with get() = value - and set(v) = value <- v - + and set v = value <- v + member x.SectionNumber with get() = sectionNumber - and set(v) = sectionNumber <- v - + and set v = sectionNumber <- v + member x.Type with get() = stype - and set(v) = stype <- v - + and set v = stype <- v + member x.StorageClass with get() = storageClass - and set(v) = storageClass <- v - + and set v = storageClass <- v + member x.NumberOfAuxSymbols with get() = numberOfAuxSymbols - and set(v) = numberOfAuxSymbols <- v - + and set v = numberOfAuxSymbols <- v + static member Width with get() = 18 - + member x.toBytes() = let buf = ByteBuffer.Create IMAGE_SYMBOL.Width buf.EmitInt64 name buf.EmitInt32 value - buf.EmitUInt16 ((uint16)sectionNumber) - buf.EmitUInt16 ((uint16)stype) + buf.EmitUInt16 (uint16 sectionNumber) + buf.EmitUInt16 (uint16 stype) buf.EmitByte storageClass buf.EmitByte numberOfAuxSymbols buf.Close() @@ -262,45 +263,45 @@ let bytesToIS (buffer: byte[]) (offset: int) = bytesToWord(buffer.[offset+14], buffer.[offset+15]), // Type buffer.[offset+16], // StorageClass buffer.[offset+17]) // NumberOfAuxSymbols - + type IMAGE_RELOCATION(va: int32, sti: int32, t: int16) = let mutable virtualAddress = va // Also RelocCount let mutable symbolTableIndex = sti let mutable ty = t // type - + member x.VirtualAddress with get() = virtualAddress - and set(v) = virtualAddress <- v - + and set v = virtualAddress <- v + member x.RelocCount with get() = virtualAddress - and set(v) = virtualAddress <- v - + and set v = virtualAddress <- v + member x.SymbolTableIndex with get() = symbolTableIndex - and set(v) = symbolTableIndex <- v - + and set v = symbolTableIndex <- v + member x.Type with get() = ty - and set(v) = ty <- v - + and set v = ty <- v + static member Width with get() = 10 - + member x.toBytes() = let buf = ByteBuffer.Create IMAGE_RELOCATION.Width buf.EmitInt32 virtualAddress buf.EmitInt32 symbolTableIndex - buf.EmitUInt16 ((uint16)ty) + buf.EmitUInt16 (uint16 ty) buf.Close() - + let bytesToIR (buffer: byte[]) (offset: int) = if (buffer.Length - offset) < IMAGE_RELOCATION.Width then invalidArg "buffer" "buffer too small to fit an IMAGE_RELOCATION" IMAGE_RELOCATION( bytesToDWord(buffer.[offset], buffer.[offset+1], buffer.[offset+2], buffer.[offset+3]), bytesToDWord(buffer.[offset+4], buffer.[offset+5], buffer.[offset+6], buffer.[offset+7]), bytesToWord(buffer.[offset+8], buffer.[offset+9])) - + type IMAGE_RESOURCE_DIRECTORY(c: int32, tds: int32, mjv: int16, mnv: int16, nne: int16, nie: int16) = let mutable characteristics = c let mutable timeDateStamp = tds @@ -308,43 +309,43 @@ type IMAGE_RESOURCE_DIRECTORY(c: int32, tds: int32, mjv: int16, mnv: int16, nne: let mutable minorVersion = mnv let mutable numberOfNamedEntries = nne let mutable numberOfIdEntries = nie - + member x.Characteristics with get() = characteristics - and set(v) = characteristics <- v - + and set v = characteristics <- v + member x.TimeDateStamp with get() = timeDateStamp - and set(v) = timeDateStamp <- v - + and set v = timeDateStamp <- v + member x.MajorVersion with get() = majorVersion - and set(v) = majorVersion <- v - + and set v = majorVersion <- v + member x.MinorVersion with get() = minorVersion - and set(v) = minorVersion <- v - + and set v = minorVersion <- v + member x.NumberOfNamedEntries with get() = numberOfNamedEntries - and set(v) = numberOfNamedEntries <- v - + and set v = numberOfNamedEntries <- v + member x.NumberOfIdEntries with get() = numberOfIdEntries - and set(v) = numberOfIdEntries <- v - + and set v = numberOfIdEntries <- v + static member Width = 16 - + member x.toBytes () = let buf = ByteBuffer.Create IMAGE_RESOURCE_DIRECTORY.Width buf.EmitInt32 characteristics buf.EmitInt32 timeDateStamp - buf.EmitUInt16 ((uint16)majorVersion) - buf.EmitUInt16 ((uint16)minorVersion) - buf.EmitUInt16 ((uint16)numberOfNamedEntries) - buf.EmitUInt16 ((uint16)numberOfIdEntries) + buf.EmitUInt16 (uint16 majorVersion) + buf.EmitUInt16 (uint16 minorVersion) + buf.EmitUInt16 (uint16 numberOfNamedEntries) + buf.EmitUInt16 (uint16 numberOfIdEntries) buf.Close() - + let bytesToIRD (buffer: byte[]) (offset: int) = if (buffer.Length - offset) < IMAGE_RESOURCE_DIRECTORY.Width then invalidArg "buffer" "buffer too small to fit an IMAGE_RESOURCE_DIRECTORY" @@ -354,76 +355,76 @@ let bytesToIRD (buffer: byte[]) (offset: int) = bytesToWord(buffer.[offset+10], buffer.[offset+11]), // MinorVersion bytesToWord(buffer.[offset+12], buffer.[offset+13]), // NumberOfNamedEntries bytesToWord(buffer.[offset+14], buffer.[offset+15])) // NumberOfIdEntries - + type IMAGE_RESOURCE_DIRECTORY_ENTRY(n: int32, o: int32) = let mutable name = n let mutable offset = o - + member x.Name with get() = name - and set(v) = name <- v - + and set v = name <- v + member x.OffsetToData with get() = offset - and set(v) = offset <- v - + and set v = offset <- v + member x.OffsetToDirectory with get() = offset &&& 0x7fffffff - + member x.DataIsDirectory with get() = (offset &&& 0x80000000) <> 0 - + static member Width = 8 - - member x.toBytes () = + + member x.toBytes () = let buf = ByteBuffer.Create IMAGE_RESOURCE_DIRECTORY_ENTRY.Width buf.EmitInt32 name buf.EmitInt32 offset buf.Close() - + let bytesToIRDE (buffer: byte[]) (offset: int) = if (buffer.Length - offset) < IMAGE_RESOURCE_DIRECTORY_ENTRY.Width then invalidArg "buffer" "buffer too small to fit an IMAGE_RESOURCE_DIRECTORY_ENTRY" IMAGE_RESOURCE_DIRECTORY_ENTRY( bytesToDWord(buffer.[offset], buffer.[offset+1], buffer.[offset+2], buffer.[offset+3]), // Name bytesToDWord(buffer.[offset+4], buffer.[offset+5], buffer.[offset+6], buffer.[offset+7])) // Offset - + type IMAGE_RESOURCE_DATA_ENTRY(o: int32, s: int32, c: int32, r: int32) = let mutable offsetToData = o let mutable size = s let mutable codePage = c let mutable reserved = r - + member x.OffsetToData with get() = offsetToData - and set(v) = offsetToData <- v + and set v = offsetToData <- v member x.Size with get() = size - and set(v) = size <- v + and set v = size <- v member x.CodePage with get() = codePage - and set(v) = codePage <- v + and set v = codePage <- v member x.Reserved with get() = reserved - and set(v) = reserved <- v - + and set v = reserved <- v + static member Width = 16 - - member x.toBytes() = + + member x.toBytes() = let buf = ByteBuffer.Create IMAGE_RESOURCE_DATA_ENTRY.Width buf.EmitInt32 offsetToData buf.EmitInt32 size buf.EmitInt32 codePage buf.EmitInt32 reserved - + let bytesToIRDataE (buffer: byte[]) (offset: int) = - if (buffer.Length - offset) < IMAGE_RESOURCE_DATA_ENTRY.Width then + if (buffer.Length - offset) < IMAGE_RESOURCE_DATA_ENTRY.Width then invalidArg "buffer" "buffer too small to fit an IMAGE_RESOURCE_DATA_ENTRY" IMAGE_RESOURCE_DATA_ENTRY(bytesToDWord(buffer.[offset], buffer.[offset+1], buffer.[offset+2], buffer.[offset+3]), // OffsetToData bytesToDWord(buffer.[offset+4], buffer.[offset+5], buffer.[offset+6], buffer.[offset+7]), // Size bytesToDWord(buffer.[offset+8], buffer.[offset+9], buffer.[offset+10], buffer.[offset+11]), // CodePage bytesToDWord(buffer.[offset+12], buffer.[offset+13], buffer.[offset+14], buffer.[offset+15])) // Reserved - - + + type ResFormatHeader() = let mutable dwDataSize = 0 let mutable dwHeaderSize = 32 // The eventual supposed size of this structure in memory @@ -434,37 +435,45 @@ type ResFormatHeader() = let mutable wLangID = 0s let mutable dwVersion = 0 let mutable dwCharacteristics = 0 - + member x.DataSize with get() = dwDataSize - and set(v) = dwDataSize <- v + and set v = dwDataSize <- v + member x.HeaderSize with get() = dwHeaderSize - and set(v) = dwHeaderSize <- v + and set v = dwHeaderSize <- v + member x.TypeID with get() = dwTypeID - and set(v) = dwTypeID <- v + and set v = dwTypeID <- v + member x.NameID with get() = dwNameID - and set(v) = dwNameID <- v + and set v = dwNameID <- v + member x.DataVersion with get() = dwDataVersion - and set(v) = dwDataVersion <- v + and set v = dwDataVersion <- v + member x.MemFlags with get() = wMemFlags - and set(v) = wMemFlags <- v + and set v = wMemFlags <- v + member x.LangID with get() = wLangID - and set(v) = wLangID <- v + and set v = wLangID <- v + member x.Version with get() = dwVersion - and set(v) = dwVersion <- v + and set v = dwVersion <- v + member x.Characteristics with get() = dwCharacteristics - and set(v) = dwCharacteristics <- v - + and set v = dwCharacteristics <- v + static member Width = 32 - + member x.toBytes() = let buf = ByteBuffer.Create ResFormatHeader.Width buf.EmitInt32 dwDataSize @@ -472,12 +481,12 @@ type ResFormatHeader() = buf.EmitInt32 dwTypeID buf.EmitInt32 dwNameID buf.EmitInt32 dwDataVersion - buf.EmitUInt16 ((uint16)wMemFlags) - buf.EmitUInt16 ((uint16)wLangID) + buf.EmitUInt16 (uint16 wMemFlags) + buf.EmitUInt16 (uint16 wLangID) buf.EmitInt32 dwVersion buf.EmitInt32 dwCharacteristics buf.Close() - + type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLinkedResource: byte[]) = let mutable resHdr = ResFormatHeader() let mutable dataEntry = Unchecked.defaultof @@ -485,39 +494,35 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink let mutable wzType = Unchecked.defaultof let mutable cName = 0 let mutable wzName = Unchecked.defaultof - - do + + do if (tid &&& 0x80000000) <> 0 then // REVIEW: Are names and types mutually exclusive? The C++ code didn't seem to think so, but I can't find any documentation - resHdr.TypeID <- 0 + resHdr.TypeID <- 0 let mtid = tid &&& 0x7fffffff - cType <- bytesToDWord(pbLinkedResource.[mtid], pbLinkedResource.[mtid+1], pbLinkedResource.[mtid+2], pbLinkedResource.[mtid+3]) - wzType <- Bytes.zeroCreate ((cType + 1) * 2) + cType <- bytesToDWord(pbLinkedResource.[mtid], pbLinkedResource.[mtid+1], pbLinkedResource.[mtid+2], pbLinkedResource.[mtid+3]) + wzType <- Bytes.zeroCreate ((cType + 1) * 2) Bytes.blit pbLinkedResource 4 wzType 0 (cType * 2) else - resHdr.TypeID <- (0xffff ||| ((tid &&& 0xffff) <<< 16)) - + resHdr.TypeID <- (0xffff ||| ((tid &&& 0xffff) <<< 16)) + if (nid &&& 0x80000000) <> 0 then - resHdr.NameID <- 0 + resHdr.NameID <- 0 let mnid = nid &&& 0x7fffffff - cName <- bytesToDWord(pbLinkedResource.[mnid], pbLinkedResource.[mnid+1], pbLinkedResource.[mnid+2], pbLinkedResource.[mnid+3]) - wzName <- Bytes.zeroCreate ((cName + 1) * 2) + cName <- bytesToDWord(pbLinkedResource.[mnid], pbLinkedResource.[mnid+1], pbLinkedResource.[mnid+2], pbLinkedResource.[mnid+3]) + wzName <- Bytes.zeroCreate ((cName + 1) * 2) Bytes.blit pbLinkedResource 4 wzName 0 (cName * 2) else resHdr.NameID <- (0xffff ||| ((nid &&& 0xffff) <<< 16)) - - resHdr.LangID <- (int16)lid - dataEntry <- bytesToIRDataE pbLinkedResource dataOffset + + resHdr.LangID <- (int16)lid + dataEntry <- bytesToIRDataE pbLinkedResource dataOffset resHdr.DataSize <- dataEntry.Size - - member x.ResHdr - with get() = resHdr - member x.DataEntry - with get() = dataEntry - member x.Type - with get() = wzType - member x.Name - with get() = wzName - + + member x.ResHdr = resHdr + member x.DataEntry = dataEntry + member x.Type = wzType + member x.Name = wzName + member x.Save(ulLinkedResourceBaseRVA: int32, pbLinkedResource: byte[], pUnlinkedResource: byte[], offset: int) = // Dump them to pUnlinkedResource // For each resource write header and data @@ -528,23 +533,23 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink resHdr.HeaderSize <- resHdr.HeaderSize + ((cType + 1) * 2) - 4 if Unchecked.defaultof <> wzName then resHdr.HeaderSize <- resHdr.HeaderSize + ((cName + 1) * 2) - 4 - + let SaveChunk(p: byte[], sz: int) = if Unchecked.defaultof <> pUnlinkedResource then Bytes.blit p 0 pUnlinkedResource (!unlinkedResourceOffset + offset) sz unlinkedResourceOffset := !unlinkedResourceOffset + sz size := !size + sz - + () - + // ---- Constant part of the header: DWORD, DWORD SaveChunk(dwToBytes resHdr.DataSize) SaveChunk(dwToBytes resHdr.HeaderSize) - + let mutable dwFiller = 0 - + if Unchecked.defaultof <> wzType then - SaveChunk(wzType,((cType + 1) * 2)) + SaveChunk(wzType, ((cType + 1) * 2)) dwFiller <- dwFiller + cType + 1 else SaveChunk(dwToBytes resHdr.TypeID) @@ -553,36 +558,36 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink dwFiller <- dwFiller + cName + 1 else SaveChunk(dwToBytes resHdr.NameID) - + 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) - - //---- Constant part of the header: DWORD,WORD,WORD,DWORD,DWORD + + //---- Constant part of the header: DWORD, WORD, WORD, DWORD, DWORD SaveChunk(dwToBytes resHdr.DataVersion) SaveChunk(wToBytes resHdr.MemFlags) SaveChunk(wToBytes resHdr.LangID) SaveChunk(dwToBytes resHdr.Version) SaveChunk(dwToBytes resHdr.Characteristics) - + //---- Header done, now data // just copying to make the code a bit cleaner - can blit if this ends up being a liability let pbData = pbLinkedResource.[(dataEntry.OffsetToData - ulLinkedResourceBaseRVA) ..] SaveChunk(pbData, dataEntry.Size) - - dwFiller <- dataEntry.Size &&& 0x3 + + dwFiller <- dataEntry.Size &&& 0x3 if dwFiller <> 0 then SaveChunk(bNil, 4 - dwFiller) - + !size -let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) = +let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) = let nPEFileType = match fileType with X86 -> 0 | X64 -> 2 let mutable tempResFiles: string list = [] let mutable objBytes: byte[] = [||] - + let unlinkedResources = unlinkedResources |> List.filter (fun arr -> arr.Length > 0) if isNil unlinkedResources then // bail if there's nothing to link objBytes @@ -596,17 +601,17 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR // We'll use the current dir and a random file name rather than System.IO.Path.GetTempFileName // to try and prevent the command line invocation string from being > MAX_PATH - let outputFilePaths = - if outputFilePath = "" then + let outputFilePaths = + if outputFilePath = "" then [ FileSystem.GetTempPathShim() ] else [ FileSystem.GetTempPathShim() ; (outputFilePath + "\\") ] // Get a unique random file - let rec GetUniqueRandomFileName(path) = + let rec GetUniqueRandomFileName path = let tfn = path + System.IO.Path.GetRandomFileName() - if FileSystem.SafeExists(tfn) then - GetUniqueRandomFileName(path) + if FileSystem.SafeExists tfn then + GetUniqueRandomFileName path else tfn @@ -617,29 +622,29 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR let cvtres = corSystemDir + "cvtres.exe " let createCvtresArgs path = - let tempObjFileName = GetUniqueRandomFileName(path) + let tempObjFileName = GetUniqueRandomFileName path let mutable cmdLineArgs = sprintf "%s \"/Out:%s\"" cmdLineArgsPreamble tempObjFileName let mutable resFiles: string list = [] for _ulr in unlinkedResources do - let tempResFileName = GetUniqueRandomFileName(path) - resFiles <- tempResFileName :: resFiles + let tempResFileName = GetUniqueRandomFileName path + resFiles <- tempResFileName :: resFiles cmdLineArgs <- cmdLineArgs + " \"" + tempResFileName + "\"" let trf = resFiles let cmd = cmdLineArgs - cmd,tempObjFileName,trf - - let cmdLineArgs,tempObjFileName,tempResFileNames = - let attempts = - outputFilePaths |> - List.map (fun path -> createCvtresArgs path) |> - List.filter (fun ((argstring: string),(_t: string),(_f: string list)) -> (cvtres.Length + argstring.Length) < MAX_PATH) - let invoc,tmp,files = + cmd, tempObjFileName, trf + + let cmdLineArgs, tempObjFileName, tempResFileNames = + let attempts = + outputFilePaths |> + List.map (fun path -> createCvtresArgs path) |> + List.filter (fun ((argstring: string), (_t: string), (_f: string list)) -> (cvtres.Length + argstring.Length) < MAX_PATH) + let invoc, tmp, files = match attempts with | [] -> createCvtresArgs ".\\" // hope for the best... - | (i,t,f) :: _rest -> i,t,f // use the first one, since they're listed in order of precedence + | (i, t, f) :: _rest -> i, t, f // use the first one, since they're listed in order of precedence tempResFiles <- files - (invoc,tmp,files) + (invoc, tmp, files) let cvtresInvocation = cvtres + cmdLineArgs @@ -649,21 +654,21 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR for ulr in unlinkedResources do // REVIEW: What can go wrong here? What happens when the various file calls fail // dump the unlinked resource bytes into the temp file - System.IO.File.WriteAllBytes(tempResFileNames.[iFiles], ulr) + System.IO.File.WriteAllBytes(tempResFileNames.[iFiles], ulr) iFiles <- iFiles + 1 // call cvtres.exe using the full cmd line string we've generated // check to see if the generated string is too long - if it is, fail with E_FAIL - if cvtresInvocation.Length >= MAX_PATH then - System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) + if cvtresInvocation.Length >= MAX_PATH then + System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) // REVIEW: We really shouldn't be calling out to cvtres - let mutable psi = System.Diagnostics.ProcessStartInfo(cvtres) - psi.Arguments <- cmdLineArgs + let mutable psi = System.Diagnostics.ProcessStartInfo cvtres + psi.Arguments <- cmdLineArgs psi.CreateNoWindow <- true ; // REVIEW: For some reason, this still creates a window unless WindowStyle is set to hidden - psi.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden - let p = System.Diagnostics.Process.Start(psi) + psi.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden + let p = System.Diagnostics.Process.Start psi // Wait for the process to finish p.WaitForExit() @@ -671,12 +676,12 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR check "Process.Start" p.ExitCode // TODO: really need to check against 0 // Conversion was successful, so read the object file - objBytes <- FileSystem.ReadAllBytesShim(tempObjFileName) + objBytes <- FileSystem.ReadAllBytesShim tempObjFileName //Array.Copy(objBytes, pbUnlinkedResource, pbUnlinkedResource.Length) - FileSystem.FileDelete(tempObjFileName) + FileSystem.FileDelete tempObjFileName finally // clean up the temp files - List.iter (fun tempResFileName -> FileSystem.FileDelete(tempResFileName)) tempResFiles + List.iter (fun tempResFileName -> FileSystem.FileDelete tempResFileName) tempResFiles // Part 2: Read the COFF file held in pbUnlinkedResource, spit it out into pResBuffer and apply the COFF fixups // pResBuffer will become the .rsrc section of the PE file @@ -690,11 +695,11 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR let rsrc01Name = 0x313024637273722eL // ".rsrc$01" let rsrc02Name = 0x323024637273722eL // ".rsrc$02" - let nullHdr = Unchecked.defaultof + let nullHdr = Unchecked.defaultof let mutable rsrc01 = nullHdr let mutable rsrc02 = nullHdr - for i = 0 to (int)hMod.NumberOfSections do + for i = 0 to int hMod.NumberOfSections do let pSection = bytesToISH objBytes (IMAGE_FILE_HEADER.Width + (IMAGE_SECTION_HEADER.Width * i)) if pSection.Name = rsrc01Name then rsrc01 <- pSection @@ -720,7 +725,7 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR let GetSymbolEntry (buffer: byte[]) (idx: int) = bytesToIS buffer (symbolTableHead + (idx * IMAGE_SYMBOL.Width) ) - for iReloc = 0 to (int)(rsrc01.NumberOfRelocations - 1s) do + for iReloc = 0 to int (rsrc01.NumberOfRelocations - 1s) do let pReloc = bytesToIR objBytes (rsrc01.PointerToRelocations + (iReloc * IMAGE_RELOCATION.Width)) let IdxSymbol = pReloc.SymbolTableIndex let pSymbolEntry = GetSymbolEntry objBytes IdxSymbol @@ -743,10 +748,10 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR // Copy $02 (resource raw into pResBuffer Bytes.blit objBytes rsrc02.PointerToRawData pResBuffer rsrc01.SizeOfRawData rsrc02.SizeOfRawData - // return the buffer + // return the buffer pResBuffer -let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = +let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = let mutable nResNodes = 0 let pirdType = bytesToIRD pbLinkedResource 0 @@ -755,8 +760,8 @@ let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = // determine entry buffer size // TODO: coalesce these two loops - for iEntry = 0 to ((int)nEntries - 1) do - pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) + for iEntry = 0 to (int nEntries - 1) do + pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) if pirdeType.DataIsDirectory then let nameBase = pirdeType.OffsetToDirectory @@ -764,26 +769,26 @@ let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = let mutable pirdeName = Unchecked.defaultof let nEntries2 = pirdName.NumberOfNamedEntries + pirdName.NumberOfIdEntries - for iEntry2 = 0 to ((int)nEntries2 - 1) do - pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) + for iEntry2 = 0 to (int nEntries2 - 1) do + pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) if pirdeName.DataIsDirectory then let langBase = pirdeName.OffsetToDirectory let pirdLang = bytesToIRD pbLinkedResource langBase let nEntries3 = pirdLang.NumberOfNamedEntries + pirdLang.NumberOfIdEntries - - nResNodes <- nResNodes + ((int)nEntries3) + + nResNodes <- nResNodes + (int nEntries3) else - nResNodes <- nResNodes + 1 + nResNodes <- nResNodes + 1 else - nResNodes <- nResNodes + 1 + nResNodes <- nResNodes + 1 let pResNodes: ResFormatNode [] = Array.zeroCreate nResNodes - nResNodes <- 0 + nResNodes <- 0 // fill out the entry buffer - for iEntry = 0 to ((int)nEntries - 1) do - pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) + for iEntry = 0 to (int nEntries - 1) do + pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) let dwTypeID = pirdeType.Name // Need to skip VERSION and RT_MANIFEST resources // REVIEW: ideally we shouldn't allocate space for these, or rename properly so we don't get the naming conflict @@ -793,9 +798,9 @@ let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = let pirdName = bytesToIRD pbLinkedResource nameBase let mutable pirdeName = Unchecked.defaultof let nEntries2 = pirdName.NumberOfNamedEntries + pirdName.NumberOfIdEntries - - for iEntry2 = 0 to ((int)nEntries2 - 1) do - pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) + + for iEntry2 = 0 to (int nEntries2 - 1) do + pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) let dwNameID = pirdeName.Name if pirdeName.DataIsDirectory then @@ -803,36 +808,36 @@ let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = let pirdLang = bytesToIRD pbLinkedResource langBase let mutable pirdeLang = Unchecked.defaultof let nEntries3 = pirdLang.NumberOfNamedEntries + pirdLang.NumberOfIdEntries - - for iEntry3 = 0 to ((int)nEntries3 - 1) do - pirdeLang <- bytesToIRDE pbLinkedResource (langBase + (iEntry3 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) + + for iEntry3 = 0 to (int nEntries3 - 1) do + pirdeLang <- bytesToIRDE pbLinkedResource (langBase + (iEntry3 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) let dwLangID = pirdeLang.Name - + if pirdeLang.DataIsDirectory then // Resource hierarchy exceeds three levels System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) else if (not skipResource) then let rfn = ResFormatNode(dwTypeID, dwNameID, dwLangID, pirdeLang.OffsetToData, pbLinkedResource) - pResNodes.[nResNodes] <- rfn - nResNodes <- nResNodes + 1 + pResNodes.[nResNodes] <- rfn + nResNodes <- nResNodes + 1 else if (not skipResource) then let rfn = ResFormatNode(dwTypeID, dwNameID, 0, pirdeName.OffsetToData, pbLinkedResource) - pResNodes.[nResNodes] <- rfn - nResNodes <- nResNodes + 1 + pResNodes.[nResNodes] <- rfn + nResNodes <- nResNodes + 1 else if (not skipResource) then let rfn = ResFormatNode(dwTypeID, 0, 0, pirdeType.OffsetToData, pbLinkedResource) // REVIEW: I believe these 0s are what's causing the duplicate res naming problems - pResNodes.[nResNodes] <- rfn - nResNodes <- nResNodes + 1 + pResNodes.[nResNodes] <- rfn + nResNodes <- nResNodes + 1 // Ok, all tree leaves are in ResFormatNode structs, and nResNodes ptrs are in pResNodes let mutable size = 0 if nResNodes <> 0 then - size <- size + ResFormatHeader.Width ; // sizeof(ResFormatHeader) + size <- size + ResFormatHeader.Width ; // sizeof ResFormatHeader for i = 0 to (nResNodes - 1) do - size <- size + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, Unchecked.defaultof, 0) + size <- size + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, Unchecked.defaultof, 0) let pResBuffer = Bytes.zeroCreate size @@ -856,7 +861,7 @@ let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = [] [] -type IMetaDataDispenser = +type IMetaDataDispenser = abstract DefineScope: unit -> unit // need this here to fill the first vtable slot abstract OpenScope: [] szScope: string * [] dwOpenFlags: Int32 * [] riid: System.Guid byref * [] punk: Object byref -> unit @@ -865,7 +870,7 @@ type IMetaDataDispenser = [] type IMetadataImport = abstract Placeholder: unit -> unit - + [] [] [] @@ -879,9 +884,9 @@ type ISymUnmanagedDocumentWriter = abstract SetSource: sourceSize: int * [] source: byte[] -> unit abstract SetCheckSum: algorithmId: System.Guid * checkSumSize: int * [] checkSum: byte [] -> unit -// Struct used to retrieve info on the debug output +// Struct used to retrieve info on the debug output [] -type ImageDebugDirectory = +type ImageDebugDirectory = val Characteristics: int32 val TimeDateStamp: int32 val MajorVersion: int16 @@ -890,7 +895,7 @@ type ImageDebugDirectory = val SizeOfData: int32 val AddressOfRawData: int32 val PointerToRawData: int32 - + [] [] type ISymUnmanagedWriter2 = @@ -898,13 +903,13 @@ type ISymUnmanagedWriter2 = language: System.Guid byref * languageVendor: System.Guid byref * documentType: System.Guid byref * - [] RetVal: ISymUnmanagedDocumentWriter byref -> unit - abstract SetUserEntryPoint: entryMethod: uint32 -> unit + [] RetVal: ISymUnmanagedDocumentWriter byref -> unit + abstract SetUserEntryPoint: entryMethod: uint32 -> unit abstract OpenMethod: meth: int -> unit - abstract CloseMethod: unit -> unit - abstract OpenScope: startOffset: int * pRetVal: int byref -> unit + abstract CloseMethod: unit -> unit + abstract OpenScope: startOffset: int * pRetVal: int byref -> unit abstract CloseScope: endOffset: int -> unit - abstract SetScopeRange: scopeID: int * startOffset: int * endOffset: int -> unit + abstract SetScopeRange: scopeID: int * startOffset: int * endOffset: int -> unit abstract DefineLocalVariable: [] varname: string * attributes: int * cSig: int * @@ -958,7 +963,7 @@ type ISymUnmanagedWriter2 = stream: IStream * fullBuild: bool -> unit abstract GetDebugInfo: iDD: ImageDebugDirectory byref * - cData: int * + cData: int * pcData: int byref * []data: byte[] -> unit abstract DefineSequencePoints: document: ISymUnmanagedDocumentWriter * @@ -987,17 +992,17 @@ type ISymUnmanagedWriter2 = addr2: int * addr3: int * startOffset: int * - endOffset: int -> unit + endOffset: int -> unit abstract DefineGlobalVariable2: [] globalvarname2: string * attributes: int * sigToken: int * addressKind: int * addr1: int * addr2: int * - addr3: int -> unit + addr3: int -> unit abstract DefineConstant2: [] constantname2: string * value: Object * - sigToken: int -> unit + sigToken: int -> unit abstract OpenMethod2: method2: int * isect: int * offset: int -> unit @@ -1016,30 +1021,30 @@ type idd = let pdbInitialize (binaryName: string) (pdbName: string) = // collect necessary COM types let CorMetaDataDispenser = System.Type.GetTypeFromProgID("CLRMetaData.CorMetaDataDispenser") - - // get the importer pointer + + // get the importer pointer let mdd = System.Activator.CreateInstance(CorMetaDataDispenser) :?> IMetaDataDispenser let mutable IID_IMetaDataEmit = new Guid("BA3FEE4C-ECB9-4E41-83B7-183FA41CD859") let mutable o = Object() mdd.OpenScope(binaryName, 0x1, &IID_IMetaDataEmit, &o) // 0x1 = ofWrite let emitterPtr = Marshal.GetComInterfaceForObject(o, typeof) - let writer = - try + let writer = + try let writer = Activator.CreateInstance(System.Type.GetTypeFromProgID("CorSymWriter_SxS")) :?> ISymUnmanagedWriter2 writer.Initialize(emitterPtr, pdbName, Unchecked.defaultof, true) writer - finally + finally // Marshal.GetComInterfaceForObject adds an extra ref for emitterPtr if IntPtr.Zero <> emitterPtr then - Marshal.Release(emitterPtr) |> ignore - + Marshal.Release emitterPtr |> ignore + { symWriter = writer } [] do() -let pdbCloseDocument(documentWriter: PdbDocumentWriter) = +let pdbCloseDocument(documentWriter: PdbDocumentWriter) = Marshal.ReleaseComObject (documentWriter.symDocWriter) |> ignore @@ -1057,7 +1062,7 @@ let pdbClose (writer: PdbWriter) dllFilename pdbFilename = let rc = Marshal.ReleaseComObject(writer.symWriter) for i = 0 to (rc - 1) do Marshal.ReleaseComObject(writer.symWriter) |> ignore - + let isLocked filename = try use x = File.Open (filename, FileMode.Open, FileAccess.ReadWrite, FileShare.None) @@ -1082,18 +1087,18 @@ let guidSourceHashMD5 = System.Guid(0x406ea660u, 0x64cfus, 0x4c82us, 0xb6uy, 0xf let hashSizeOfMD5 = 16 // If the FIPS algorithm policy is enabled on the computer (e.g., for US government employees and contractors) -// then obtaining the MD5 implementation in BCL will throw. -// In this case, catch the failure, and not set a checksum. +// then obtaining the MD5 implementation in BCL will throw. +// In this case, catch the failure, and not set a checksum. let internal setCheckSum (url: string, writer: ISymUnmanagedDocumentWriter) = try - use file = FileSystem.FileStreamReadShim(url) + use file = FileSystem.FileStreamReadShim url use md5 = System.Security.Cryptography.MD5.Create() - let checkSum = md5.ComputeHash(file) + let checkSum = md5.ComputeHash file if (checkSum.Length = hashSizeOfMD5) then writer.SetCheckSum (guidSourceHashMD5, hashSizeOfMD5, checkSum) with _ -> () -let pdbDefineDocument (writer: PdbWriter) (url: string) = +let pdbDefineDocument (writer: PdbWriter) (url: string) = //3F5162F8-07C6-11D3-9053-00C04FA302A1 //let mutable corSymLanguageTypeCSharp = System.Guid(0x3F5162F8u, 0x07C6us, 0x11D3us, 0x90uy, 0x53uy, 0x00uy, 0xC0uy, 0x4Fuy, 0xA3uy, 0x02uy, 0xA1uy) let mutable corSymLanguageTypeFSharp = System.Guid(0xAB4F38C9u, 0xB6E6us, 0x43baus, 0xBEuy, 0x3Buy, 0x58uy, 0x08uy, 0x0Buy, 0x2Cuy, 0xCCuy, 0xE3uy) @@ -1104,35 +1109,35 @@ let pdbDefineDocument (writer: PdbWriter) (url: string) = setCheckSum (url, docWriter) { symDocWriter = docWriter } -let pdbOpenMethod (writer: PdbWriter) (methodToken: int32) = - writer.symWriter.OpenMethod(methodToken) +let pdbOpenMethod (writer: PdbWriter) (methodToken: int32) = + writer.symWriter.OpenMethod methodToken -let pdbCloseMethod (writer: PdbWriter) = +let pdbCloseMethod (writer: PdbWriter) = writer.symWriter.CloseMethod() - -let pdbOpenScope (writer: PdbWriter) (startOffset: int32) = + +let pdbOpenScope (writer: PdbWriter) (startOffset: int32) = let mutable retInt = 0 writer.symWriter.OpenScope(startOffset, &retInt) check "action" (retInt) -let pdbCloseScope (writer: PdbWriter) (endOffset: int32) = - writer.symWriter.CloseScope(endOffset) +let pdbCloseScope (writer: PdbWriter) (endOffset: int32) = + writer.symWriter.CloseScope endOffset -let pdbDefineLocalVariable (writer: PdbWriter) (name: string) (signature: byte[]) (addr1: int32) = - writer.symWriter.DefineLocalVariable(name, 0, signature.Length, signature, (int)System.Diagnostics.SymbolStore.SymAddressKind.ILOffset, addr1, 0, 0, 0, 0) +let pdbDefineLocalVariable (writer: PdbWriter) (name: string) (signature: byte[]) (addr1: int32) = + writer.symWriter.DefineLocalVariable(name, 0, signature.Length, signature, int System.Diagnostics.SymbolStore.SymAddressKind.ILOffset, addr1, 0, 0, 0, 0) -let pdbSetMethodRange (writer: PdbWriter) (docWriter1: PdbDocumentWriter) (startLine: int) (startCol: int) (docWriter2: PdbDocumentWriter) (endLine: int) (endCol: int) = +let pdbSetMethodRange (writer: PdbWriter) (docWriter1: PdbDocumentWriter) (startLine: int) (startCol: int) (docWriter2: PdbDocumentWriter) (endLine: int) (endCol: int) = writer.symWriter.SetMethodSourceRange(docWriter1.symDocWriter, startLine, startCol, docWriter2.symDocWriter, endLine, endCol) -let pdbDefineSequencePoints (writer: PdbWriter) (docWriter: PdbDocumentWriter) (pts: (int * int * int * int * int)[]) = - let offsets = (Array.map (fun (x,_,_,_,_) -> x) pts) - let lines = (Array.map (fun (_,x,_,_,_) -> x) pts) - let columns = (Array.map (fun (_,_,x,_,_) -> x) pts) - let endLines = (Array.map (fun (_,_,_,x,_) -> x) pts) - let endColumns = (Array.map (fun (_,_,_,_,x) -> x) pts) +let pdbDefineSequencePoints (writer: PdbWriter) (docWriter: PdbDocumentWriter) (pts: (int * int * int * int * int)[]) = + let offsets = (Array.map (fun (x, _, _, _, _) -> x) pts) + let lines = (Array.map (fun (_, x, _, _, _) -> x) pts) + let columns = (Array.map (fun (_, _, x, _, _) -> x) pts) + let endLines = (Array.map (fun (_, _, _, x, _) -> x) pts) + let endColumns = (Array.map (fun (_, _, _, _, x) -> x) pts) writer.symWriter.DefineSequencePoints(docWriter.symDocWriter, pts.Length, offsets, lines, columns, endLines, endColumns) -let pdbWriteDebugInfo (writer: PdbWriter) = +let pdbWriteDebugInfo (writer: PdbWriter) = let mutable iDD = new ImageDebugDirectory() let mutable length = 0 writer.symWriter.GetDebugInfo(&iDD, 0, &length, null) @@ -1155,7 +1160,7 @@ type PdbMethod = { symMethod: ISymbolMethod } type PdbVariable = { symVariable: ISymbolVariable } type PdbMethodScope = { symScope: ISymbolScope } -type PdbSequencePoint = +type PdbSequencePoint = { pdbSeqPointOffset: int pdbSeqPointDocument: PdbDocument pdbSeqPointLine: int @@ -1163,73 +1168,73 @@ type PdbSequencePoint = pdbSeqPointEndLine: int pdbSeqPointEndColumn: int } -let pdbReadOpen (moduleName: string) (path: string) : PdbReader = +let pdbReadOpen (moduleName: string) (path: string) : PdbReader = let CorMetaDataDispenser = System.Type.GetTypeFromProgID("CLRMetaData.CorMetaDataDispenser") let mutable IID_IMetaDataImport = new Guid("7DAC8207-D3AE-4c75-9B67-92801A497D44") let mdd = System.Activator.CreateInstance(CorMetaDataDispenser) :?> IMetaDataDispenser let mutable o: Object = new Object() - mdd.OpenScope(moduleName, 0, &IID_IMetaDataImport, &o) + mdd.OpenScope(moduleName, 0, &IID_IMetaDataImport, &o) let importerPtr = Marshal.GetComInterfaceForObject(o, typeof) - try + try #if ENABLE_MONO_SUPPORT - // ISymWrapper.dll is not available as a compile-time dependency for the cross-platform compiler, since it is Windows-only - // Access it via reflection instead.System.Diagnostics.SymbolStore.SymBinder - try - let isym = System.Reflection.Assembly.Load("ISymWrapper, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a") - let symbolBinder = isym.CreateInstance("System.Diagnostics.SymbolStore.SymBinder") - let symbolBinderTy = symbolBinder.GetType() - let reader = symbolBinderTy.InvokeMember("GetReader",BindingFlags.Public ||| BindingFlags.InvokeMethod ||| BindingFlags.Instance, null,symbolBinder,[| box importerPtr; box moduleName; box path |]) - { symReader = reader :?> ISymbolReader } - with _ -> - { symReader = null } -#else + // ISymWrapper.dll is not available as a compile-time dependency for the cross-platform compiler, since it is Windows-only + // Access it via reflection instead.System.Diagnostics.SymbolStore.SymBinder + try + let isym = System.Reflection.Assembly.Load("ISymWrapper, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a") + let symbolBinder = isym.CreateInstance("System.Diagnostics.SymbolStore.SymBinder") + let symbolBinderTy = symbolBinder.GetType() + let reader = symbolBinderTy.InvokeMember("GetReader", BindingFlags.Public ||| BindingFlags.InvokeMethod ||| BindingFlags.Instance, null, symbolBinder, [| box importerPtr; box moduleName; box path |]) + { symReader = reader :?> ISymbolReader } + with _ -> + { symReader = null } +#else let symbolBinder = new System.Diagnostics.SymbolStore.SymBinder() { symReader = symbolBinder.GetReader(importerPtr, moduleName, path) } #endif finally // Marshal.GetComInterfaceForObject adds an extra ref for importerPtr if IntPtr.Zero <> importerPtr then - Marshal.Release(importerPtr) |> ignore + Marshal.Release importerPtr |> ignore // The symbol reader's finalize method will clean up any unmanaged resources. // If file locks persist, we may want to manually invoke finalize let pdbReadClose (_reader: PdbReader) : unit = () -let pdbReaderGetMethod (reader: PdbReader) (token: int32) : PdbMethod = - { symMethod = reader.symReader.GetMethod(System.Diagnostics.SymbolStore.SymbolToken(token)) } +let pdbReaderGetMethod (reader: PdbReader) (token: int32) : PdbMethod = + { symMethod = reader.symReader.GetMethod(SymbolToken token) } -let pdbReaderGetMethodFromDocumentPosition (reader: PdbReader) (document: PdbDocument) (line: int) (column: int) : PdbMethod = +let pdbReaderGetMethodFromDocumentPosition (reader: PdbReader) (document: PdbDocument) (line: int) (column: int) : PdbMethod = { symMethod = reader.symReader.GetMethodFromDocumentPosition(document.symDocument, line, column) } -let pdbReaderGetDocuments (reader: PdbReader) : PdbDocument[] = +let pdbReaderGetDocuments (reader: PdbReader) : PdbDocument[] = let arr = reader.symReader.GetDocuments() Array.map (fun i -> { symDocument=i }) arr -let pdbReaderGetDocument (reader: PdbReader) (url: string) (language: byte[]) (languageVendor: byte[]) (documentType: byte[]) : PdbDocument = - { symDocument = reader.symReader.GetDocument(url, System.Guid(language), System.Guid(languageVendor), System.Guid(documentType)) } +let pdbReaderGetDocument (reader: PdbReader) (url: string) (language: byte[]) (languageVendor: byte[]) (documentType: byte[]) : PdbDocument = + { symDocument = reader.symReader.GetDocument(url, Guid language, Guid languageVendor, System.Guid documentType) } -let pdbDocumentGetURL (document: PdbDocument) : string = +let pdbDocumentGetURL (document: PdbDocument) : string = document.symDocument.URL -let pdbDocumentGetType (document: PdbDocument) : byte[] (* guid *) = +let pdbDocumentGetType (document: PdbDocument) : byte[] (* guid *) = let guid = document.symDocument.DocumentType guid.ToByteArray() -let pdbDocumentGetLanguage (document: PdbDocument) : byte[] (* guid *) = +let pdbDocumentGetLanguage (document: PdbDocument) : byte[] (* guid *) = let guid = document.symDocument.Language guid.ToByteArray() -let pdbDocumentGetLanguageVendor (document: PdbDocument) : byte[] = +let pdbDocumentGetLanguageVendor (document: PdbDocument) : byte[] = let guid = document.symDocument.LanguageVendor guid.ToByteArray() - -let pdbDocumentFindClosestLine (document: PdbDocument) (line: int) : int = - document.symDocument.FindClosestLine(line) -let pdbMethodGetToken (meth: PdbMethod) : int32 = +let pdbDocumentFindClosestLine (document: PdbDocument) (line: int) : int = + document.symDocument.FindClosestLine line + +let pdbMethodGetToken (meth: PdbMethod) : int32 = let token = meth.symMethod.Token token.GetToken() - + let pdbMethodGetSequencePoints (meth: PdbMethod) : PdbSequencePoint[] = let pSize = meth.symMethod.SequencePointCount let offsets = Array.zeroCreate pSize @@ -1238,37 +1243,37 @@ let pdbMethodGetSequencePoints (meth: PdbMethod) : PdbSequencePoint[] = let cols = Array.zeroCreate pSize let endLines = Array.zeroCreate pSize let endColumns = Array.zeroCreate pSize - + meth.symMethod.GetSequencePoints(offsets, docs, lines, cols, endLines, endColumns) - Array.init pSize (fun i -> + Array.init pSize (fun i -> { pdbSeqPointOffset = offsets.[i] pdbSeqPointDocument = { symDocument = docs.[i] } pdbSeqPointLine = lines.[i] pdbSeqPointColumn = cols.[i] pdbSeqPointEndLine = endLines.[i] - pdbSeqPointEndColumn = endColumns.[i] }) + pdbSeqPointEndColumn = endColumns.[i] }) -let pdbScopeGetChildren (scope: PdbMethodScope) : PdbMethodScope[] = +let pdbScopeGetChildren (scope: PdbMethodScope) : PdbMethodScope[] = let arr = scope.symScope.GetChildren() Array.map (fun i -> { symScope=i }) arr -let pdbScopeGetOffsets (scope: PdbMethodScope) : int * int = +let pdbScopeGetOffsets (scope: PdbMethodScope) : int * int = (scope.symScope.StartOffset, scope.symScope.EndOffset) -let pdbScopeGetLocals (scope: PdbMethodScope) : PdbVariable[] = +let pdbScopeGetLocals (scope: PdbMethodScope) : PdbVariable[] = let arr = scope.symScope.GetLocals() Array.map (fun i -> { symVariable=i }) arr -let pdbVariableGetName (variable: PdbVariable) : string = +let pdbVariableGetName (variable: PdbVariable) : string = variable.symVariable.Name -let pdbVariableGetSignature (variable: PdbVariable) : byte[] = +let pdbVariableGetSignature (variable: PdbVariable) : byte[] = variable.symVariable.GetSignature() // The tuple is (AddressKind, AddressField1) -let pdbVariableGetAddressAttributes (variable: PdbVariable) : (int32 * int32) = - (int32 variable.symVariable.AddressKind,variable.symVariable.AddressField1) +let pdbVariableGetAddressAttributes (variable: PdbVariable) : (int32 * int32) = + (int32 variable.symVariable.AddressKind, variable.symVariable.AddressField1) #endif // Key signing @@ -1279,27 +1284,27 @@ type pubkeyOptions = byte[] * bool #if FX_NO_CORHOST_SIGNER -let signerOpenPublicKeyFile filePath = FileSystem.ReadAllBytesShim(filePath) +let signerOpenPublicKeyFile filePath = FileSystem.ReadAllBytesShim filePath -let signerOpenKeyPairFile filePath = FileSystem.ReadAllBytesShim(filePath) +let signerOpenKeyPairFile filePath = FileSystem.ReadAllBytesShim filePath -let signerGetPublicKeyForKeyPair (kp: keyPair) : pubkey = +let signerGetPublicKeyForKeyPair (kp: keyPair) : pubkey = let reply = (StrongNameSign.getPublicKeyForKeyPair kp) reply -let signerGetPublicKeyForKeyContainer (_kcName: keyContainerName) : pubkey = +let signerGetPublicKeyForKeyContainer (_kcName: keyContainerName) : pubkey = raise (NotImplementedException("signerGetPublicKeyForKeyContainer is not yet implemented")) - -let signerCloseKeyContainer (_kc: keyContainerName) : unit = + +let signerCloseKeyContainer (_kc: keyContainerName) : unit = raise (NotImplementedException("signerCloseKeyContainer is not yet implemented")) -let signerSignatureSize (pk: pubkey) : int = +let signerSignatureSize (pk: pubkey) : int = (StrongNameSign.signatureSize pk) let signerSignFileWithKeyPair (fileName: string) (kp: keyPair) : unit = (StrongNameSign.signFile fileName kp) -let signerSignFileWithKeyContainer (_fileName: string) (_kcName: keyContainerName) : unit = +let signerSignFileWithKeyContainer (_fileName: string) (_kcName: keyContainerName) : unit = raise (NotImplementedException("signerSignFileWithKeyContainer is not yet implemented")) #else @@ -1310,10 +1315,10 @@ type UnusedCOMMethod = unit -> unit [] type ICLRMetaHost = [] - abstract GetRuntime: + abstract GetRuntime: [] version: string * [] interfaceId: System.Guid -> [] System.Object - + // Methods that we don't need are stubbed out for now... abstract GetVersionFromFile: UnusedCOMMethod abstract EnumerateInstalledRuntimes: UnusedCOMMethod @@ -1332,10 +1337,10 @@ type ICLRStrongName = abstract GetHashFromFileW: UnusedCOMMethod abstract GetHashFromHandle: UnusedCOMMethod abstract StrongNameCompareAssemblies: UnusedCOMMethod - + [] abstract StrongNameFreeBuffer: [] pbMemory: nativeint -> unit - + abstract StrongNameGetBlob: UnusedCOMMethod abstract StrongNameGetBlobFromImage: UnusedCOMMethod @@ -1346,7 +1351,7 @@ type ICLRStrongName = [] cbKeyBlob: uint32 * [] ppbPublicKeyBlob: nativeint byref * [] pcbPublicKeyBlob: uint32 byref -> unit - + abstract StrongNameHashSize: UnusedCOMMethod [] @@ -1364,7 +1369,7 @@ type ICLRStrongName = [] cbKeyBlob: uint32 * [] ppbSignatureBlob: nativeint * [] pcbSignatureBlob: uint32 byref -> unit - + abstract StrongNameSignatureGenerationEx: UnusedCOMMethod [] @@ -1372,7 +1377,7 @@ type ICLRStrongName = [] pbPublicKeyBlob: byte[] * [] cbPublicKeyBlob: uint32 * [] pcbSize: uint32 byref -> unit - + abstract StrongNameSignatureVerification: UnusedCOMMethod [] @@ -1380,12 +1385,12 @@ type ICLRStrongName = [] pwzFilePath: string * [] fForceVerification: bool * [] pfWasVerified: bool byref -> [] bool - + abstract StrongNameSignatureVerificationFromImage: UnusedCOMMethod abstract StrongNameTokenFromAssembly: UnusedCOMMethod abstract StrongNameTokenFromAssemblyEx: UnusedCOMMethod abstract StrongNameTokenFromPublicKey: UnusedCOMMethod - + [] [] @@ -1402,7 +1407,7 @@ type ICLRRuntimeInfo = abstract GetInterface : [] coClassId: System.Guid * [] interfaceId: System.Guid -> []System.Object - + [] [] let CreateInterface ( @@ -1411,9 +1416,9 @@ let CreateInterface ( ([] _metaHost : ICLRMetaHost byref)) : unit = failwith "CreateInterface" -let signerOpenPublicKeyFile filePath = FileSystem.ReadAllBytesShim(filePath) +let signerOpenPublicKeyFile filePath = FileSystem.ReadAllBytesShim filePath -let signerOpenKeyPairFile filePath = FileSystem.ReadAllBytesShim(filePath) +let signerOpenKeyPairFile filePath = FileSystem.ReadAllBytesShim filePath let mutable iclrsn: ICLRStrongName option = None let getICLRStrongName () = @@ -1424,7 +1429,7 @@ let getICLRStrongName () = let CLSID_CLRMetaHost = System.Guid(0x9280188Du, 0x0E8Eus, 0x4867us, 0xB3uy, 0x0Cuy, 0x7Fuy, 0xA8uy, 0x38uy, 0x84uy, 0xE8uy, 0xDEuy) let IID_ICLRMetaHost = System.Guid(0xD332DB9Eu, 0xB9B3us, 0x4125us, 0x82uy, 0x07uy, 0xA1uy, 0x48uy, 0x84uy, 0xF5uy, 0x32uy, 0x16uy) let clrRuntimeInfoGuid = System.Guid(0xBD39D1D2u, 0xBA2Fus, 0x486aus, 0x89uy, 0xB0uy, 0xB4uy, 0xB0uy, 0xCBuy, 0x46uy, 0x68uy, 0x91uy) - + let runtimeVer = System.Runtime.InteropServices.RuntimeEnvironment.GetSystemVersion() let mutable metaHost = Unchecked.defaultof CreateInterface(CLSID_CLRMetaHost, IID_ICLRMetaHost, &metaHost) @@ -1434,25 +1439,25 @@ let getICLRStrongName () = let sn = runtimeInfo.GetInterface(CLSID_CLRStrongName, IID_ICLRStrongName) :?> ICLRStrongName if Unchecked.defaultof = sn then failwith "Unable to obtain ICLRStrongName object" - iclrsn <- Some(sn) + iclrsn <- Some sn sn - | Some(sn) -> sn + | Some sn -> sn let signerGetPublicKeyForKeyPair kp = - if IL.runningOnMono then - let snt = System.Type.GetType("Mono.Security.StrongName") + if IL.runningOnMono then + let snt = System.Type.GetType("Mono.Security.StrongName") let sn = System.Activator.CreateInstance(snt, [| box kp |]) - snt.InvokeMember("PublicKey", (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public), null, sn, [| |], Globalization.CultureInfo.InvariantCulture) :?> byte[] + snt.InvokeMember("PublicKey", (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public), null, sn, [| |], Globalization.CultureInfo.InvariantCulture) :?> byte[] else let mutable pSize = 0u let mutable pBuffer: nativeint = (nativeint)0 let iclrSN = getICLRStrongName() iclrSN.StrongNameGetPublicKey(Unchecked.defaultof, kp, (uint32) kp.Length, &pBuffer, &pSize) |> ignore - let mutable keybuffer: byte [] = Bytes.zeroCreate ((int)pSize) + let mutable keybuffer: byte [] = Bytes.zeroCreate (int pSize) // Copy the marshalled data over - we'll have to free this ourselves - Marshal.Copy(pBuffer, keybuffer, 0, (int)pSize) - iclrSN.StrongNameFreeBuffer(pBuffer) |> ignore + Marshal.Copy(pBuffer, keybuffer, 0, int pSize) + iclrSN.StrongNameFreeBuffer pBuffer |> ignore keybuffer let signerGetPublicKeyForKeyContainer kc = @@ -1460,17 +1465,17 @@ let signerGetPublicKeyForKeyContainer kc = let mutable pBuffer: nativeint = (nativeint)0 let iclrSN = getICLRStrongName() iclrSN.StrongNameGetPublicKey(kc, Unchecked.defaultof, 0u, &pBuffer, &pSize) |> ignore - let mutable keybuffer: byte [] = Bytes.zeroCreate ((int)pSize) + let mutable keybuffer: byte [] = Bytes.zeroCreate (int pSize) // Copy the marshalled data over - we'll have to free this ourselves later - Marshal.Copy(pBuffer, keybuffer, 0, (int)pSize) - iclrSN.StrongNameFreeBuffer(pBuffer) |> ignore + Marshal.Copy(pBuffer, keybuffer, 0, int pSize) + iclrSN.StrongNameFreeBuffer pBuffer |> ignore keybuffer - -let signerCloseKeyContainer kc = + +let signerCloseKeyContainer kc = let iclrSN = getICLRStrongName() - iclrSN.StrongNameKeyDelete(kc) |> ignore + iclrSN.StrongNameKeyDelete kc |> ignore -let signerSignatureSize (pk: byte[]) = +let signerSignatureSize (pk: byte[]) = if IL.runningOnMono then if pk.Length > 32 then pk.Length - 32 else 128 else @@ -1479,9 +1484,9 @@ let signerSignatureSize (pk: byte[]) = iclrSN.StrongNameSignatureSize(pk, uint32 pk.Length, &pSize) |> ignore int pSize -let signerSignFileWithKeyPair fileName kp = - if IL.runningOnMono then - let snt = System.Type.GetType("Mono.Security.StrongName") +let signerSignFileWithKeyPair fileName kp = + if IL.runningOnMono then + let snt = System.Type.GetType("Mono.Security.StrongName") let sn = System.Activator.CreateInstance(snt, [| box kp |]) let conv (x: obj) = if (unbox x: bool) then 0 else -1 snt.InvokeMember("Sign", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, sn, [| box fileName |], Globalization.CultureInfo.InvariantCulture) |> conv |> check "Sign" diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index b684c308f..160fbf386 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -49,8 +49,8 @@ let dw2 n = byte ((n >>> 16) &&& 0xFFL) let dw1 n = byte ((n >>> 8) &&& 0xFFL) let dw0 n = byte (n &&& 0xFFL) -let bitsOfSingle (x: float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x), 0) -let bitsOfDouble (x: float) = System.BitConverter.DoubleToInt64Bits(x) +let bitsOfSingle (x: float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes x, 0) +let bitsOfDouble (x: float) = System.BitConverter.DoubleToInt64Bits x let emitBytesViaBuffer f = let bb = ByteBuffer.Create 10 in f bb; bb.Close() @@ -161,18 +161,18 @@ type ILStrongNameSigner = static member OpenPublicKeyOptions s p = PublicKeyOptionsSigner((Support.signerOpenPublicKeyFile s), p) - static member OpenPublicKey pubkey = PublicKeySigner(pubkey) + static member OpenPublicKey pubkey = PublicKeySigner pubkey static member OpenKeyPairFile s = KeyPair(Support.signerOpenKeyPairFile s) - static member OpenKeyContainer s = KeyContainer(s) + static member OpenKeyContainer s = KeyContainer s member s.Close() = match s with | PublicKeySigner _ | PublicKeyOptionsSigner _ | KeyPair _ -> () - | KeyContainer containerName -> Support.signerCloseKeyContainer(containerName) + | KeyContainer containerName -> Support.signerCloseKeyContainer containerName member s.IsFullySigned = match s with @@ -191,7 +191,7 @@ type ILStrongNameSigner = member s.SignatureSize = let pkSignatureSize pk = - try Support.signerSignatureSize(pk) + try Support.signerSignatureSize pk with e -> failwith ("A call to StrongNameSignatureSize failed ("+e.Message+")") 0x80 @@ -452,12 +452,12 @@ type MetadataTable<'T> = member tbl.AddSharedEntry x = let n = tbl.rows.Count + 1 tbl.dict.[x] <- n - tbl.rows.Add(x) + tbl.rows.Add x n member tbl.AddUnsharedEntry x = let n = tbl.rows.Count + 1 - tbl.rows.Add(x) + tbl.rows.Add x n member tbl.FindOrAddSharedEntry x = @@ -545,9 +545,9 @@ type TypeDefTableKey = TdKey of string list (* enclosing *) * string (* type nam type MetadataTable = | Shared of MetadataTable | Unshared of MetadataTable - member t.FindOrAddSharedEntry(x) = match t with Shared u -> u.FindOrAddSharedEntry(x) | Unshared u -> failwithf "FindOrAddSharedEntry: incorrect table kind, u.name = %s" u.name - member t.AddSharedEntry(x) = match t with | Shared u -> u.AddSharedEntry(x) | Unshared u -> failwithf "AddSharedEntry: incorrect table kind, u.name = %s" u.name - member t.AddUnsharedEntry(x) = match t with Unshared u -> u.AddUnsharedEntry(x) | Shared u -> failwithf "AddUnsharedEntry: incorrect table kind, u.name = %s" u.name + member t.FindOrAddSharedEntry x = match t with Shared u -> u.FindOrAddSharedEntry x | Unshared u -> failwithf "FindOrAddSharedEntry: incorrect table kind, u.name = %s" u.name + member t.AddSharedEntry x = match t with | Shared u -> u.AddSharedEntry x | Unshared u -> failwithf "AddSharedEntry: incorrect table kind, u.name = %s" u.name + member t.AddUnsharedEntry x = match t with Unshared u -> u.AddUnsharedEntry x | Shared u -> failwithf "AddUnsharedEntry: incorrect table kind, u.name = %s" u.name member t.GenericRowsOfTable = match t with Unshared u -> u.EntriesAsArray |> Array.map (fun x -> x.GenericRow) | Shared u -> u.EntriesAsArray |> Array.map (fun x -> x.GenericRow) member t.SetRowsOfSharedTable rows = match t with Shared u -> u.SetRowsOfTable (Array.map SharedRow rows) | Unshared u -> failwithf "SetRowsOfSharedTable: incorrect table kind, u.name = %s" u.name member t.Count = match t with Unshared u -> u.Count | Shared u -> u.Count @@ -709,10 +709,10 @@ let rec GetIdxForTypeDef cenv key = let rec GetAssemblyRefAsRow cenv (aref: ILAssemblyRef) = AssemblyRefRow - ((match aref.Version with None -> 0us | Some (version) -> version.Major), - (match aref.Version with None -> 0us | Some (version) -> version.Minor), - (match aref.Version with None -> 0us | Some (version) -> version.Build), - (match aref.Version with None -> 0us | Some (version) -> version.Revision), + ((match aref.Version with None -> 0us | Some version -> version.Major), + (match aref.Version with None -> 0us | Some version -> version.Minor), + (match aref.Version with None -> 0us | Some version -> version.Build), + (match aref.Version with None -> 0us | Some version -> version.Revision), ((match aref.PublicKey with Some (PublicKey _) -> 0x0001 | _ -> 0x0000) ||| (if aref.Retargetable then 0x0100 else 0x0000)), BlobIndex (match aref.PublicKey with @@ -1727,7 +1727,7 @@ module Codebuf = // Now apply the adjusted fixups in the new code newReqdBrFixups |> List.iter (fun (newFixupLoc, endOfInstr, tg, small) -> - match newAvailBrFixups.TryGetValue(tg) with + match newAvailBrFixups.TryGetValue tg with | true, n -> let relOffset = n - endOfInstr if small then @@ -2170,17 +2170,17 @@ module Codebuf = let pc2pos = Array.zeroCreate (instrs.Length+1) let pc2labs = Dictionary() for KeyValue (lab, pc) in code.Labels do - match pc2labs.TryGetValue(pc) with + match pc2labs.TryGetValue pc with | true, labels -> pc2labs.[pc] <- lab :: labels | _ -> pc2labs.[pc] <- [lab] // Emit the instructions for pc = 0 to instrs.Length do - match pc2labs.TryGetValue(pc) with + match pc2labs.TryGetValue pc with | true, labels -> for lab in labels do - codebuf.RecordAvailBrFixup(lab) + codebuf.RecordAvailBrFixup lab | _ -> () pc2pos.[pc] <- codebuf.code.Position if pc < instrs.Length then @@ -2822,10 +2822,10 @@ and GenExportedTypesPass3 cenv (ce: ILExportedTypesAndForwarders) = and GetManifsetAsAssemblyRow cenv m = UnsharedRow [|ULong m.AuxModuleHashAlgorithm - UShort (match m.Version with None -> 0us | Some (version) -> version.Major) - UShort (match m.Version with None -> 0us | Some (version) -> version.Minor) - UShort (match m.Version with None -> 0us | Some (version) -> version.Build) - UShort (match m.Version with None -> 0us | Some (version) -> version.Revision) + UShort (match m.Version with None -> 0us | Some version -> version.Major) + UShort (match m.Version with None -> 0us | Some version -> version.Minor) + UShort (match m.Version with None -> 0us | Some version -> version.Build) + UShort (match m.Version with None -> 0us | Some version -> version.Revision) ULong ( (match m.AssemblyLongevity with | ILAssemblyLongevity.Unspecified -> 0x0000 @@ -3563,9 +3563,9 @@ let writeBinaryAndReportMappings (outfile, let os = try // Ensure the output directory exists otherwise it will fail - let dir = Path.GetDirectoryName(outfile) - if not (Directory.Exists(dir)) then Directory.CreateDirectory(dir) |>ignore - new BinaryWriter(FileSystem.FileStreamCreateShim(outfile)) + let dir = Path.GetDirectoryName outfile + if not (Directory.Exists dir) then Directory.CreateDirectory dir |>ignore + new BinaryWriter(FileSystem.FileStreamCreateShim outfile) with e -> failwith ("Could not open file for writing (binary mode): " + outfile) @@ -3576,7 +3576,7 @@ let writeBinaryAndReportMappings (outfile, let alignVirt = modul.VirtualAlignment // FIXED CHOICE let alignPhys = modul.PhysicalAlignment // FIXED CHOICE - let isItanium = modul.Platform = Some(IA64) + let isItanium = modul.Platform = Some IA64 let numSections = 3 // .text, .sdata, .reloc @@ -3631,9 +3631,9 @@ let writeBinaryAndReportMappings (outfile, match ilg.primaryAssemblyScopeRef with | ILScopeRef.Local -> failwith "Expected mscorlib to be ILScopeRef.Assembly was ILScopeRef.Local" | ILScopeRef.Module(_) -> failwith "Expected mscorlib to be ILScopeRef.Assembly was ILScopeRef.Module" - | ILScopeRef.Assembly(aref) -> + | ILScopeRef.Assembly aref -> match aref.Version with - | Some (version) when version.Major = 2us -> parseILVersion "2.0.50727.0" + | Some version when version.Major = 2us -> parseILVersion "2.0.50727.0" | Some v -> v | None -> failwith "Expected msorlib to have a version number" @@ -3678,7 +3678,7 @@ let writeBinaryAndReportMappings (outfile, generatePortablePdb embedAllSource embedSourceList sourceLink showTimes pdbData deterministic if embeddedPDB then Some (compressPortablePdbStream uncompressedLength contentId stream) - else Some (pdbStream) + else Some pdbStream | _ -> None @@ -3699,7 +3699,7 @@ let writeBinaryAndReportMappings (outfile, chunk (align 0x4 (match pdbfile with | None -> 0 | Some f -> (24 - + System.Text.Encoding.Unicode.GetByteCount(f) // See bug 748444 + + System.Text.Encoding.Unicode.GetByteCount f // See bug 748444 + debugDataJustInCase))) next let debugEmbeddedPdbChunk, next = @@ -3745,7 +3745,7 @@ let writeBinaryAndReportMappings (outfile, unlinkResource linkedResourceBase linkedResource) begin - try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName(outfile)) + try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName outfile) with e -> failwith ("Linking a native resource failed: "+e.Message+"") end #endif @@ -3824,7 +3824,7 @@ let writeBinaryAndReportMappings (outfile, write (Some peFileHeaderChunk.addr) os "pe file header" [| |] - if (modul.Platform = Some(AMD64)) then + if (modul.Platform = Some AMD64) then writeInt32AsUInt16 os 0x8664 // Machine - IMAGE_FILE_MACHINE_AMD64 elif isItanium then writeInt32AsUInt16 os 0x200 @@ -4225,7 +4225,7 @@ let writeBinaryAndReportMappings (outfile, reportTime showTimes "Generate PDB Info" // Now we have the debug data we can go back and fill in the debug directory in the image - let fs2 = FileSystem.FileStreamWriteExistingShim(outfile) + let fs2 = FileSystem.FileStreamWriteExistingShim outfile let os2 = new BinaryWriter(fs2) try // write the IMAGE_DEBUG_DIRECTORY diff --git a/src/absil/ilwritepdb.fs b/src/absil/ilwritepdb.fs index 0ff7e74cc..756181daf 100644 --- a/src/absil/ilwritepdb.fs +++ b/src/absil/ilwritepdb.fs @@ -29,11 +29,11 @@ type BlobBuildingStream () = override this.CanWrite = true override this.CanRead = false override this.CanSeek = false - override this.Length = int64(builder.Count) + override this.Length = int64 (builder.Count) override this.Write(buffer: byte array, offset: int, count: int) = builder.WriteBytes(buffer, offset, count) - override this.WriteByte(value: byte) = builder.WriteByte(value) - member this.WriteInt32(value: int) = builder.WriteInt32(value) + override this.WriteByte(value: byte) = builder.WriteByte value + member this.WriteInt32(value: int) = builder.WriteInt32 value member this.ToImmutableArray() = builder.ToImmutableArray() member this.TryWriteBytes(stream: Stream, length: int) = builder.TryWriteBytes(stream, length) @@ -135,11 +135,11 @@ let pdbGetCvDebugInfo (mvid: byte[]) (timestamp: int32) (filepath: string) (cvCh let path = (System.Text.Encoding.UTF8.GetBytes filepath) let buffer = Array.zeroCreate (sizeof + mvid.Length + sizeof + path.Length + 1) let (offset, size) = (0, sizeof) // Magic Number RSDS dword: 0x53445352L - Buffer.BlockCopy(BitConverter.GetBytes(cvMagicNumber), 0, buffer, offset, size) + Buffer.BlockCopy(BitConverter.GetBytes cvMagicNumber, 0, buffer, offset, size) let (offset, size) = (offset + size, mvid.Length) // mvid Guid Buffer.BlockCopy(mvid, 0, buffer, offset, size) let (offset, size) = (offset + size, sizeof) // # of pdb files generated (1) - Buffer.BlockCopy(BitConverter.GetBytes(1), 0, buffer, offset, size) + Buffer.BlockCopy(BitConverter.GetBytes 1, 0, buffer, offset, size) let (offset, size) = (offset + size, path.Length) // Path to pdb string Buffer.BlockCopy(path, 0, buffer, offset, size) buffer @@ -157,7 +157,7 @@ let pdbGetPdbDebugInfo (embeddedPDBChunk: BinaryChunk) (uncompressedLength: int6 let iddPdbBuffer = let buffer = Array.zeroCreate (sizeof + sizeof + int(stream.Length)) let (offset, size) = (0, sizeof) // Magic Number dword: 0x4244504dL - Buffer.BlockCopy(BitConverter.GetBytes(pdbMagicNumber), 0, buffer, offset, size) + Buffer.BlockCopy(BitConverter.GetBytes pdbMagicNumber, 0, buffer, offset, size) let (offset, size) = (offset + size, sizeof) // Uncompressed size Buffer.BlockCopy(BitConverter.GetBytes((int uncompressedLength)), 0, buffer, offset, size) let (offset, size) = (offset + size, int(stream.Length)) // Uncompressed size @@ -186,9 +186,9 @@ let hashSizeOfMD5 = 16 // In this case, catch the failure, and not set a checksum. let checkSum (url: string) = try - use file = FileSystem.FileStreamReadShim(url) + use file = FileSystem.FileStreamReadShim url use md5 = System.Security.Cryptography.MD5.Create() - let checkSum = md5.ComputeHash(file) + let checkSum = md5.ComputeHash file Some (guidSourceHashMD5, checkSum) with _ -> None @@ -216,7 +216,7 @@ let sortMethods showTimes info = let getRowCounts tableRowCounts = let builder = ImmutableArray.CreateBuilder(tableRowCounts |> Array.length) - tableRowCounts |> Seq.iter(fun x -> builder.Add(x)) + tableRowCounts |> Seq.iter(fun x -> builder.Add x) builder.MoveToImmutable() let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (sourceLink: string) showTimes (info: PdbData) isDeterministic = @@ -235,13 +235,13 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s let separator = if (count name s1) >= (count name s2) then s1 else s2 let writer = new BlobBuilder() - writer.WriteByte(byte(separator)) + writer.WriteByte(byte separator) for part in name.Split( [| separator |] ) do - let partIndex = MetadataTokens.GetHeapOffset(BlobHandle.op_Implicit(metadata.GetOrAddBlobUTF8(part))) - writer.WriteCompressedInteger(int(partIndex)) + let partIndex = MetadataTokens.GetHeapOffset(BlobHandle.op_Implicit(metadata.GetOrAddBlobUTF8 part)) + writer.WriteCompressedInteger(int partIndex) - metadata.GetOrAddBlob(writer) + metadata.GetOrAddBlob writer let corSymLanguageTypeId = System.Guid(0xAB4F38C9u, 0xB6E6us, 0x43baus, 0xBEuy, 0x3Buy, 0x58uy, 0x08uy, 0x0Buy, 0x2Cuy, 0xCCuy, 0xE3uy) let embeddedSourceId = System.Guid(0x0e8a571bu, 0x6926us, 0x466eus, 0xb4uy, 0xaduy, 0x8auy, 0xb0uy, 0x46uy, 0x11uy, 0xf5uy, 0xfeuy) @@ -265,23 +265,23 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s if not embedAllSource && not isInList || not (File.Exists file) then None else - let stream = File.OpenRead(file) + let stream = File.OpenRead file let length64 = stream.Length - if length64 > int64(Int32.MaxValue) then raise (new IOException("File is too long")) + if length64 > int64 (Int32.MaxValue) then raise (new IOException("File is too long")) let builder = new BlobBuildingStream() - let length = int(length64) + let length = int length64 if length < sourceCompressionThreshold then - builder.WriteInt32(0) + builder.WriteInt32 0 builder.TryWriteBytes(stream, length) |> ignore else - builder.WriteInt32(length) |>ignore + builder.WriteInt32 length |>ignore use deflater = new DeflateStream(builder, CompressionMode.Compress, true) - stream.CopyTo(deflater) |> ignore + stream.CopyTo deflater |> ignore Some (builder.ToImmutableArray()) let mutable index = new Dictionary(docs.Length) - let docLength = docs.Length + if String.IsNullOrEmpty(sourceLink) then 1 else 0 + let docLength = docs.Length + if String.IsNullOrEmpty sourceLink then 1 else 0 metadata.SetCapacity(TableIndex.Document, docLength) for doc in docs do let handle = @@ -289,32 +289,32 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s | Some (hashAlg, checkSum) -> let dbgInfo = (serializeDocumentName doc.File, - metadata.GetOrAddGuid(hashAlg), + metadata.GetOrAddGuid hashAlg, metadata.GetOrAddBlob(checkSum.ToImmutableArray()), - metadata.GetOrAddGuid(corSymLanguageTypeId)) |> metadata.AddDocument + metadata.GetOrAddGuid corSymLanguageTypeId) |> metadata.AddDocument match includeSource doc.File with | None -> () | Some blob -> - metadata.AddCustomDebugInformation(DocumentHandle.op_Implicit(dbgInfo), - metadata.GetOrAddGuid(embeddedSourceId), - metadata.GetOrAddBlob(blob)) |> ignore + metadata.AddCustomDebugInformation(DocumentHandle.op_Implicit dbgInfo, + metadata.GetOrAddGuid embeddedSourceId, + metadata.GetOrAddBlob blob) |> ignore dbgInfo | None -> let dbgInfo = (serializeDocumentName doc.File, metadata.GetOrAddGuid(System.Guid.Empty), metadata.GetOrAddBlob(ImmutableArray.Empty), - metadata.GetOrAddGuid(corSymLanguageTypeId)) |> metadata.AddDocument + metadata.GetOrAddGuid corSymLanguageTypeId) |> metadata.AddDocument dbgInfo index.Add(doc.File, handle) - if not (String.IsNullOrEmpty(sourceLink)) then - let fs = File.OpenRead(sourceLink) + if not (String.IsNullOrEmpty sourceLink) then + let fs = File.OpenRead sourceLink let ms = new MemoryStream() - fs.CopyTo(ms) + fs.CopyTo ms metadata.AddCustomDebugInformation( ModuleDefinitionHandle.op_Implicit(EntityHandle.ModuleDefinition), - metadata.GetOrAddGuid(sourceLinkId), + metadata.GetOrAddGuid sourceLinkId, metadata.GetOrAddBlob(ms.ToArray())) |> ignore index @@ -400,26 +400,26 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s else offset if i < 1 || offsetDelta > 0 then - builder.WriteCompressedInteger(offsetDelta) + builder.WriteCompressedInteger offsetDelta // Hidden-sequence-point-record if startLine = 0xfeefee || endLine = 0xfeefee || (startColumn = 0 && endColumn = 0) then - builder.WriteCompressedInteger(0) - builder.WriteCompressedInteger(0) + builder.WriteCompressedInteger 0 + builder.WriteCompressedInteger 0 else // Non-hidden-sequence-point-record let deltaLines = endLine - startLine // lines - builder.WriteCompressedInteger(deltaLines) + builder.WriteCompressedInteger deltaLines let deltaColumns = endColumn - startColumn // Columns if deltaLines = 0 then - builder.WriteCompressedInteger(deltaColumns) + builder.WriteCompressedInteger deltaColumns else - builder.WriteCompressedSignedInteger(deltaColumns) + builder.WriteCompressedSignedInteger deltaColumns if previousNonHiddenStartLine < 0 then // delta Start Line & Column: - builder.WriteCompressedInteger(startLine) - builder.WriteCompressedInteger(startColumn) + builder.WriteCompressedInteger startLine + builder.WriteCompressedInteger startColumn else builder.WriteCompressedSignedInteger(startLine - previousNonHiddenStartLine) builder.WriteCompressedSignedInteger(startColumn - previousNonHiddenStartColumn) @@ -427,12 +427,12 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s previousNonHiddenStartLine <- startLine previousNonHiddenStartColumn <- startColumn - getDocumentHandle singleDocumentIndex, metadata.GetOrAddBlob(builder) + getDocumentHandle singleDocumentIndex, metadata.GetOrAddBlob builder metadata.AddMethodDebugInformation(docHandle, sequencePointBlob) |> ignore // Write the scopes - let nextHandle handle = MetadataTokens.LocalVariableHandle(MetadataTokens.GetRowNumber(LocalVariableHandle.op_Implicit(handle)) + 1) + let nextHandle handle = MetadataTokens.LocalVariableHandle(MetadataTokens.GetRowNumber(LocalVariableHandle.op_Implicit handle) + 1) let writeMethodScope scope = let scopeSorter (scope1: PdbMethodScope) (scope2: PdbMethodScope) = if scope1.StartOffset > scope2.StartOffset then 1 @@ -472,8 +472,8 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s let entryPoint = match info.EntryPoint with - | None -> MetadataTokens.MethodDefinitionHandle(0) - | Some x -> MetadataTokens.MethodDefinitionHandle(x) + | None -> MetadataTokens.MethodDefinitionHandle 0 + | Some x -> MetadataTokens.MethodDefinitionHandle x let deterministicIdProvider isDeterministic : System.Func, BlobContentId> = match isDeterministic with @@ -484,33 +484,33 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s let hash = content |> Seq.collect (fun c -> c.GetBytes().Array |> sha.ComputeHash) |> Array.ofSeq |> sha.ComputeHash - BlobContentId.FromHash(hash) + BlobContentId.FromHash hash System.Func, BlobContentId>( convert ) let serializer = PortablePdbBuilder(metadata, externalRowCounts, entryPoint, deterministicIdProvider isDeterministic) let blobBuilder = new BlobBuilder() - let contentId= serializer.Serialize(blobBuilder) + let contentId= serializer.Serialize blobBuilder let portablePdbStream = new MemoryStream() - blobBuilder.WriteContentTo(portablePdbStream) + blobBuilder.WriteContentTo portablePdbStream reportTime showTimes "PDB: Created" (portablePdbStream.Length, contentId, portablePdbStream) let compressPortablePdbStream (uncompressedLength: int64) (contentId: BlobContentId) (stream: MemoryStream) = let compressedStream = new MemoryStream() use compressionStream = new DeflateStream(compressedStream, CompressionMode.Compress,true) - stream.WriteTo(compressionStream) + stream.WriteTo compressionStream (uncompressedLength, contentId, compressedStream) let writePortablePdbInfo (contentId: BlobContentId) (stream: MemoryStream) showTimes fpdb cvChunk = try FileSystem.FileDelete fpdb with _ -> () use pdbFile = new FileStream(fpdb, FileMode.Create, FileAccess.ReadWrite) - stream.WriteTo(pdbFile) + stream.WriteTo pdbFile reportTime showTimes "PDB: Closed" pdbGetDebugInfo (contentId.Guid.ToByteArray()) (int32 (contentId.Stamp)) fpdb cvChunk None 0L None let embedPortablePdbInfo (uncompressedLength: int64) (contentId: BlobContentId) (stream: MemoryStream) showTimes fpdb cvChunk pdbChunk = reportTime showTimes "PDB: Closed" - let fn = Path.GetFileName(fpdb) + let fn = Path.GetFileName fpdb pdbGetDebugInfo (contentId.Guid.ToByteArray()) (int32 (contentId.Stamp)) fn cvChunk (Some pdbChunk) uncompressedLength (Some stream) #if !FX_NO_PDB_WRITER @@ -526,7 +526,7 @@ let writePdbInfo showTimes f fpdb info cvChunk = try pdbw := pdbInitialize f fpdb - with _ -> error(Error(FSComp.SR.ilwriteErrorCreatingPdb(fpdb), rangeCmdArgs)) + with _ -> error(Error(FSComp.SR.ilwriteErrorCreatingPdb fpdb, rangeCmdArgs)) match info.EntryPoint with | None -> () @@ -636,22 +636,22 @@ let (?) this memb (args:'Args) : 'R = // Get array of 'obj' arguments for the reflection call let args = if typeof<'Args> = typeof then [| |] - elif FSharpType.IsTuple typeof<'Args> then Microsoft.FSharp.Reflection.FSharpValue.GetTupleFields(args) + elif FSharpType.IsTuple typeof<'Args> then Microsoft.FSharp.Reflection.FSharpValue.GetTupleFields args else [| box args |] // Get methods and perform overload resolution let methods = this.GetType().GetMethods() let bestMatch = methods |> Array.tryFind (fun mi -> mi.Name = memb && mi.GetParameters().Length = args.Length) match bestMatch with - | Some(mi) -> unbox(mi.Invoke(this, args)) - | None -> error(Error(FSComp.SR.ilwriteMDBMemberMissing(memb), rangeCmdArgs)) + | Some mi -> unbox(mi.Invoke(this, args)) + | None -> error(Error(FSComp.SR.ilwriteMDBMemberMissing memb, rangeCmdArgs)) // Creating instances of needed classes from 'Mono.CompilerServices.SymbolWriter' assembly let monoCompilerSvc = new AssemblyName("Mono.CompilerServices.SymbolWriter, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756") let ctor (asmName: AssemblyName) clsName (args: obj[]) = - let asm = Assembly.Load(asmName) - let ty = asm.GetType(clsName) + let asm = Assembly.Load asmName + let ty = asm.GetType clsName System.Activator.CreateInstance(ty, args) let createSourceMethodImpl (name: string) (token: int) (namespaceID: int) = @@ -678,7 +678,7 @@ let writeMdbInfo fmdb f info = let docs = [| for doc in info.Documents do let doc = wr?DefineDocument(doc.File) - let unit = wr?DefineCompilationUnit(doc) + let unit = wr?DefineCompilationUnit doc yield doc, unit |] let getDocument i = @@ -707,11 +707,11 @@ let writeMdbInfo fmdb f info = for local in scope.Locals do wr?DefineLocalVariable(local.Index, local.Name) for child in scope.Children do - writeScope(child) + writeScope child wr?CloseScope(scope.EndOffset) match meth.RootScope with | None -> () - | Some rootscope -> writeScope(rootscope) + | Some rootscope -> writeScope rootscope // Finished generating debug information for the curretn method @@ -720,7 +720,7 @@ let writeMdbInfo fmdb f info = // Finalize - MDB requires the MVID of the generated .NET module let moduleGuid = new System.Guid(info.ModuleID |> Array.map byte) - wr?WriteSymbolFile(moduleGuid) + wr?WriteSymbolFile moduleGuid #endif //--------------------------------------------------------------------- diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index 17e01bdab..e9eceef9b 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -52,7 +52,7 @@ let rec private evalILAttribElem e = let rec private evalFSharpAttribArg g e = match e with - | Expr.Const(c, _, _) -> + | Expr.Const (c, _, _) -> match c with | Const.Bool b -> box b | Const.SByte i -> box i diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index c859fb638..876a2ddc3 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -81,20 +81,20 @@ let mkILLangPrimTy (g: TcGlobals) = mkILNonGenericBoxedTy g.tcref_LanguagePrimit let mkILCallGetComparer (g: TcGlobals) m = let ty = mkILNonGenericBoxedTy g.tcref_System_Collections_IComparer.CompiledRepresentationForNamedType let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g, "get_GenericComparer", [], ty) - mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.IComparer_ty], m) + mkAsmExpr ([IL.mkNormalCall mspec], [], [], [g.IComparer_ty], m) let mkILCallGetEqualityComparer (g: TcGlobals) m = let ty = mkILNonGenericBoxedTy g.tcref_System_Collections_IEqualityComparer.CompiledRepresentationForNamedType let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g, "get_GenericEqualityComparer", [], ty) - mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.IEqualityComparer_ty], m) + mkAsmExpr ([IL.mkNormalCall mspec], [], [], [g.IEqualityComparer_ty], m) let mkThisVar g m ty = mkCompGenLocal m "this" (mkThisTy g ty) -let mkShl g m acce n = mkAsmExpr([ IL.AI_shl ], [], [acce; mkInt g m n], [g.int_ty], m) +let mkShl g m acce n = mkAsmExpr ([ IL.AI_shl ], [], [acce; mkInt g m n], [g.int_ty], m) -let mkShr g m acce n = mkAsmExpr([ IL.AI_shr ], [], [acce; mkInt g m n], [g.int_ty], m) +let mkShr g m acce n = mkAsmExpr ([ IL.AI_shr ], [], [acce; mkInt g m n], [g.int_ty], m) -let mkAdd (g: TcGlobals) m e1 e2 = mkAsmExpr([ IL.AI_add ], [], [e1;e2], [g.int_ty], m) +let mkAdd (g: TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_add ], [], [e1;e2], [g.int_ty], m) let mkAddToHashAcc g m e accv acce = mkValSet m accv (mkAdd g m (mkInt g m 0x9e3779b9) @@ -208,8 +208,8 @@ let mkRecdCompare g tcref (tycon: Tycon) = let m = fref.Range mkCallGenericComparisonWithComparerOuter g m fty compe - (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m)) - (mkRecdFieldGetViaExprAddr(thataddre, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr (thise, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr (thataddre, fref, tinst, m)) let expr = mkCompareTestConjuncts g m (List.map mkTest fields) let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thataddre expr @@ -232,8 +232,8 @@ let mkRecdCompareWithComparer g tcref (tycon: Tycon) (_thisv, thise) (_, thate) let m = fref.Range mkCallGenericComparisonWithComparerOuter g m fty compe - (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m)) - (mkRecdFieldGetViaExprAddr(thataddre, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr (thise, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr (thataddre, fref, tinst, m)) let expr = mkCompareTestConjuncts g m (List.map mkTest fields) let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thate expr @@ -255,8 +255,8 @@ let mkRecdEquality g tcref (tycon: Tycon) = let fref = tcref.MakeNestedRecdFieldRef fspec let m = fref.Range mkCallGenericEqualityEROuter g m fty - (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m)) - (mkRecdFieldGetViaExprAddr(thataddre, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr (thise, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr (thataddre, fref, tinst, m)) let expr = mkEqualsTestConjuncts g m (List.map mkTest fields) let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThatNullEquals g m thise thataddre expr @@ -278,8 +278,8 @@ let mkRecdEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje ( mkCallGenericEqualityWithComparerOuter g m fty compe - (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m)) - (mkRecdFieldGetViaExprAddr(thataddre, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr (thise, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr (thataddre, fref, tinst, m)) let expr = mkEqualsTestConjuncts g m (List.map mkTest fields) let expr = mkBindThatAddr g m ty thataddrv thatv thate expr @@ -357,8 +357,8 @@ let mkUnionCompare g tcref (tycon: Tycon) = let mkTest thise thataddre j (argty: RecdField) = mkCallGenericComparisonWithComparerOuter g m argty.FormalType compe - (mkUnionCaseFieldGetProvenViaExprAddr(thise, cref, tinst, j, m)) - (mkUnionCaseFieldGetProvenViaExprAddr(thataddre, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr (thise, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr (thataddre, cref, tinst, j, m)) let test = if cref.Tycon.IsStructOrEnumTycon then mkCompareTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) @@ -416,8 +416,8 @@ let mkUnionCompareWithComparer g tcref (tycon: Tycon) (_thisv, thise) (_thatobjv let mkTest thise thataddre j (argty: RecdField) = mkCallGenericComparisonWithComparerOuter g m argty.FormalType compe - (mkUnionCaseFieldGetProvenViaExprAddr(thise, cref, tinst, j, m)) - (mkUnionCaseFieldGetProvenViaExprAddr(thataddre, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr (thise, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr (thataddre, cref, tinst, j, m)) let test = if cref.Tycon.IsStructOrEnumTycon then @@ -476,8 +476,8 @@ let mkUnionEquality g tcref (tycon: Tycon) = let mkTest thise thataddre j (argty: RecdField) = mkCallGenericEqualityEROuter g m argty.FormalType - (mkUnionCaseFieldGetProvenViaExprAddr(thise, cref, tinst, j, m)) - (mkUnionCaseFieldGetProvenViaExprAddr(thataddre, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr (thise, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr (thataddre, cref, tinst, j, m)) let test = if cref.Tycon.IsStructOrEnumTycon then @@ -537,8 +537,8 @@ let mkUnionEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje let mkTest thise thataddre j (argty: RecdField) = mkCallGenericEqualityWithComparerOuter g m argty.FormalType compe - (mkUnionCaseFieldGetProvenViaExprAddr(thise, cref, tinst, j, m)) - (mkUnionCaseFieldGetProvenViaExprAddr(thataddre, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr (thise, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr (thataddre, cref, tinst, j, m)) let test = if cref.Tycon.IsStructOrEnumTycon then @@ -593,7 +593,7 @@ let mkRecdHashWithComparer g tcref (tycon: Tycon) compe = let fty = fspec.FormalType let fref = tcref.MakeNestedRecdFieldRef fspec let m = fref.Range - let e = mkRecdFieldGetViaExprAddr(thise, fref, tinst, m) + let e = mkRecdFieldGetViaExprAddr (thise, fref, tinst, m) mkCallGenericHashWithComparerOuter g m fty compe e @@ -635,7 +635,7 @@ let mkUnionHashWithComparer g tcref (tycon: Tycon) compe = else let mkHash thise j (rfield: RecdField) = let fty = rfield.FormalType - let e = mkUnionCaseFieldGetProvenViaExprAddr(thise, c1ref, tinst, j, m) + let e = mkUnionCaseFieldGetProvenViaExprAddr (thise, c1ref, tinst, j, m) mkCallGenericHashWithComparerOuter g m fty compe e let test = @@ -715,68 +715,68 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = | _, _, None, None, None, None, None, None, None // [] on union/record/struct - | true, _, None, Some(true), None, None, None, Some(true), None + | true, _, None, Some true, None, None, None, Some true, None // [] on union/record/struct - | true, _, None, Some(true), None, None, Some(true), None, None -> + | true, _, None, Some true, None, None, Some true, None, None -> () // [] on union/record/struct - | true, _, None, None, Some(true), None, Some(true), None, None + | true, _, None, None, Some true, None, Some true, None, None // [] on union/record/struct - | true, _, None, None, Some(true), None, None, None, None -> + | true, _, None, None, Some true, None, None, None, None -> if isTrueFSharpStructTycon g tycon then errorR(Error(FSComp.SR.augNoRefEqualsOnStruct(), m)) else () // [] on union/record/struct - | true, true, None, None, None, Some(true), None, None, Some(true) + | true, true, None, None, None, Some true, None, None, Some true // [] - | true, _, None, None, None, Some(true), Some(true), None, None + | true, _, None, None, None, Some true, Some true, None, None // [] - | true, _, None, None, None, Some(true), None, Some(true), None + | true, _, None, None, None, Some true, None, Some true, None // [] on anything - | _, _, None, None, None, None, Some(true), None, None + | _, _, None, None, None, None, Some true, None, None // [] on anything - | _, _, Some(true), None, None, None, Some(true), None, None -> + | _, _, Some true, None, None, None, Some true, None, None -> () (* THESE ARE THE ERROR CASES *) // [] - | _, _, Some(true), _, _, _, None, _, _ -> + | _, _, Some true, _, _, _, None, _, _ -> errorR(Error(FSComp.SR.augNoEqualityNeedsNoComparison(), m)) // [] - | true, true, _, _, _, None, _, _, Some(true) -> + | true, true, _, _, _, None, _, _, Some true -> errorR(Error(FSComp.SR.augStructCompNeedsStructEquality(), m)) // [] - | true, _, _, _, _, Some(true), None, _, None -> + | true, _, _, _, _, Some true, None, _, None -> errorR(Error(FSComp.SR.augStructEqNeedsNoCompOrStructComp(), m)) // [] - | true, _, _, Some(true), _, _, None, None, _ -> + | true, _, _, Some true, _, _, None, None, _ -> errorR(Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp(), m)) // [] - | true, _, _, _, Some(true), Some(true), _, _, _ + | true, _, _, _, Some true, Some true, _, _, _ // [] - | true, _, _, _, Some(true), _, _, _, Some(true) -> + | true, _, _, _, Some true, _, _, _, Some true -> errorR(Error(FSComp.SR.augTypeCantHaveRefEqAndStructAttrs(), m)) // non augmented type, [] // non augmented type, [] // non augmented type, [] - | false, _, _, _, Some(true), _, _, _, _ - | false, _, _, _, _, Some(true), _, _, _ - | false, _, _, _, _, _, _, _, Some(true) -> + | false, _, _, _, Some true, _, _, _, _ + | false, _, _, _, _, Some true, _, _, _ + | false, _, _, _, _, _, _, _, Some true -> errorR(Error(FSComp.SR.augOnlyCertainTypesCanHaveAttrs(), m)) // All other cases | _ -> @@ -802,21 +802,21 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = match attribs with // [] + any equality semantics - | _, _, Some(true), _, _, _, _, _, _ when (hasExplicitEquals || hasExplicitGenericEquals) -> + | _, _, Some true, _, _, _, _, _, _ when (hasExplicitEquals || hasExplicitGenericEquals) -> warning(Error(FSComp.SR.augNoEqNeedsNoObjEquals(), m)) // [] + any comparison semantics - | _, _, _, _, _, _, Some(true), _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> + | _, _, _, _, _, _, Some true, _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> warning(Error(FSComp.SR.augNoCompCantImpIComp(), m)) // [] + no explicit override Object.Equals + no explicit IStructuralEquatable - | _, _, _, Some(true), _, _, _, _, _ when isImplementation && not hasExplicitEquals && not hasExplicitGenericEquals-> + | _, _, _, Some true, _, _, _, _, _ when isImplementation && not hasExplicitEquals && not hasExplicitGenericEquals-> errorR(Error(FSComp.SR.augCustomEqNeedsObjEquals(), m)) // [] + no explicit IComparable + no explicit IStructuralComparable - | _, _, _, _, _, _, _, Some(true), _ when isImplementation && not hasExplicitICompare && not hasExplicitIGenericCompare -> + | _, _, _, _, _, _, _, Some true, _ when isImplementation && not hasExplicitICompare && not hasExplicitIGenericCompare -> errorR(Error(FSComp.SR.augCustomCompareNeedsIComp(), m)) // [] + any equality semantics - | _, _, _, _, Some(true), _, _, _, _ when (hasExplicitEquals || hasExplicitIGenericCompare) -> + | _, _, _, _, Some true, _, _, _, _ when (hasExplicitEquals || hasExplicitIGenericCompare) -> errorR(Error(FSComp.SR.augRefEqCantHaveObjEquals(), m)) | _ -> @@ -831,9 +831,9 @@ let TyconIsCandidateForAugmentationWithCompare (g: TcGlobals) (tycon: Tycon) = // [< >] | true, true, None, None, None, None, None, None, None // [] - | true, true, None, None, None, Some(true), None, None, Some(true) + | true, true, None, None, None, Some true, None, None, Some true // [] - | true, true, None, None, None, None, None, None, Some(true) -> true + | true, true, None, None, None, None, None, None, Some true -> true // other cases | _ -> false @@ -848,7 +848,7 @@ let TyconIsCandidateForAugmentationWithEquals (g: TcGlobals) (tycon: Tycon) = | true, _, None, None, None, None, _, _, _ // [] // [] - | true, _, None, None, None, Some(true), _, _, _ -> true + | true, _, None, None, None, Some true, _, _, _ -> true // other cases | _ -> false @@ -885,13 +885,13 @@ let unaryArg = [ ValReprInfo.unnamedTopArg ] let tupArg = [ [ ValReprInfo.unnamedTopArg1; ValReprInfo.unnamedTopArg1 ] ] let mkValSpec g (tcref: TyconRef) tmty vis slotsig methn ty argData = let m = tcref.Range - let tps = tcref.Typars(m) + let tps = tcref.Typars m let final = isUnionTy g tmty || isRecdTy g tmty || isStructTy g tmty - let membInfo = match slotsig with None -> nonVirtualMethod tcref | Some(slotsig) -> slotImplMethod(final, tcref, slotsig) + let membInfo = match slotsig with None -> nonVirtualMethod tcref | Some slotsig -> slotImplMethod(final, tcref, slotsig) let inl = ValInline.Optional let args = ValReprInfo.unnamedTopArg :: argData let topValInfo = Some (ValReprInfo (ValReprInfo.InferTyparInfo tps, args, ValReprInfo.unnamedRetVal)) - NewVal (methn, m, None, ty, Immutable, true, topValInfo, vis, ValNotInRecScope, Some(membInfo), NormalVal, [], inl, XmlDoc.Empty, true, false, false, false, false, false, None, Parent(tcref)) + NewVal (methn, m, None, ty, Immutable, true, topValInfo, vis, ValNotInRecScope, Some membInfo, NormalVal, [], inl, XmlDoc.Empty, true, false, false, false, false, false, None, Parent tcref) let MakeValsForCompareAugmentation g (tcref: TyconRef) = let m = tcref.Range @@ -968,7 +968,7 @@ let MakeBindingsForCompareWithComparerAugmentation g (tycon: Tycon) = let mkCompare comparef = match tycon.GeneratedCompareToWithComparerValues with | None -> [] - | Some (vref) -> + | Some vref -> let vspec = vref.Deref let _, ty = mkMinimalTy g tcref @@ -1037,7 +1037,7 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) = let tcref = mkLocalTyconRef tycon let m = tycon.Range - let tps = tycon.Typars(m) + let tps = tycon.Typars m let mkEquals equalsf = match tycon.GeneratedHashAndEqualsValues with | None -> [] diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index e14df2d3f..4d13ffd07 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -96,7 +96,7 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = let rec RangeFromException = function | ErrorFromAddingConstraint(_, err2, _) -> RangeFromException err2 #if !NO_EXTENSIONTYPING - | ExtensionTyping.ProvidedTypeResolutionNoRange(e) -> RangeFromException e + | ExtensionTyping.ProvidedTypeResolutionNoRange e -> RangeFromException e | ExtensionTyping.ProvidedTypeResolution(m, _) #endif | ReservedKeyword(_, m) @@ -107,8 +107,8 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | FunctionExpected(_, _, m) | BakedInMemberConstraintName(_, m) | StandardOperatorRedefinitionWarning(_, m) - | BadEventTransformation(m) - | ParameterlessStructCtor(m) + | BadEventTransformation m + | ParameterlessStructCtor m | FieldNotMutable (_, _, m) | Recursion (_, _, _, _, m) | InvalidRuntimeCoercion(_, _, _, m) @@ -116,10 +116,10 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | IndeterminateStaticCoercion (_, _, _, m) | StaticCoercionShouldUseBox (_, _, _, m) | CoercionTargetSealed(_, _, m) - | UpcastUnnecessary(m) + | UpcastUnnecessary m | QuotationTranslator.IgnoringPartOfQuotedTermWarning (_, m) - | TypeTestUnnecessary(m) + | TypeTestUnnecessary m | RuntimeCoercionSourceSealed(_, _, m) | OverrideDoesntOverride(_, _, _, _, _, m) | UnionPatternsBindDifferentNames m @@ -132,7 +132,7 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | UnitTypeExpectedWithPossiblePropertySetter (_, _, _, _, m) | UnitTypeExpectedWithPossibleAssignment (_, _, _, _, m) | UseOfAddressOfOperator m - | DeprecatedThreadStaticBindingWarning(m) + | DeprecatedThreadStaticBindingWarning m | NonUniqueInferredAbstractSlot (_, _, _, _, _, m) | DefensiveCopyWarning (_, m) | LetRecCheckedAtRuntime m @@ -154,10 +154,10 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | ValNotMutable(_, _, m) | ValNotLocal(_, _, m) | MissingFields(_, m) - | OverrideInIntrinsicAugmentation(m) - | IntfImplInIntrinsicAugmentation(m) - | OverrideInExtrinsicAugmentation(m) - | IntfImplInExtrinsicAugmentation(m) + | OverrideInIntrinsicAugmentation m + | IntfImplInIntrinsicAugmentation m + | OverrideInExtrinsicAugmentation m + | IntfImplInExtrinsicAugmentation m | ValueRestriction(_, _, _, _, m) | LetRecUnsound (_, _, m) | ObsoleteError (_, m) @@ -166,9 +166,9 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | PossibleUnverifiableCode m | UserCompilerMessage (_, _, m) | Deprecated(_, m) - | LibraryUseOnly(m) + | LibraryUseOnly m | FieldsFromDifferentTypes (_, _, _, m) - | IndeterminateType(m) + | IndeterminateType m | TyconBadArgs(_, _, _, m) -> Some m @@ -177,7 +177,7 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | ConstrNotContained(_, aval, _, _) -> Some aval.Id.idRange | ExnconstrNotContained(_, aexnc, _, _) -> Some aexnc.Range - | VarBoundTwice(id) + | VarBoundTwice id | UndefinedName(_, _, id, _) -> Some id.idRange @@ -186,8 +186,8 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | UnresolvedOverloading(_, _, _, m) | UnresolvedConversionOperator (_, _, _, m) | PossibleOverload(_, _, _, m) - | VirtualAugmentationOnNullValuedType(m) - | NonVirtualAugmentationOnNullValuedType(m) + | VirtualAugmentationOnNullValuedType m + | NonVirtualAugmentationOnNullValuedType m | NonRigidTypar(_, _, _, _, _, m) | ConstraintSolverTupleDiffLengths(_, _, _, m, _) | ConstraintSolverInfiniteTypes(_, _, _, _, m, _) @@ -214,16 +214,16 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | DeprecatedCommandLineOptionSuggestAlternative(_, _, m) | DeprecatedCommandLineOptionNoDescription(_, m) | InternalCommandLineOption(_, m) - | HashIncludeNotAllowedInNonScript(m) - | HashReferenceNotAllowedInNonScript(m) - | HashDirectiveNotAllowedInNonScript(m) + | HashIncludeNotAllowedInNonScript m + | HashReferenceNotAllowedInNonScript m + | HashDirectiveNotAllowedInNonScript m | FileNameNotResolved(_, _, m) | LoadedSourceNotFoundIgnoring(_, m) | MSBuildReferenceResolutionWarning(_, _, m) | MSBuildReferenceResolutionError(_, _, m) | AssemblyNotResolved(_, m) | HashLoadedSourceHasIssues(_, _, m) - | HashLoadedScriptConsideredSource(m) -> + | HashLoadedScriptConsideredSource m -> Some m // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e -> @@ -401,7 +401,7 @@ let warningOn err level specificWarnOn = | _ -> level >= GetWarningLevel err let SplitRelatedDiagnostics(err: PhasedDiagnostic) = - let ToPhased(e) = {Exception=e; Phase = err.Phase} + let ToPhased e = {Exception=e; Phase = err.Phase} let rec SplitRelatedException = function | UnresolvedOverloading(a, overloads, b, c) -> let related = overloads |> List.map ToPhased @@ -428,7 +428,7 @@ let SplitRelatedDiagnostics(err: PhasedDiagnostic) = | :? System.Reflection.TargetInvocationException as e -> SplitRelatedException e.InnerException | e -> - ToPhased(e), [] + ToPhased e, [] SplitRelatedException(err.Exception) @@ -649,10 +649,10 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = os.Append(FSComp.SR.arrayElementHasWrongType(t1, t2)) |> ignore else os.Append(FSComp.SR.listElementHasWrongType(t1, t2)) |> ignore - | ContextInfo.OmittedElseBranch range when range = m -> os.Append(FSComp.SR.missingElseBranch(t2)) |> ignore + | ContextInfo.OmittedElseBranch range when range = m -> os.Append(FSComp.SR.missingElseBranch t2) |> ignore | ContextInfo.ElseBranchResult range when range = m -> os.Append(FSComp.SR.elseBranchHasWrongType(t1, t2)) |> ignore | ContextInfo.FollowingPatternMatchClause range when range = m -> os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType(t1, t2)) |> ignore - | ContextInfo.PatternMatchGuard range when range = m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool(t2)) |> ignore + | ContextInfo.PatternMatchGuard range when range = m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool t2) |> ignore | _ -> os.Append(ConstraintSolverTypesNotInEqualityRelation2E().Format t1 t2) |> ignore if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore @@ -686,10 +686,10 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = os.Append(FSComp.SR.arrayElementHasWrongType(t1, t2)) |> ignore else os.Append(FSComp.SR.listElementHasWrongType(t1, t2)) |> ignore - | ContextInfo.OmittedElseBranch range when range = m -> os.Append(FSComp.SR.missingElseBranch(t2)) |> ignore + | ContextInfo.OmittedElseBranch range when range = m -> os.Append(FSComp.SR.missingElseBranch t2) |> ignore | ContextInfo.ElseBranchResult range when range = m -> os.Append(FSComp.SR.elseBranchHasWrongType(t1, t2)) |> ignore | ContextInfo.FollowingPatternMatchClause range when range = m -> os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType(t1, t2)) |> ignore - | ContextInfo.PatternMatchGuard range when range = m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool(t2)) |> ignore + | ContextInfo.PatternMatchGuard range when range = m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool t2) |> ignore | ContextInfo.TupleInRecordFields -> os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore os.Append(System.Environment.NewLine + FSComp.SR.commaInsteadOfSemicolonInRecord()) |> ignore @@ -745,7 +745,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = OutputExceptionR os e #if !NO_EXTENSIONTYPING - | ExtensionTyping.ProvidedTypeResolutionNoRange(e) + | ExtensionTyping.ProvidedTypeResolutionNoRange e | ExtensionTyping.ProvidedTypeResolution(_, e) -> OutputExceptionR os e @@ -755,7 +755,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = #endif | UnresolvedOverloading(_, _, mtext, _) -> - os.Append(mtext) |> ignore + os.Append mtext |> ignore | UnresolvedConversionOperator(denv, fromTy, toTy, _) -> let t1, t2, _tpcs = NicePrint.minimalStringsOfTwoTypes denv fromTy toTy @@ -778,7 +778,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = os.Append(BakedInMemberConstraintNameE().Format nm) |> ignore | StandardOperatorRedefinitionWarning(msg, _) -> - os.Append(msg) |> ignore + os.Append msg |> ignore | BadEventTransformation(_) -> os.Append(BadEventTransformationE().Format) |> ignore @@ -831,7 +831,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | InternalUndefinedItemRef(f, smr, ccuName, s) -> let _, errs = f(smr, ccuName, s) - os.Append(errs) |> ignore + os.Append errs |> ignore | FieldNotMutable _ -> os.Append(FieldNotMutableE().Format) |> ignore @@ -839,7 +839,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | FieldsFromDifferentTypes (_, fref1, fref2, _) -> os.Append(FieldsFromDifferentTypesE().Format fref1.FieldName fref2.FieldName) |> ignore - | VarBoundTwice(id) -> + | VarBoundTwice id -> os.Append(VarBoundTwiceE().Format (DecompileOpName id.idText)) |> ignore | Recursion (denv, id, ty1, ty2, _) -> @@ -1360,7 +1360,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = os.Append(NonUniqueInferredAbstractSlot3E().Format t1 t2) |> ignore os.Append(NonUniqueInferredAbstractSlot4E().Format) |> ignore - | Error ((_, s), _) -> os.Append(s) |> ignore + | Error ((_, s), _) -> os.Append s |> ignore | ErrorWithSuggestions ((_, s), _, idText, suggestionF) -> os.Append(DecompileOpName s) |> ignore @@ -1368,7 +1368,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = if List.isEmpty filtered |> not then os.Append(ErrorResolutionHints.FormatPredictions DecompileOpName filtered) |> ignore - | NumberedError ((_, s), _) -> os.Append(s) |> ignore + | NumberedError ((_, s), _) -> os.Append s |> ignore | InternalError (s, _) @@ -1426,7 +1426,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | PossibleUnverifiableCode _ -> os.Append(PossibleUnverifiableCodeE().Format) |> ignore - | UserCompilerMessage (msg, _, _) -> os.Append(msg) |> ignore + | UserCompilerMessage (msg, _, _) -> os.Append msg |> ignore | Deprecated(s, _) -> os.Append(DeprecatedE().Format s) |> ignore @@ -1450,7 +1450,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = v.DisplayName) |> ignore else match v.MemberInfo with - | Some(membInfo) when + | Some membInfo when begin match membInfo.MemberFlags.MemberKind with | MemberKind.PropertyGet | MemberKind.PropertySet @@ -1487,7 +1487,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | UnresolvedReferenceError(assemblyname, _) - | UnresolvedReferenceNoRange(assemblyname) -> + | UnresolvedReferenceNoRange assemblyname -> os.Append(UnresolvedReferenceNoRangeE().Format assemblyname) |> ignore | UnresolvedPathReference(assemblyname, pathname, _) @@ -1496,19 +1496,19 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = os.Append(UnresolvedPathReferenceNoRangeE().Format pathname assemblyname) |> ignore | DeprecatedCommandLineOptionFull(fullText, _) -> - os.Append(fullText) |> ignore + os.Append fullText |> ignore | DeprecatedCommandLineOptionForHtmlDoc(optionName, _) -> - os.Append(FSComp.SR.optsDCLOHtmlDoc(optionName)) |> ignore + os.Append(FSComp.SR.optsDCLOHtmlDoc optionName) |> ignore | DeprecatedCommandLineOptionSuggestAlternative(optionName, altOption, _) -> os.Append(FSComp.SR.optsDCLODeprecatedSuggestAlternative(optionName, altOption)) |> ignore | InternalCommandLineOption(optionName, _) -> - os.Append(FSComp.SR.optsInternalNoDescription(optionName)) |> ignore + os.Append(FSComp.SR.optsInternalNoDescription optionName) |> ignore | DeprecatedCommandLineOptionNoDescription(optionName, _) -> - os.Append(FSComp.SR.optsDCLONoDescription(optionName)) |> ignore + os.Append(FSComp.SR.optsDCLONoDescription optionName) |> ignore | HashIncludeNotAllowedInNonScript(_) -> os.Append(HashIncludeNotAllowedInNonScriptE().Format) |> ignore @@ -1533,10 +1533,10 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = OutputExceptionR os (List.head l) if errors=[] then os.Append(HashLoadedSourceHasIssues1E().Format) |> ignore - Emit(warnings) + Emit warnings else os.Append(HashLoadedSourceHasIssues2E().Format) |> ignore - Emit(errors) + Emit errors | HashLoadedScriptConsideredSource(_) -> os.Append(HashLoadedScriptConsideredSourceE().Format) |> ignore @@ -1588,7 +1588,7 @@ let OutputPhasedDiagnostic (os: System.Text.StringBuilder) (err: PhasedDiagnosti OutputPhasedErrorR buf err let s = if flattenErrors then ErrorLogger.NormalizeErrorString (buf.ToString()) else buf.ToString() - os.Append(s) |> ignore + os.Append s |> ignore let SanitizeFileName fileName implicitIncludeDir = // The assert below is almost ok, but it fires in two cases: @@ -1596,13 +1596,13 @@ let SanitizeFileName fileName implicitIncludeDir = // - if you have a #line directive, e.g. // # 1000 "Line01.fs" // then it also asserts. But these are edge cases that can be fixed later, e.g. in bug 4651. - //System.Diagnostics.Debug.Assert(FileSystem.IsPathRootedShim(fileName), sprintf "filename should be absolute: '%s'" fileName) + //System.Diagnostics.Debug.Assert(FileSystem.IsPathRootedShim fileName, sprintf "filename should be absolute: '%s'" fileName) try - let fullPath = FileSystem.GetFullPathShim(fileName) + let fullPath = FileSystem.GetFullPathShim fileName let currentDir = implicitIncludeDir // if the file name is not rooted in the current directory, return the full path - if not(fullPath.StartsWithOrdinal(currentDir)) then + if not(fullPath.StartsWithOrdinal currentDir) then fullPath // if the file name is rooted in the current directory, return the relative path else @@ -1690,7 +1690,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt | _ -> let errors = ResizeArray() let report err = - let OutputWhere(err) = + let OutputWhere err = match GetRangeOfDiagnostic err with | Some m -> Some(outputWhere (showFullPaths, errorStyle) m) | None -> None @@ -1704,7 +1704,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} let mainError, relatedErrors = SplitRelatedDiagnostics err - let where = OutputWhere(mainError) + let where = OutputWhere mainError let canonical = OutputCanonicalInformation(err.Subcategory(), GetDiagnosticNumber mainError) let message = let os = System.Text.StringBuilder() @@ -1719,7 +1719,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt match errorStyle with // Give a canonical string when --vserror. | ErrorStyle.VSErrors -> - let relWhere = OutputWhere(mainError) // mainError? + let relWhere = OutputWhere mainError // mainError? let relCanonical = OutputCanonicalInformation(err.Subcategory(), GetDiagnosticNumber mainError) // Use main error for code let relMessage = let os = System.Text.StringBuilder() @@ -1790,9 +1790,9 @@ let (++) x s = x @ [s] /// Will return None if the filename is not found. let TryResolveFileUsingPaths(paths, m, name) = let () = - try FileSystem.IsPathRootedShim(name) |> ignore + try FileSystem.IsPathRootedShim name |> ignore with :? System.ArgumentException as e -> error(Error(FSComp.SR.buildProblemWithFilename(name, e.Message), m)) - if FileSystem.IsPathRootedShim(name) && FileSystem.SafeExists name + if FileSystem.IsPathRootedShim name && FileSystem.SafeExists name then Some name else let res = paths |> List.tryPick (fun path -> @@ -1804,7 +1804,7 @@ let TryResolveFileUsingPaths(paths, m, name) = /// Will raise FileNameNotResolved if the filename was not found let ResolveFileUsingPaths(paths, m, name) = match TryResolveFileUsingPaths(paths, m, name) with - | Some(res) -> res + | Some res -> res | None -> let searchMessage = String.concat "\n " paths raise (FileNameNotResolved(name, searchMessage, m)) @@ -1819,14 +1819,14 @@ let GetWarningNumber(m, s: string) = elif s.StartsWithOrdinal("FS") = true then raise (new ArgumentException()) else None with err -> - warning(Error(FSComp.SR.buildInvalidWarningNumber(s), m)) + warning(Error(FSComp.SR.buildInvalidWarningNumber s, m)) None let ComputeMakePathAbsolute implicitIncludeDir (path: string) = try // remove any quotation marks from the path first let path = path.Replace("\"", "") - if not (FileSystem.IsPathRootedShim(path)) + if not (FileSystem.IsPathRootedShim path) then Path.Combine (implicitIncludeDir, path) else path with @@ -1855,19 +1855,19 @@ type VersionFlag = | VersionString of string | VersionFile of string | VersionNone - member x.GetVersionInfo(implicitIncludeDir) = - let vstr = x.GetVersionString(implicitIncludeDir) + member x.GetVersionInfo implicitIncludeDir = + let vstr = x.GetVersionString implicitIncludeDir try IL.parseILVersion vstr - with _ -> errorR(Error(FSComp.SR.buildInvalidVersionString(vstr), rangeStartup)); IL.parseILVersion "0.0.0.0" + with _ -> errorR(Error(FSComp.SR.buildInvalidVersionString vstr, rangeStartup)); IL.parseILVersion "0.0.0.0" - member x.GetVersionString(implicitIncludeDir) = + member x.GetVersionString implicitIncludeDir = match x with | VersionString s -> s | VersionFile s -> - let s = if FileSystem.IsPathRootedShim(s) then s else Path.Combine(implicitIncludeDir, s) - if not(FileSystem.SafeExists(s)) then - errorR(Error(FSComp.SR.buildInvalidVersionFile(s), rangeStartup)); "0.0.0.0" + let s = if FileSystem.IsPathRootedShim s then s else Path.Combine(implicitIncludeDir, s) + if not(FileSystem.SafeExists s) then + errorR(Error(FSComp.SR.buildInvalidVersionFile s, rangeStartup)); "0.0.0.0" else use is = System.IO.File.OpenText s is.ReadLine() @@ -1902,11 +1902,11 @@ type TimeStampCache(defaultTimeStamp: DateTime) = let files = Dictionary() let projects = Dictionary(HashIdentity.Reference) member cache.GetFileTimeStamp fileName = - let ok, v = files.TryGetValue(fileName) + let ok, v = files.TryGetValue fileName if ok then v else let v = try - FileSystem.GetLastWriteTimeShim(fileName) + FileSystem.GetLastWriteTimeShim fileName with | :? FileNotFoundException -> defaultTimeStamp @@ -1914,7 +1914,7 @@ type TimeStampCache(defaultTimeStamp: DateTime) = v member cache.GetProjectReferenceTimeStamp (pr: IProjectReference, ctok) = - let ok, v = projects.TryGetValue(pr) + let ok, v = projects.TryGetValue pr if ok then v else let v = defaultArg (pr.TryGetLogicalTimeStamp (cache, ctok)) defaultTimeStamp projects.[pr] <- v @@ -1942,7 +1942,7 @@ type AssemblyReference = member x.Range = (let (AssemblyReference(m, _, _)) = x in m) member x.Text = (let (AssemblyReference(_, text, _)) = x in text) member x.ProjectReference = (let (AssemblyReference(_, _, contents)) = x in contents) - member x.SimpleAssemblyNameIs(name) = + member x.SimpleAssemblyNameIs name = (String.Compare(fileNameWithoutExtensionWithValidate false x.Text, name, StringComparison.OrdinalIgnoreCase) = 0) || (let text = x.Text.ToLowerInvariant() not (text.Contains "/") && not (text.Contains "\\") && not (text.Contains ".dll") && not (text.Contains ".exe") && @@ -2280,9 +2280,9 @@ type TcConfigBuilder = static member CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, reduceMemoryUsage, implicitIncludeDir, isInteractive, isInvalidationSupported, defaultCopyFSharpCore, tryGetMetadataSnapshot) = - Debug.Assert(FileSystem.IsPathRootedShim(implicitIncludeDir), sprintf "implicitIncludeDir should be absolute: '%s'" implicitIncludeDir) + Debug.Assert(FileSystem.IsPathRootedShim implicitIncludeDir, sprintf "implicitIncludeDir should be absolute: '%s'" implicitIncludeDir) - if (String.IsNullOrEmpty(defaultFSharpBinariesDir)) then + if (String.IsNullOrEmpty defaultFSharpBinariesDir) then failwith "Expected a valid defaultFSharpBinariesDir" { TcConfigBuilder.Initial with @@ -2333,7 +2333,7 @@ type TcConfigBuilder = error(Error(FSComp.SR.buildPdbRequiresDebug(), rangeStartup)) else None - tcConfigB.outputFile <- Some(outfile) + tcConfigB.outputFile <- Some outfile outfile, pdbfile, assemblyName member tcConfigB.TurnWarningOff(m, s: string) = @@ -2360,23 +2360,23 @@ type TcConfigBuilder = let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path let ok = let existsOpt = - try Some(Directory.Exists(absolutePath)) - with e -> warning(Error(FSComp.SR.buildInvalidSearchDirectory(path), m)); None + try Some(Directory.Exists absolutePath) + with e -> warning(Error(FSComp.SR.buildInvalidSearchDirectory path, m)); None match existsOpt with - | Some(exists) -> - if not exists then warning(Error(FSComp.SR.buildSearchDirectoryNotFound(absolutePath), m)) + | Some exists -> + if not exists then warning(Error(FSComp.SR.buildSearchDirectoryNotFound absolutePath, m)) exists | None -> false if ok && not (List.contains absolutePath tcConfigB.includes) then tcConfigB.includes <- tcConfigB.includes ++ absolutePath member tcConfigB.AddLoadedSource(m, path, pathLoadedFrom) = - if FileSystem.IsInvalidPathShim(path) then - warning(Error(FSComp.SR.buildInvalidFilename(path), m)) + if FileSystem.IsInvalidPathShim path then + warning(Error(FSComp.SR.buildInvalidFilename path, m)) else let path = match TryResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom], m, path) with - | Some(path) -> path + | Some path -> path | None -> // File doesn't exist in the paths. Assume it will be in the load-ed from directory. ComputeMakePathAbsolute pathLoadedFrom path @@ -2390,8 +2390,8 @@ type TcConfigBuilder = tcConfigB.embedResources <- tcConfigB.embedResources ++ filename member tcConfigB.AddReferencedAssemblyByPath (m, path) = - if FileSystem.IsInvalidPathShim(path) then - warning(Error(FSComp.SR.buildInvalidAssemblyName(path), m)) + if FileSystem.IsInvalidPathShim path then + warning(Error(FSComp.SR.buildInvalidAssemblyName path, m)) elif not (tcConfigB.referencedDLLs |> List.exists (fun ar2 -> m=ar2.Range && path=ar2.Text)) then // NOTE: We keep same paths if range is different. let projectReference = tcConfigB.projectReferences |> List.tryPick (fun pr -> if pr.FileName = path then Some pr else None) tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs ++ AssemblyReference(m, path, projectReference) @@ -2410,7 +2410,7 @@ type TcConfigBuilder = let pubpri = String.sub rest (p+1) (rest.Length - p - 1) if pubpri = "public" then file, name, ILResourceAccess.Public elif pubpri = "private" then file, name, ILResourceAccess.Private - else error(Error(FSComp.SR.buildInvalidPrivacy(pubpri), rangeStartup)) + else error(Error(FSComp.SR.buildInvalidPrivacy pubpri, rangeStartup)) else file, rest, ILResourceAccess.Public else @@ -2458,19 +2458,19 @@ type AssemblyResolution = /// is cached. /// /// For project references in the language service, this would result in a build of the project. - /// This is because ``EvaluateRawContents(ctok)`` is used. However this path is only currently used + /// This is because ``EvaluateRawContents ctok`` is used. However this path is only currently used /// in fsi.fs, which does not use project references. // member this.GetILAssemblyRef(ctok, reduceMemoryUsage, tryGetMetadataSnapshot) = cancellable { match !this.ilAssemblyRef with - | Some(assemblyRef) -> return assemblyRef + | Some assemblyRef -> return assemblyRef | None -> let! assemblyRefOpt = cancellable { match this.ProjectReference with | Some r -> - let! contents = r.EvaluateRawContents(ctok) + let! contents = r.EvaluateRawContents ctok match contents with | None -> return None | Some contents -> @@ -2491,7 +2491,7 @@ type AssemblyResolution = tryGetMetadataSnapshot = tryGetMetadataSnapshot } use reader = OpenILModuleReader this.resolvedPath readerSettings mkRefToILAssembly reader.ILModuleDef.ManifestOfAssembly - this.ilAssemblyRef := Some(assemblyRef) + this.ilAssemblyRef := Some assemblyRef return assemblyRef } @@ -2529,33 +2529,33 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = // Validate the inputs - this helps ensure errors in options are shown in visual studio rather than only when built // However we only validate a minimal number of options at the moment - do if validate then try data.version.GetVersionInfo(data.implicitIncludeDir) |> ignore with e -> errorR(e) + do if validate then try data.version.GetVersionInfo(data.implicitIncludeDir) |> ignore with e -> errorR e // clone the input builder to ensure nobody messes with it. let data = { data with pause = data.pause } - let computeKnownDllReference(libraryName) = + let computeKnownDllReference libraryName = let defaultCoreLibraryReference = AssemblyReference(range0, libraryName+".dll", None) let nameOfDll(r: AssemblyReference) = let filename = ComputeMakePathAbsolute data.implicitIncludeDir r.Text - if FileSystem.SafeExists(filename) then - r, Some(filename) + if FileSystem.SafeExists filename then + r, Some filename else // If the file doesn't exist, let reference resolution logic report the error later... - defaultCoreLibraryReference, if r.Range =rangeStartup then Some(filename) else None + defaultCoreLibraryReference, if r.Range =rangeStartup then Some filename else None match data.referencedDLLs |> List.filter (fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) with | [r] -> nameOfDll r | [] -> defaultCoreLibraryReference, None | r:: _ -> // Recover by picking the first one. - errorR(Error(FSComp.SR.buildMultipleReferencesNotAllowed(libraryName), rangeCmdArgs)) - nameOfDll(r) + errorR(Error(FSComp.SR.buildMultipleReferencesNotAllowed libraryName, rangeCmdArgs)) + nameOfDll r // Look for an explicit reference to mscorlib and use that to compute clrRoot and targetFrameworkVersion let primaryAssemblyReference, primaryAssemblyExplicitFilenameOpt = computeKnownDllReference(data.primaryAssembly.Name) let fslibReference, fslibExplicitFilenameOpt = - let (_, fileNameOpt) as res = computeKnownDllReference(getFSharpCoreLibraryName) + let (_, fileNameOpt) as res = computeKnownDllReference getFSharpCoreLibraryName match fileNameOpt with | None -> // if FSharp.Core was not provided explicitly - use version that was referenced by compiler @@ -2583,7 +2583,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = | Some primaryAssemblyFilename -> let filename = ComputeMakePathAbsolute data.implicitIncludeDir primaryAssemblyFilename try - let clrRoot = Some(Path.GetDirectoryName(FileSystem.GetFullPathShim(filename))) + let clrRoot = Some(Path.GetDirectoryName(FileSystem.GetFullPathShim filename)) clrRoot, data.legacyReferenceResolver.HighestInstalledNetFrameworkVersion() with e -> // We no longer expect the above to fail but leaving this just in case @@ -2617,7 +2617,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) - let fslibRoot = Path.GetDirectoryName(FileSystem.GetFullPathShim(filename)) + let fslibRoot = Path.GetDirectoryName(FileSystem.GetFullPathShim filename) fslibRoot | _ -> data.defaultFSharpBinariesDir @@ -2782,9 +2782,9 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = // // In the current way of doing things, F# Interactive refers to implementation assemblies. yield runtimeRoot - if Directory.Exists(runtimeRootFacades) then + if Directory.Exists runtimeRootFacades then yield runtimeRootFacades // System.Runtime.dll is in /usr/lib/mono/4.5/Facades - if Directory.Exists(runtimeRootWPF) then + if Directory.Exists runtimeRootWPF then yield runtimeRootWPF // PresentationCore.dll is in C:\Windows\Microsoft.NET\Framework\v4.0.30319\WPF | ResolutionEnvironment.EditingOrCompilation _ -> @@ -2795,16 +2795,16 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = // On Mono, the default references come from the implementation assemblies. // This is because we have had trouble reliably using MSBuild APIs to compute DotNetFrameworkReferenceAssembliesRootDirectory on Mono. yield runtimeRoot - if Directory.Exists(runtimeRootFacades) then + if Directory.Exists runtimeRootFacades then yield runtimeRootFacades // System.Runtime.dll is in /usr/lib/mono/4.5/Facades - if Directory.Exists(runtimeRootWPF) then + if Directory.Exists runtimeRootWPF then yield runtimeRootWPF // PresentationCore.dll is in C:\Windows\Microsoft.NET\Framework\v4.0.30319\WPF // On Mono we also add a default reference to the 4.5-api and 4.5-api/Facades directories. let runtimeRootApi = runtimeRootWithoutSlash + "-api" let runtimeRootApiFacades = Path.Combine(runtimeRootApi, "Facades") - if Directory.Exists(runtimeRootApi) then + if Directory.Exists runtimeRootApi then yield runtimeRootApi - if Directory.Exists(runtimeRootApiFacades) then + if Directory.Exists runtimeRootApiFacades then yield runtimeRootApiFacades else #endif @@ -2815,23 +2815,23 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let frameworkRootVersion = Path.Combine(frameworkRoot, tcConfig.targetFrameworkVersion) yield frameworkRootVersion let facades = Path.Combine(frameworkRootVersion, "Facades") - if Directory.Exists(facades) then + if Directory.Exists facades then yield facades ] with e -> errorRecovery e range0; [] - member tcConfig.ComputeLightSyntaxInitialStatus(filename) = + member tcConfig.ComputeLightSyntaxInitialStatus filename = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter let lower = String.lowercase filename let lightOnByDefault = List.exists (Filename.checkSuffix lower) FSharpLightSyntaxFileSuffixes - if lightOnByDefault then (tcConfig.light <> Some(false)) else (tcConfig.light = Some(true) ) + if lightOnByDefault then (tcConfig.light <> Some false) else (tcConfig.light = Some true ) member tcConfig.GetAvailableLoadedSources() = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter let resolveLoadedSource (m, path) = try - if not(FileSystem.SafeExists(path)) then + if not(FileSystem.SafeExists path) then error(LoadedSourceNotFoundIgnoring(path, m)) None else Some(m, path) @@ -2874,7 +2874,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter // Only want to resolve certain extensions (otherwise, 'System.Xml' is ambiguous). // MSBuild resolution is limited to .exe and .dll so do the same here. - let ext = System.IO.Path.GetExtension(nm) + let ext = System.IO.Path.GetExtension nm let isNetModule = String.Compare(ext, ".netmodule", StringComparison.OrdinalIgnoreCase)=0 // See if the language service has already produced the contents of the assembly for us, virtually @@ -2906,7 +2906,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let resolved = TryResolveFileUsingPaths(searchPaths, m, nm) match resolved with - | Some(resolved) -> + | Some resolved -> let sysdir = tcConfig.IsSystemAssembly resolved Some { originalReference = r @@ -2914,7 +2914,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = prepareToolTip = (fun () -> let fusionName = System.Reflection.AssemblyName.GetAssemblyName(resolved).ToString() let line(append: string) = append.Trim([|' '|])+"\n" - line(resolved) + line(fusionName)) + line resolved + line fusionName) sysdir = sysdir ilAssemblyRef = ref None } | None -> None @@ -2924,7 +2924,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let m, nm = r.Range, r.Text use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter // test for both libraries and executables - let ext = System.IO.Path.GetExtension(nm) + let ext = System.IO.Path.GetExtension nm let isExe = (String.Compare(ext, ".exe", StringComparison.OrdinalIgnoreCase) = 0) let isDLL = (String.Compare(ext, ".dll", StringComparison.OrdinalIgnoreCase) = 0) let isNetModule = (String.Compare(ext, ".netmodule", StringComparison.OrdinalIgnoreCase) = 0) @@ -2936,7 +2936,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = [AssemblyReference(m, nm+".dll", None);AssemblyReference(m, nm+".exe", None);AssemblyReference(m, nm+".netmodule", None)] match rs |> List.tryPick (fun r -> tcConfig.TryResolveLibWithDirectories r) with - | Some(res) -> Some res + | Some res -> Some res | None -> match ccuLoadFaulureAction with | CcuLoadFailureAction.RaiseError -> @@ -2996,9 +2996,9 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let targetProcessorArchitecture = match tcConfig.platform with | None -> "MSIL" - | Some(X86) -> "x86" - | Some(AMD64) -> "amd64" - | Some(IA64) -> "ia64" + | Some X86 -> "x86" + | Some AMD64 -> "amd64" + | Some IA64 -> "ia64" // First, try to resolve everything as a file using simple resolution let resolvedAsFile = @@ -3183,7 +3183,7 @@ let QualFileNameOfImpls filename specs = | [SynModuleOrNamespace(_, _, kind, _, _, _, _, m)] when not kind.IsModule -> QualFileNameOfFilename m filename | _ -> QualFileNameOfFilename (mkRange filename pos0 pos0) filename -let PrepandPathToQualFileName x (QualifiedNameOfFile(q)) = ComputeQualifiedNameOfFileFromUniquePath (q.idRange, pathOfLid x@[q.idText]) +let PrepandPathToQualFileName x (QualifiedNameOfFile q) = ComputeQualifiedNameOfFileFromUniquePath (q.idRange, pathOfLid x@[q.idText]) let PrepandPathToImpl x (SynModuleOrNamespace(p, b, c, d, e, f, g, h)) = SynModuleOrNamespace(x@p, b, c, d, e, f, g, h) let PrepandPathToSpec x (SynModuleOrNamespaceSig(p, b, c, d, e, f, g, h)) = SynModuleOrNamespaceSig(x@p, b, c, d, e, f, g, h) @@ -3194,7 +3194,7 @@ let PrependPathToInput x inp = let ComputeAnonModuleName check defaultNamespace filename (m: range) = let modname = CanonicalizeFilename filename - if check && not (modname |> String.forall (fun c -> System.Char.IsLetterOrDigit(c) || c = '_')) then + if check && not (modname |> String.forall (fun c -> System.Char.IsLetterOrDigit c || c = '_')) then if not (filename.EndsWith("fsx", StringComparison.OrdinalIgnoreCase) || filename.EndsWith("fsscript", StringComparison.OrdinalIgnoreCase)) then warning(Error(FSComp.SR.buildImplicitModuleIsNotLegalIdentifier(modname, (fileNameOfPath filename)), m)) let combined = @@ -3270,7 +3270,7 @@ let PostParseModuleSpec (_i, defaultNamespace, isLastCompiland, filename, intf) let PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, ParsedImplFile(hashDirectives, impls)) = - match impls |> List.rev |> List.tryPick (function ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid, _, _, _, _, _, _, _)) -> Some(lid) | _ -> None) with + match impls |> List.rev |> List.tryPick (function ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid, _, _, _, _, _, _, _)) -> Some lid | _ -> None) with | Some lid when impls.Length > 1 -> errorR(Error(FSComp.SR.buildMultipleToplevelModules(), rangeOfLid lid)) | _ -> @@ -3290,7 +3290,7 @@ let PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, ParsedImp ParsedInput.ImplFile(ParsedImplFileInput(filename, isScript, qualName, scopedPragmas, hashDirectives, impls, isLastCompiland)) let PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, ParsedSigFile(hashDirectives, specs)) = - match specs |> List.rev |> List.tryPick (function ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid, _, _, _, _, _, _, _)) -> Some(lid) | _ -> None) with + match specs |> List.rev |> List.tryPick (function ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid, _, _, _, _, _, _, _)) -> Some lid | _ -> None) with | Some lid when specs.Length > 1 -> errorR(Error(FSComp.SR.buildMultipleToplevelModules(), rangeOfLid lid)) | _ -> @@ -3347,7 +3347,7 @@ let ParseInput (lexer, errorLogger: ErrorLogger, lexbuf: UnicodeLexing.Lexbuf, d // - if you have a #line directive, e.g. // # 1000 "Line01.fs" // then it also asserts. But these are edge cases that can be fixed later, e.g. in bug 4651. - //System.Diagnostics.Debug.Assert(System.IO.Path.IsPathRooted(filename), sprintf "should be absolute: '%s'" filename) + //System.Diagnostics.Debug.Assert(System.IO.Path.IsPathRooted filename, sprintf "should be absolute: '%s'" filename) let lower = String.lowercase filename // Delay sending errors and warnings until after the file is parsed. This gives us a chance to scrape the // #nowarn declarations for the file @@ -3367,13 +3367,13 @@ let ParseInput (lexer, errorLogger: ErrorLogger, lexbuf: UnicodeLexing.Lexbuf, d let intfs = Parser.signatureFile lexer lexbuf PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, intfs) else - delayLogger.Error(Error(FSComp.SR.buildInvalidSourceFileExtension(filename), Range.rangeStartup)) + delayLogger.Error(Error(FSComp.SR.buildInvalidSourceFileExtension filename, Range.rangeStartup)) scopedPragmas <- GetScopedPragmasForInput input input finally // OK, now commit the errors, since the ScopedPragmas will (hopefully) have been scraped let filteringErrorLogger = ErrorLoggerFilteringByScopedPragmas(false, scopedPragmas, errorLogger) - delayLogger.CommitDelayedDiagnostics(filteringErrorLogger) + delayLogger.CommitDelayedDiagnostics filteringErrorLogger //---------------------------------------------------------------------------- // parsing - ParseOneInputFile @@ -3383,7 +3383,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp use unwindbuildphase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse try let skip = true in (* don't report whitespace from lexer *) - let lightSyntaxStatus = LightSyntaxStatus (tcConfig.ComputeLightSyntaxInitialStatus(filename), true) + let lightSyntaxStatus = LightSyntaxStatus (tcConfig.ComputeLightSyntaxInitialStatus filename, true) let lexargs = mkLexargs (filename, conditionalCompilationDefines@tcConfig.conditionalCompilationDefines, lightSyntaxStatus, lexResourceManager, ref [], errorLogger) let shortFilename = SanitizeFileName filename tcConfig.implicitIncludeDir let input = @@ -3432,8 +3432,8 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompil try let lower = String.lowercase filename if List.exists (Filename.checkSuffix lower) (FSharpSigFileSuffixes@FSharpImplFileSuffixes) then - if not(FileSystem.SafeExists(filename)) then - error(Error(FSComp.SR.buildCouldNotFindSourceFile(filename), rangeStartup)) + if not(FileSystem.SafeExists filename) then + error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup)) // bug 3155: if the file name is indirect, use a full path let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(filename, tcConfig.inputCodePage, retryLocked) ParseOneInputLexbuf(tcConfig, lexResourceManager, conditionalCompilationDefines, lexbuf, filename, isLastCompiland, errorLogger) @@ -3448,10 +3448,10 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list, let resolvedPathToResolution = results |> List.map (fun r -> r.resolvedPath, r) |> Map.ofList /// Add some resolutions to the map of resolution results. - member tcResolutions.AddResolutionResults(newResults) = TcAssemblyResolutions(tcConfig, results @ newResults, unresolved) + member tcResolutions.AddResolutionResults newResults = TcAssemblyResolutions(tcConfig, results @ newResults, unresolved) /// Add some unresolved results. - member tcResolutions.AddUnresolvedReferences(newUnresolved) = TcAssemblyResolutions(tcConfig, results, unresolved @ newUnresolved) + member tcResolutions.AddUnresolvedReferences newUnresolved = TcAssemblyResolutions(tcConfig, results, unresolved @ newUnresolved) /// Get information about referenced DLLs member tcResolutions.GetAssemblyResolutions() = results @@ -3555,24 +3555,24 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list, //-------------------------------------------------------------------------- let IsSignatureDataResource (r: ILResource) = - r.Name.StartsWithOrdinal(FSharpSignatureDataResourceName) || - r.Name.StartsWithOrdinal(FSharpSignatureDataResourceName2) + r.Name.StartsWithOrdinal FSharpSignatureDataResourceName || + r.Name.StartsWithOrdinal FSharpSignatureDataResourceName2 let IsOptimizationDataResource (r: ILResource) = - r.Name.StartsWithOrdinal(FSharpOptimizationDataResourceName)|| - r.Name.StartsWithOrdinal(FSharpOptimizationDataResourceName2) + r.Name.StartsWithOrdinal FSharpOptimizationDataResourceName|| + r.Name.StartsWithOrdinal FSharpOptimizationDataResourceName2 let GetSignatureDataResourceName (r: ILResource) = - if r.Name.StartsWithOrdinal(FSharpSignatureDataResourceName) then + if r.Name.StartsWithOrdinal FSharpSignatureDataResourceName then String.dropPrefix r.Name FSharpSignatureDataResourceName - elif r.Name.StartsWithOrdinal(FSharpSignatureDataResourceName2) then + elif r.Name.StartsWithOrdinal FSharpSignatureDataResourceName2 then String.dropPrefix r.Name FSharpSignatureDataResourceName2 else failwith "GetSignatureDataResourceName" let GetOptimizationDataResourceName (r: ILResource) = - if r.Name.StartsWithOrdinal(FSharpOptimizationDataResourceName) then + if r.Name.StartsWithOrdinal FSharpOptimizationDataResourceName then String.dropPrefix r.Name FSharpOptimizationDataResourceName - elif r.Name.StartsWithOrdinal(FSharpOptimizationDataResourceName2) then + elif r.Name.StartsWithOrdinal FSharpOptimizationDataResourceName2 then String.dropPrefix r.Name FSharpOptimizationDataResourceName2 else failwith "GetOptimizationDataResourceName" @@ -3622,8 +3622,8 @@ let WriteOptimizationData (tcGlobals, file, inMem, ccu: CcuThunk, modulInfo) = type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyRefs) = let externalSigAndOptData = ["FSharp.Core"] interface IRawFSharpAssemblyData with - member __.GetAutoOpenAttributes(ilg) = GetAutoOpenAttributes ilg ilModule - member __.GetInternalsVisibleToAttributes(ilg) = GetInternalsVisibleToAttributes ilg ilModule + member __.GetAutoOpenAttributes ilg = GetAutoOpenAttributes ilg ilModule + member __.GetInternalsVisibleToAttributes ilg = GetInternalsVisibleToAttributes ilg ilModule member __.TryGetILModuleDef() = Some ilModule member __.GetRawFSharpSignatureData(m, ilShortAssemName, filename) = let resources = ilModule.Resources.AsList @@ -3667,7 +3667,7 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR member __.HasAnyFSharpSignatureDataAttribute = let attrs = GetCustomAttributesOfILModule ilModule List.exists IsSignatureDataVersionAttr attrs - member __.HasMatchingFSharpSignatureDataAttribute(ilg) = + member __.HasMatchingFSharpSignatureDataAttribute ilg = let attrs = GetCustomAttributesOfILModule ilModule List.exists (IsMatchingSignatureDataVersionAttr ilg (IL.parseILVersion Internal.Utilities.FSharpEnvironment.FSharpBinaryMetadataFormatRevision)) attrs @@ -3677,7 +3677,7 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR //-------------------------------------------------------------------------- let availableToOptionalCcu = function - | ResolvedCcu(ccu) -> Some(ccu) + | ResolvedCcu ccu -> Some ccu | UnresolvedCcu _ -> None @@ -3689,14 +3689,14 @@ let availableToOptionalCcu = function /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. type TcConfigProvider = | TcConfigProvider of (CompilationThreadToken -> TcConfig) - member x.Get(ctok) = (let (TcConfigProvider(f)) = x in f ctok) + member x.Get ctok = (let (TcConfigProvider f) = x in f ctok) /// Get a TcConfigProvider which will return only the exact TcConfig. - static member Constant(tcConfig) = TcConfigProvider(fun _ctok -> tcConfig) + static member Constant tcConfig = TcConfigProvider(fun _ctok -> tcConfig) /// Get a TcConfigProvider which will continue to respect changes in the underlying /// TcConfigBuilder rather than delivering snapshots. - static member BasedOnMutableBuilder(tcConfigB) = TcConfigProvider(fun _ctok -> TcConfig.Create(tcConfigB, validate=false)) + static member BasedOnMutableBuilder tcConfigB = TcConfigProvider(fun _ctok -> TcConfig.Create(tcConfigB, validate=false)) //---------------------------------------------------------------------------- @@ -3732,7 +3732,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu | Some entity -> entity.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind n - match (Some ccu.Contents, nsname) ||> List.fold(matchNameSpace) with + match (Some ccu.Contents, nsname) ||> List.fold matchNameSpace with | Some ns -> match Map.tryFind tname ns.ModuleOrNamespaceType.TypesByMangledName with | Some _ -> true @@ -3751,13 +3751,13 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu CheckDisposed() dllTable - member tcImports.RegisterCcu(ccuInfo) = + member tcImports.RegisterCcu ccuInfo = CheckDisposed() ccuInfos <- ccuInfos ++ ccuInfo // Assembly Ref Resolution: remove this use of ccu.AssemblyName ccuTable <- NameMap.add (ccuInfo.FSharpViewOfMetadata.AssemblyName) ccuInfo ccuTable - member tcImports.RegisterDll(dllInfo) = + member tcImports.RegisterDll dllInfo = CheckDisposed() dllInfos <- dllInfos ++ dllInfo dllTable <- NameMap.add (getNameOfScopeRef dllInfo.ILScopeRef) dllInfo dllTable @@ -3765,24 +3765,24 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu member tcImports.GetDllInfos() = CheckDisposed() match importsBase with - | Some(importsBase)-> importsBase.GetDllInfos() @ dllInfos + | Some importsBase-> importsBase.GetDllInfos() @ dllInfos | None -> dllInfos member tcImports.AllAssemblyResolutions() = CheckDisposed() let ars = resolutions.GetAssemblyResolutions() match importsBase with - | Some(importsBase)-> importsBase.AllAssemblyResolutions() @ ars + | Some importsBase-> importsBase.AllAssemblyResolutions() @ ars | None -> ars member tcImports.TryFindDllInfo (ctok: CompilationThreadToken, m, assemblyName, lookupOnly) = CheckDisposed() let rec look (t: TcImports) = match NameMap.tryFind assemblyName t.DllTable with - | Some res -> Some(res) + | Some res -> Some res | None -> match t.Base with - | Some t2 -> look(t2) + | Some t2 -> look t2 | None -> None match look tcImports with | Some res -> Some res @@ -3794,12 +3794,12 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu member tcImports.FindDllInfo (ctok, m, assemblyName) = match tcImports.TryFindDllInfo (ctok, m, assemblyName, lookupOnly=false) with | Some res -> res - | None -> error(Error(FSComp.SR.buildCouldNotResolveAssembly(assemblyName), m)) + | None -> error(Error(FSComp.SR.buildCouldNotResolveAssembly assemblyName, m)) member tcImports.GetImportedAssemblies() = CheckDisposed() match importsBase with - | Some(importsBase)-> List.append (importsBase.GetImportedAssemblies()) ccuInfos + | Some importsBase-> List.append (importsBase.GetImportedAssemblies()) ccuInfos | None -> ccuInfos member tcImports.GetCcusExcludingBase() = @@ -3815,31 +3815,31 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu CheckDisposed() let rec look (t: TcImports) = match NameMap.tryFind assemblyName t.CcuTable with - | Some res -> Some(res) + | Some res -> Some res | None -> match t.Base with | Some t2 -> look t2 | None -> None match look tcImports with - | Some res -> ResolvedImportedAssembly(res) + | Some res -> ResolvedImportedAssembly res | None -> tcImports.ImplicitLoadIfAllowed(ctok, m, assemblyName, lookupOnly) match look tcImports with - | Some res -> ResolvedImportedAssembly(res) - | None -> UnresolvedImportedAssembly(assemblyName) + | Some res -> ResolvedImportedAssembly res + | None -> UnresolvedImportedAssembly assemblyName member tcImports.FindCcu (ctok, m, assemblyName, lookupOnly) = CheckDisposed() match tcImports.FindCcuInfo(ctok, m, assemblyName, lookupOnly) with - | ResolvedImportedAssembly(importedAssembly) -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) - | UnresolvedImportedAssembly(assemblyName) -> UnresolvedCcu(assemblyName) + | ResolvedImportedAssembly importedAssembly -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) + | UnresolvedImportedAssembly assemblyName -> UnresolvedCcu assemblyName member tcImports.FindCcuFromAssemblyRef(ctok, m, assemblyRef: ILAssemblyRef) = CheckDisposed() match tcImports.FindCcuInfo(ctok, m, assemblyRef.Name, lookupOnly=false) with - | ResolvedImportedAssembly(importedAssembly) -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) + | ResolvedImportedAssembly importedAssembly -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) | UnresolvedImportedAssembly _ -> UnresolvedCcu(assemblyRef.QualifiedName) @@ -3862,8 +3862,8 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let g = tcImports.GetTcGlobals() let ilScopeRef = ILScopeRef.Assembly (ILAssemblyRef.FromAssemblyName aname) let fileName = aname.Name + ".dll" - let bytes = assembly.PApplyWithProvider((fun (assembly, provider) -> assembly.GetManifestModuleContents(provider)), m).PUntaint(id, m) - let tcConfig = tcConfigP.Get(ctok) + let bytes = assembly.PApplyWithProvider((fun (assembly, provider) -> assembly.GetManifestModuleContents provider), m).PUntaint(id, m) + let tcConfig = tcConfigP.Get ctok let ilModule, ilAssemblyRefs = let opts: ILReaderOptions = { ilGlobals = g.ilg @@ -3883,7 +3883,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu ProviderGeneratedStaticLinkMap= if g.isInteractive then None else Some (ProvidedAssemblyStaticLinkingMap.CreateNew()) ILScopeRef = ilScopeRef ILAssemblyRefs = ilAssemblyRefs } - tcImports.RegisterDll(dllinfo) + tcImports.RegisterDll dllinfo let ccuData: CcuData = { IsFSharp=false UsesFSharp20PlusQuotations=false @@ -3909,7 +3909,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu IsProviderGenerated = true TypeProviders=[] FSharpOptimizationData = notlazy None } - tcImports.RegisterCcu(ccuinfo) + tcImports.RegisterCcu ccuinfo // Yes, it is generative true, dllinfo.ProviderGeneratedStaticLinkMap @@ -3929,7 +3929,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu |> Seq.toList #endif - member tcImports.AttachDisposeAction(action) = + member tcImports.AttachDisposeAction action = CheckDisposed() disposeActions <- action :: disposeActions @@ -3938,7 +3938,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu member tcImports.OpenILBinaryModule(ctok, filename, m) = try CheckDisposed() - let tcConfig = tcConfigP.Get(ctok) + let tcConfig = tcConfigP.Get ctok let pdbDirPath = // We open the pdb file if one exists parallel to the binary we // are reading, so that --standalone will preserve debug information. @@ -3946,7 +3946,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let pdbDir = try Filename.directoryName filename with _ -> "." let pdbFile = (try Filename.chopExtension filename with _ -> filename) + ".pdb" - if FileSystem.SafeExists(pdbFile) then + if FileSystem.SafeExists pdbFile then if verbose then dprintf "reading PDB file %s from directory %s\n" pdbFile pdbDir Some pdbDir else @@ -3975,11 +3975,11 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let auxModTable = HashMultiMap(10, HashIdentity.Structural) fun viewedScopeRef -> - let tcConfig = tcConfigP.Get(ctok) + let tcConfig = tcConfigP.Get ctok match viewedScopeRef with | ILScopeRef.Module modref -> let key = modref.Name - if not (auxModTable.ContainsKey(key)) then + if not (auxModTable.ContainsKey key) then let resolution = tcConfig.ResolveLibWithDirectories (CcuLoadFailureAction.RaiseError, AssemblyReference(m, key, None)) |> Option.get let ilModule, _ = tcImports.OpenILBinaryModule(ctok, resolution.resolvedPath, m) auxModTable.[key] <- ilModule @@ -4044,14 +4044,14 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu match remainingNamespace with | next::rest -> // Inject the namespace entity - match entity.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryFind(next) with + match entity.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryFind next with | Some childEntity -> tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, childEntity, next::injectedNamspace, rest, provider, st) | None -> // Build up the artificial namespace if there is not a real one. let cpath = CompPath(ILScopeRef.Local, injectedNamspace |> List.rev |> List.map (fun n -> (n, ModuleOrNamespaceKind.Namespace)) ) let newNamespace = NewModuleOrNamespace (Some cpath) taccessPublic (ident(next, rangeStartup)) XmlDoc.Empty [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType Namespace)) - entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation(newNamespace) + entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation newNamespace tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, newNamespace, next::injectedNamspace, rest, provider, st) | [] -> match st with @@ -4063,7 +4063,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let importProvidedType t = Import.ImportProvidedType (tcImports.GetImportMap()) m t let isSuppressRelocate = tcConfig.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate), m) let newEntity = Construct.NewProvidedTycon(typeProviderEnvironment, st, importProvidedType, isSuppressRelocate, m) - entity.ModuleOrNamespaceType.AddProvidedTypeEntity(newEntity) + entity.ModuleOrNamespaceType.AddProvidedTypeEntity newEntity | None -> () entity.entity_tycon_repr <- @@ -4099,7 +4099,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu |> List.map (function null -> fileNameOfRuntimeAssembly | s -> s) // For each simple name of a design-time assembly, we take the first matching one in the order they are // specified in the attributes - |> List.distinctBy (fun s -> try Path.GetFileNameWithoutExtension(s) with _ -> s) + |> List.distinctBy (fun s -> try Path.GetFileNameWithoutExtension s with _ -> s) if not (List.isEmpty designTimeAssemblyNames) then @@ -4124,7 +4124,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu // failing function when the object is disposed. let systemRuntimeContainsType = // NOTE: do not touch this - let systemRuntimeContainsTypeRef = ref (fun typeName -> tcImports.SystemRuntimeContainsType(typeName)) + let systemRuntimeContainsTypeRef = ref (fun typeName -> tcImports.SystemRuntimeContainsType typeName) tcImports.AttachDisposeAction(fun () -> systemRuntimeContainsTypeRef := (fun _ -> raise (System.ObjectDisposedException("The type provider has been disposed")))) fun arg -> systemRuntimeContainsTypeRef.Value arg @@ -4210,7 +4210,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu member tcImports.PrepareToImportReferencedILAssembly (ctok, m, filename, dllinfo: ImportedBinary) = CheckDisposed() - let tcConfig = tcConfigP.Get(ctok) + let tcConfig = tcConfigP.Get ctok assert dllinfo.RawMetadata.TryGetILModuleDef().IsSome let ilModule = dllinfo.RawMetadata.TryGetILModuleDef().Value let ilScopeRef = dllinfo.ILScopeRef @@ -4237,18 +4237,18 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu TypeProviders = [] #endif FSharpOptimizationData = notlazy None } - tcImports.RegisterCcu(ccuinfo) + tcImports.RegisterCcu ccuinfo let phase2 () = #if !NO_EXTENSIONTYPING ccuinfo.TypeProviders <- tcImports.ImportTypeProviderExtensions (ctok, tcConfig, filename, ilScopeRef, ilModule.ManifestOfAssembly.CustomAttrs.AsList, ccu.Contents, invalidateCcu, m) #endif - [ResolvedImportedAssembly(ccuinfo)] + [ResolvedImportedAssembly ccuinfo] phase2 member tcImports.PrepareToImportReferencedFSharpAssembly (ctok, m, filename, dllinfo: ImportedBinary) = CheckDisposed() #if !NO_EXTENSIONTYPING - let tcConfig = tcConfigP.Get(ctok) + let tcConfig = tcConfigP.Get ctok #endif let ilModule = dllinfo.RawMetadata let ilScopeRef = dllinfo.ILScopeRef @@ -4306,8 +4306,8 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let ilg = defaultArg ilGlobalsOpt EcmaMscorlibILGlobals let ccuinfo = { FSharpViewOfMetadata=ccu - AssemblyAutoOpenAttributes = ilModule.GetAutoOpenAttributes(ilg) - AssemblyInternalsVisibleToAttributes = ilModule.GetInternalsVisibleToAttributes(ilg) + AssemblyAutoOpenAttributes = ilModule.GetAutoOpenAttributes ilg + AssemblyInternalsVisibleToAttributes = ilModule.GetInternalsVisibleToAttributes ilg FSharpOptimizationData=optdata #if !NO_EXTENSIONTYPING IsProviderGenerated = false @@ -4347,7 +4347,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let! contentsOpt = cancellable { match r.ProjectReference with - | Some ilb -> return! ilb.EvaluateRawContents(ctok) + | Some ilb -> return! ilb.EvaluateRawContents ctok | None -> return None } @@ -4376,12 +4376,12 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu #endif ILScopeRef = ilScopeRef ILAssemblyRefs = assemblyData.ILAssemblyRefs } - tcImports.RegisterDll(dllinfo) + tcImports.RegisterDll dllinfo let ilg = defaultArg ilGlobalsOpt EcmaMscorlibILGlobals let phase2 = if assemblyData.HasAnyFSharpSignatureDataAttribute then - if not (assemblyData.HasMatchingFSharpSignatureDataAttribute(ilg)) then - errorR(Error(FSComp.SR.buildDifferentVersionMustRecompile(filename), m)) + if not (assemblyData.HasMatchingFSharpSignatureDataAttribute ilg) then + errorR(Error(FSComp.SR.buildDifferentVersionMustRecompile filename, m)) tcImports.PrepareToImportReferencedILAssembly (ctok, m, filename, dllinfo) else try @@ -4420,7 +4420,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu CheckDisposed() // If the user is asking for the default framework then also try to resolve other implicit assemblies as they are discovered. // Using this flag to mean 'allow implicit discover of assemblies'. - let tcConfig = tcConfigP.Get(ctok) + let tcConfig = tcConfigP.Get ctok if not lookupOnly && tcConfig.implicitlyResolveAssemblies then let tryFile speculativeFileName = let foundFile = tcImports.TryResolveAssemblyReference (ctok, AssemblyReference (m, speculativeFileName, None), ResolveAssemblyReferenceMode.Speculative) @@ -4455,7 +4455,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu resolutions.TryFindByExactILAssemblyRef (ctok, assemblyRef) |> Option.map (fun r -> r.resolvedPath) member tcImports.TryResolveAssemblyReference(ctok, assemblyReference: AssemblyReference, mode: ResolveAssemblyReferenceMode) : OperationResult = - let tcConfig = tcConfigP.Get(ctok) + let tcConfig = tcConfigP.Get ctok // First try to lookup via the original reference text. match resolutions.TryFindByOriginalReference assemblyReference with | Some assemblyResolution -> @@ -4465,7 +4465,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu try ResultD [tcConfig.ResolveLibWithDirectories assemblyReference] with e -> - ErrorD(e) + ErrorD e #else // Next try to lookup up by the exact full resolved path. match resolutions.TryFindByResolvedPath assemblyReference.Text with @@ -4513,7 +4513,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu static member BuildFrameworkTcImports (ctok, tcConfigP: TcConfigProvider, frameworkDLLs, nonFrameworkDLLs) = cancellable { - let tcConfig = tcConfigP.Get(ctok) + let tcConfig = tcConfigP.Get ctok let tcResolutions = TcAssemblyResolutions.BuildFromPriorResolutions(ctok, tcConfig, frameworkDLLs, []) let tcAltResolutions = TcAssemblyResolutions.BuildFromPriorResolutions(ctok, tcConfig, nonFrameworkDLLs, []) @@ -4525,7 +4525,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let! primaryAssem = frameworkTcImports.RegisterAndImportReferencedAssemblies(ctok, primaryAssemblyResolution) let primaryScopeRef = match primaryAssem with - | (_, [ResolvedImportedAssembly(ccu)]) -> ccu.FSharpViewOfMetadata.ILScopeRef + | (_, [ResolvedImportedAssembly ccu]) -> ccu.FSharpViewOfMetadata.ILScopeRef | _ -> failwith "unexpected" let ilGlobals = mkILGlobals primaryScopeRef @@ -4549,7 +4549,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let fslibCcu = if tcConfig.compilingFslib then // When compiling FSharp.Core.dll, the fslibCcu reference to FSharp.Core.dll is a delayed ccu thunk fixed up during type checking - CcuThunk.CreateDelayed(getFSharpCoreLibraryName) + CcuThunk.CreateDelayed getFSharpCoreLibraryName else let fslibCcuInfo = let coreLibraryReference = tcConfig.CoreLibraryDllReference() @@ -4566,7 +4566,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu match resolvedAssemblyRef with | Some coreLibraryResolution -> match frameworkTcImports.RegisterAndImportReferencedAssemblies(ctok, [coreLibraryResolution]) |> Cancellable.runWithoutCancellation with - | (_, [ResolvedImportedAssembly(fslibCcuInfo) ]) -> fslibCcuInfo + | (_, [ResolvedImportedAssembly fslibCcuInfo ]) -> fslibCcuInfo | _ -> error(InternalError("BuildFrameworkTcImports: no successful import of "+coreLibraryResolution.resolvedPath, coreLibraryResolution.originalReference.Range)) | None -> @@ -4591,11 +4591,11 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu #if !NO_INLINE_IL_PARSER FSharp.Compiler.AbstractIL.Internal.AsciiConstants.parseILGlobals := tcGlobals.ilg #endif - frameworkTcImports.SetTcGlobals(tcGlobals) + frameworkTcImports.SetTcGlobals tcGlobals return tcGlobals, frameworkTcImports } - member tcImports.ReportUnresolvedAssemblyReferences(knownUnresolved) = + member tcImports.ReportUnresolvedAssemblyReferences knownUnresolved = // Report that an assembly was not resolved. let reportAssemblyNotResolved(file, originalReferences: AssemblyReference list) = originalReferences |> List.iter(fun originalReference -> errorR(AssemblyNotResolved(file, originalReference.Range))) @@ -4607,12 +4607,12 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu // and when hosted in Visual Studio or another long-running process must dispose this object. static member BuildNonFrameworkTcImports (ctok, tcConfigP: TcConfigProvider, tcGlobals: TcGlobals, baseTcImports, nonFrameworkReferences, knownUnresolved) = cancellable { - let tcConfig = tcConfigP.Get(ctok) + let tcConfig = tcConfigP.Get ctok let tcResolutions = TcAssemblyResolutions.BuildFromPriorResolutions(ctok, tcConfig, nonFrameworkReferences, knownUnresolved) let references = tcResolutions.GetAssemblyResolutions() let tcImports = new TcImports(tcConfigP, tcResolutions, Some baseTcImports, Some tcGlobals.ilg) let! _assemblies = tcImports.RegisterAndImportReferencedAssemblies(ctok, references) - tcImports.ReportUnresolvedAssemblyReferences(knownUnresolved) + tcImports.ReportUnresolvedAssemblyReferences knownUnresolved return tcImports } @@ -4622,8 +4622,8 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu // we should start disposing these objects. static member BuildTcImports(ctok, tcConfigP: TcConfigProvider) = cancellable { - let tcConfig = tcConfigP.Get(ctok) - //let foundationalTcImports, tcGlobals = TcImports.BuildFoundationalTcImports(tcConfigP) + let tcConfig = tcConfigP.Get ctok + //let foundationalTcImports, tcGlobals = TcImports.BuildFoundationalTcImports tcConfigP let frameworkDLLs, nonFrameworkReferences, knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok, tcConfig) let! tcGlobals, frameworkTcImports = TcImports.BuildFrameworkTcImports (ctok, tcConfigP, frameworkDLLs, nonFrameworkReferences) let! tcImports = TcImports.BuildNonFrameworkTcImports(ctok, tcConfigP, tcGlobals, frameworkTcImports, nonFrameworkReferences, knownUnresolved) @@ -4651,8 +4651,8 @@ let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file) = let asms = ccuinfos |> List.map (function - | ResolvedImportedAssembly(asm) -> asm - | UnresolvedImportedAssembly(assemblyName) -> error(Error(FSComp.SR.buildCouldNotResolveAssemblyRequiredByFile(assemblyName, file), m))) + | ResolvedImportedAssembly asm -> asm + | UnresolvedImportedAssembly assemblyName -> error(Error(FSComp.SR.buildCouldNotResolveAssemblyRequiredByFile(assemblyName, file), m))) let g = tcImports.GetTcGlobals() let amap = tcImports.GetImportMap() @@ -4680,7 +4680,7 @@ let ProcessMetaCommandsFromInput match hash with | ParsedHashDirective("I", args, m) -> if not canHaveScriptMetaCommands then - errorR(HashIncludeNotAllowedInNonScript(m)) + errorR(HashIncludeNotAllowedInNonScript m) match args with | [path] -> matchedm<-m @@ -4693,7 +4693,7 @@ let ProcessMetaCommandsFromInput List.fold (fun state d -> nowarnF state (m, d)) state numbers | ParsedHashDirective(("reference" | "r"), args, m) -> if not canHaveScriptMetaCommands then - errorR(HashReferenceNotAllowedInNonScript(m)) + errorR(HashReferenceNotAllowedInNonScript m) match args with | [path] -> matchedm<-m @@ -4703,7 +4703,7 @@ let ProcessMetaCommandsFromInput state | ParsedHashDirective("load", args, m) -> if not canHaveScriptMetaCommands then - errorR(HashDirectiveNotAllowedInNonScript(m)) + errorR(HashDirectiveNotAllowedInNonScript m) match args with | _ :: _ -> matchedm<-m @@ -4713,7 +4713,7 @@ let ProcessMetaCommandsFromInput state | ParsedHashDirective("time", args, m) -> if not canHaveScriptMetaCommands then - errorR(HashDirectiveNotAllowedInNonScript(m)) + errorR(HashDirectiveNotAllowedInNonScript m) match args with | [] -> () @@ -4795,7 +4795,7 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig: TcConfig, inp: ParsedInput, let GetAssemblyResolutionInformation(ctok, tcConfig: TcConfig) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter - let assemblyList = TcAssemblyResolutions.GetAllDllReferences(tcConfig) + let assemblyList = TcAssemblyResolutions.GetAllDllReferences tcConfig let resolutions = TcAssemblyResolutions.ResolveAssemblyReferences (ctok, tcConfig, assemblyList, []) resolutions.GetAssemblyResolutions(), resolutions.GetUnresolvedReferences() @@ -4847,12 +4847,12 @@ module private ScriptPreprocessClosure = type Observed() = let seen = System.Collections.Generic.Dictionary<_, bool>() - member ob.SetSeen(check) = - if not(seen.ContainsKey(check)) then + member ob.SetSeen check = + if not(seen.ContainsKey check) then seen.Add(check, true) - member ob.HaveSeen(check) = - seen.ContainsKey(check) + member ob.HaveSeen check = + seen.ContainsKey check /// Parse a script from source. let ParseScriptText @@ -4883,7 +4883,7 @@ module private ScriptPreprocessClosure = assumeDotNetFramework, tryGetMetadataSnapshot, reduceMemoryUsage) = - let projectDir = Path.GetDirectoryName(filename) + let projectDir = Path.GetDirectoryName filename let isInteractive = (codeContext = CodeContext.CompilationAndEvaluation) let isInvalidationSupported = (codeContext = CodeContext.Editing) @@ -4913,12 +4913,12 @@ module private ScriptPreprocessClosure = let ClosureSourceOfFilename(filename, m, inputCodePage, parseRequired) = try - let filename = FileSystem.GetFullPathShim(filename) + let filename = FileSystem.GetFullPathShim filename use stream = FileSystem.FileStreamReadShim filename use reader = match inputCodePage with | None -> new StreamReader(stream, true) - | Some (n: int) -> new StreamReader(stream, Encoding.GetEncoding(n)) + | Some (n: int) -> new StreamReader(stream, Encoding.GetEncoding n) let source = reader.ReadToEnd() [ClosureSource(filename, m, source, parseRequired)] with e -> @@ -4954,10 +4954,10 @@ module private ScriptPreprocessClosure = let observedSources = Observed() let rec loop (ClosureSource(filename, m, source, parseRequired)) = - [ if not (observedSources.HaveSeen(filename)) then - observedSources.SetSeen(filename) + [ if not (observedSources.HaveSeen filename) then + observedSources.SetSeen filename //printfn "visiting %s" filename - if IsScript(filename) || parseRequired then + if IsScript filename || parseRequired then let parseResult, parseDiagnostics = let errorLogger = CapturingErrorLogger("FindClosureParse") use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) @@ -4968,7 +4968,7 @@ module private ScriptPreprocessClosure = | Some parsedScriptAst -> let errorLogger = CapturingErrorLogger("FindClosureMetaCommands") use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) - let pathOfMetaCommandSource = Path.GetDirectoryName(filename) + let pathOfMetaCommandSource = Path.GetDirectoryName filename let preSources = (!tcConfig).GetAvailableLoadedSources() let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (!tcConfig, parsedScriptAst, pathOfMetaCommandSource) @@ -4981,7 +4981,7 @@ module private ScriptPreprocessClosure = // printfn "visiting %s - has subsource of %s " filename subFile for (m, subFile) in sources do - if IsScript(subFile) then + if IsScript subFile then for subSource in ClosureSourceOfFilename(subFile, m, tcConfigResult.inputCodePage, false) do yield! loop subSource else @@ -5234,7 +5234,7 @@ type TcState = // a.fsi + b.fsi + c.fsi (after checking implementation file for c.fs) member x.CcuSig = x.tcsCcuSig - member x.NextStateAfterIncrementalFragment(tcEnvAtEndOfLastInput) = + member x.NextStateAfterIncrementalFragment tcEnvAtEndOfLastInput = { x with tcsTcSigEnv = tcEnvAtEndOfLastInput tcsTcImplEnv = tcEnvAtEndOfLastInput } @@ -5268,7 +5268,7 @@ let GetInitialTcState(m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcIm // OK, is this is the FSharp.Core CCU then fix it up. if tcConfig.compilingFslib then - tcGlobals.fslibCcu.Fixup(ccu) + tcGlobals.fslibCcu.Fixup ccu { tcsCcu= ccu tcsCcuType=ccuType @@ -5290,7 +5290,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: let! ctok = Eventually.token RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST - CheckSimulateException(tcConfig) + CheckSimulateException tcConfig let m = inp.Range let amap = tcImports.GetImportMap() @@ -5337,7 +5337,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: | ParsedInput.ImplFile (ParsedImplFileInput(_, _, qualNameOfFile, _, _, _, _) as file) -> // Check if we've got an interface for this fragment - let rootSigOpt = tcState.tcsRootSigs.TryFind(qualNameOfFile) + let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile // Check if we've already seen an implementation for this fragment if Zset.contains qualNameOfFile tcState.tcsRootImpls then @@ -5401,7 +5401,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: /// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = // 'use' ensures that the warning handler is restored at the end - use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(inp), oldLogger) ) + use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp) |> Eventually.force ctok diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 4aeefae3b..e13167085 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -71,7 +71,7 @@ let GetOptionsOfBlock block = let FilterCompilerOptionBlock pred block = match block with | PublicOptions(heading, opts) -> PublicOptions(heading, List.filter pred opts) - | PrivateOptions(opts) -> PrivateOptions(List.filter pred opts) + | PrivateOptions opts -> PrivateOptions(List.filter pred opts) let compilerOptionUsage (CompilerOption(s, tag, spec, _, _)) = let s = if s="--" then "" else s (* s="flag" for "--flag" options. s="--" for "--" option. Adjust printing here for "--" case. *) @@ -172,7 +172,7 @@ module ResponseFile = let parseFile path: Choice = let parseLine (l: string) = match l with - | s when String.IsNullOrWhiteSpace(s) -> None + | s when String.IsNullOrWhiteSpace s -> None | s when l.StartsWithOrdinal("#") -> Some (ResponseFileLine.Comment (s.TrimStart('#'))) | s -> Some (ResponseFileLine.CompilerOptionSpec (s.Trim())) @@ -254,9 +254,9 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler match fullpath with | None -> - errorR(Error(FSComp.SR.optsResponseFileNameInvalid(rsp), rangeCmdArgs)) + errorR(Error(FSComp.SR.optsResponseFileNameInvalid rsp, rangeCmdArgs)) [] - | Some(path) when not (FileSystem.SafeExists path) -> + | Some path when not (FileSystem.SafeExists path) -> errorR(Error(FSComp.SR.optsResponseFileNotFound(rsp, path), rangeCmdArgs)) [] | Some path -> @@ -279,7 +279,7 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler let reportDeprecatedOption errOpt = match errOpt with - | Some(e) -> warning(e) + | Some e -> warning e | None -> () let rec attempt l = @@ -290,7 +290,7 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler | (CompilerOption(s, _, OptionUnit f, d, _) :: _) when optToken = s && argString = "" -> reportDeprecatedOption d f (); t - | (CompilerOption(s, _, OptionSwitch f, d, _) :: _) when getSwitchOpt(optToken) = s && argString = "" -> + | (CompilerOption(s, _, OptionSwitch f, d, _) :: _) when getSwitchOpt optToken = s && argString = "" -> reportDeprecatedOption d f (getSwitch opt); t | (CompilerOption(s, _, OptionSet f, d, _) :: _) when optToken = s && argString = "" -> @@ -309,14 +309,14 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler reportDeprecatedOption d let oa = getOptionArg compilerOption argString if oa <> "" then - f (try int32 (oa) with _ -> + f (try int32 oa with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(getOptionArg compilerOption argString), rangeCmdArgs)); 0) t | (CompilerOption(s, _, OptionFloat f, d, _) as compilerOption :: _) when optToken = s -> reportDeprecatedOption d let oa = getOptionArg compilerOption argString if oa <> "" then - f (try float (oa) with _ -> + f (try float oa with _ -> errorR(Error(FSComp.SR.buildArgInvalidFloat(getOptionArg compilerOption argString), rangeCmdArgs)); 0.0) t | (CompilerOption(s, _, OptionRest f, d, _) :: _) when optToken = s -> @@ -326,14 +326,14 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler reportDeprecatedOption d let al = getOptionArgList compilerOption argString if al <> [] then - List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i), rangeCmdArgs)); 0)) al + List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt i, rangeCmdArgs)); 0)) al t - | (CompilerOption(s, _, OptionIntListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s -> + | (CompilerOption(s, _, OptionIntListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt optToken = s -> reportDeprecatedOption d let al = getOptionArgList compilerOption argString if al <> [] then - let switch = getSwitch(opt) - List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i), rangeCmdArgs)); 0) switch) al + let switch = getSwitch opt + List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt i, rangeCmdArgs)); 0) switch) al t // here | (CompilerOption(s, _, OptionStringList f, d, _) as compilerOption :: _) when optToken = s -> @@ -342,11 +342,11 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler if al <> [] then List.iter f (getOptionArgList compilerOption argString) t - | (CompilerOption(s, _, OptionStringListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s -> + | (CompilerOption(s, _, OptionStringListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt optToken = s -> reportDeprecatedOption d let al = getOptionArgList compilerOption argString if al <> [] then - let switch = getSwitch(opt) + let switch = getSwitch opt List.iter (fun s -> f s switch) (getOptionArgList compilerOption argString) t | (CompilerOption(_, _, OptionGeneral (pred, exec), d, _) :: _) when pred args -> @@ -358,7 +358,7 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler then // want the whole opt token - delimiter and all let unrecOpt = (opt.Split([|':'|]).[0]) - errorR(Error(FSComp.SR.buildUnrecognizedOption(unrecOpt), rangeCmdArgs)) + errorR(Error(FSComp.SR.buildUnrecognizedOption unrecOpt, rangeCmdArgs)) t else (collectOtherArgument opt; t) @@ -399,7 +399,7 @@ let SetOptimizeOn(tcConfigB: TcConfigBuilder) = tcConfigB.doFinalSimplify <- true let SetOptimizeSwitch (tcConfigB: TcConfigBuilder) switch = - if (switch = OptionSwitch.On) then SetOptimizeOn(tcConfigB) else SetOptimizeOff(tcConfigB) + if (switch = OptionSwitch.On) then SetOptimizeOn tcConfigB else SetOptimizeOff tcConfigB let SetTailcallSwitch (tcConfigB: TcConfigBuilder) switch = tcConfigB.emitTailcalls <- (switch = OptionSwitch.On) @@ -426,10 +426,10 @@ let useHighEntropyVASwitch (tcConfigB: TcConfigBuilder) switch = tcConfigB.useHighEntropyVA <- switch = OptionSwitch.On let subSystemVersionSwitch (tcConfigB: TcConfigBuilder) (text: string) = - let fail() = error(Error(FSComp.SR.optsInvalidSubSystemVersion(text), rangeCmdArgs)) + let fail() = error(Error(FSComp.SR.optsInvalidSubSystemVersion text, rangeCmdArgs)) // per spec for 357994: Validate input string, should be two positive integers x.y when x>=4 and y>=0 and both <= 65535 - if System.String.IsNullOrEmpty(text) then + if System.String.IsNullOrEmpty text then fail() else match text.Split('.') with @@ -450,11 +450,11 @@ let SetTarget (tcConfigB: TcConfigBuilder)(s: string) = | "winexe" -> tcConfigB.target <- CompilerTarget.WinExe | "library" -> tcConfigB.target <- CompilerTarget.Dll | "module" -> tcConfigB.target <- CompilerTarget.Module - | _ -> error(Error(FSComp.SR.optsUnrecognizedTarget(s), rangeCmdArgs)) + | _ -> error(Error(FSComp.SR.optsUnrecognizedTarget s, rangeCmdArgs)) let SetDebugSwitch (tcConfigB: TcConfigBuilder) (dtype: string option) (s: OptionSwitch) = match dtype with - | Some(s) -> + | Some s -> match s with | "portable" -> tcConfigB.portablePDB <- true @@ -483,7 +483,7 @@ let SetDebugSwitch (tcConfigB: TcConfigBuilder) (dtype: string option) (s: Optio tcConfigB.jitTracking <- true #endif - | _ -> error(Error(FSComp.SR.optsUnrecognizedDebugType(s), rangeCmdArgs)) + | _ -> error(Error(FSComp.SR.optsUnrecognizedDebugType s, rangeCmdArgs)) | None -> tcConfigB.portablePDB <- false; tcConfigB.embeddedPDB <- false; tcConfigB.jitTracking <- s = OptionSwitch.On tcConfigB.debuginfo <- s = OptionSwitch.On @@ -561,12 +561,12 @@ let inputFileFlagsFsc tcConfigB = inputFileFlagsBoth tcConfigB //--------------------------------- let errorsAndWarningsFlags (tcConfigB: TcConfigBuilder) = - let trimFS (s:string) = if s.StartsWithOrdinal("FS") = true then s.Substring(2) else s + let trimFS (s:string) = if s.StartsWithOrdinal("FS") = true then s.Substring 2 else s let trimFStoInt (s:string) = try Some (int32 (trimFS s)) with _ -> - errorR(Error(FSComp.SR.buildArgInvalidInt(s), rangeCmdArgs)) + errorR(Error(FSComp.SR.buildArgInvalidInt s, rangeCmdArgs)) None [ CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> @@ -592,7 +592,7 @@ let errorsAndWarningsFlags (tcConfigB: TcConfigBuilder) = CompilerOption("warn", tagInt, OptionInt (fun n -> tcConfigB.errorSeverityOptions <- { tcConfigB.errorSeverityOptions with - WarnLevel = if (n >= 0 && n <= 5) then n else error(Error (FSComp.SR.optsInvalidWarningLevel(n), rangeCmdArgs)) } + WarnLevel = if (n >= 0 && n <= 5) then n else error(Error (FSComp.SR.optsInvalidWarningLevel n, rangeCmdArgs)) } ), None, Some (FSComp.SR.optsWarn())) CompilerOption("nowarn", tagWarnList, OptionStringList (fun n -> @@ -655,12 +655,12 @@ let outputFileFlagsFsc (tcConfigB: TcConfigBuilder) = CompilerOption ("keyfile", tagFile, - OptionString (fun s -> tcConfigB.signer <- Some(s)), None, + OptionString (fun s -> tcConfigB.signer <- Some s), None, Some (FSComp.SR.optsStrongKeyFile())) CompilerOption ("keycontainer", tagString, - OptionString(fun s -> tcConfigB.container <- Some(s)), None, + OptionString(fun s -> tcConfigB.container <- Some s), None, Some(FSComp.SR.optsStrongKeyContainer())) CompilerOption @@ -675,7 +675,7 @@ let outputFileFlagsFsc (tcConfigB: TcConfigBuilder) = tcConfigB.prefer32Bit <- true None | "anycpu" -> None - | _ -> error(Error(FSComp.SR.optsUnknownPlatform(s), rangeCmdArgs))), None, + | _ -> error(Error(FSComp.SR.optsUnknownPlatform s, rangeCmdArgs))), None, Some(FSComp.SR.optsPlatform())) CompilerOption @@ -745,7 +745,7 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) = CompilerOption ("debug", tagFullPDBOnlyPortable, - OptionString (fun s -> SetDebugSwitch tcConfigB (Some(s)) OptionSwitch.On), None, + OptionString (fun s -> SetDebugSwitch tcConfigB (Some s) OptionSwitch.On), None, Some (FSComp.SR.optsDebug(if isFsi then "pdbonly" else "full"))) ] let embed = @@ -836,17 +836,17 @@ let codePageFlag (tcConfigB: TcConfigBuilder) = ("codepage", tagInt, OptionInt (fun n -> try - System.Text.Encoding.GetEncoding(n) |> ignore + System.Text.Encoding.GetEncoding n |> ignore with :? System.ArgumentException as err -> error(Error(FSComp.SR.optsProblemWithCodepage(n, err.Message), rangeCmdArgs)) - tcConfigB.inputCodePage <- Some(n)), None, + tcConfigB.inputCodePage <- Some n), None, Some (FSComp.SR.optsCodepage())) let preferredUiLang (tcConfigB: TcConfigBuilder) = CompilerOption ("preferreduilang", tagString, - OptionString (fun s -> tcConfigB.preferredUiLang <- Some(s)), None, + OptionString (fun s -> tcConfigB.preferredUiLang <- Some s), None, Some(FSComp.SR.optsPreferredUiLang())) let utf8OutputFlag (tcConfigB: TcConfigBuilder) = @@ -876,7 +876,7 @@ let SetTargetProfile tcConfigB v = | "netcore" -> PrimaryAssembly.System_Runtime // Indicates we assume "netstandard.dll", i.e .NET Standard 2.0 and above | "netstandard" -> PrimaryAssembly.NetStandard - | _ -> error(Error(FSComp.SR.optsInvalidTargetProfile(v), rangeCmdArgs)) + | _ -> error(Error(FSComp.SR.optsInvalidTargetProfile v, rangeCmdArgs)) let advancedFlagsBoth tcConfigB = [ @@ -985,18 +985,18 @@ let testFlag tcConfigB = | "DumpDebugInfo" -> tcConfigB.dumpDebugInfo <- true | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true | "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true - | str -> warning(Error(FSComp.SR.optsUnknownArgumentToTheTestSwitch(str), rangeCmdArgs))), None, + | str -> warning(Error(FSComp.SR.optsUnknownArgumentToTheTestSwitch str, rangeCmdArgs))), None, None) // Not shown in fsc.exe help, no warning on use, motivation is for use from tooling. let editorSpecificFlags (tcConfigB: TcConfigBuilder) = [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.VSErrors), None, None) - CompilerOption("validate-type-providers", tagNone, OptionUnit (id), None, None) // preserved for compatibility's sake, no longer has any effect + CompilerOption("validate-type-providers", tagNone, OptionUnit id, None, None) // preserved for compatibility's sake, no longer has any effect CompilerOption("LCID", tagInt, OptionInt ignore, None, None) CompilerOption("flaterrors", tagNone, OptionUnit (fun () -> tcConfigB.flatErrors <- true), None, None) CompilerOption("sqmsessionguid", tagNone, OptionString ignore, None, None) CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.GccErrors), None, None) - CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some(s)), None, None) + CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some s), None, None) CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) CompilerOption("noconditionalerasure", tagNone, OptionUnit (fun () -> tcConfigB.noConditionalErasure <- true), None, None) ] @@ -1041,7 +1041,7 @@ let internalFlags (tcConfigB:TcConfigBuilder) = CompilerOption ("simulateException", tagNone, - OptionString (fun s -> tcConfigB.simulateException <- Some(s)), + OptionString (fun s -> tcConfigB.simulateException <- Some s), Some(InternalCommandLineOption("--simulateException", rangeCmdArgs)), Some "Simulate an exception from some part of the compiler") CompilerOption @@ -1188,7 +1188,7 @@ let internalFlags (tcConfigB:TcConfigBuilder) = CompilerOption ("metadataversion", tagString, - OptionString (fun s -> tcConfigB.metadataVersion <- Some(s)), + OptionString (fun s -> tcConfigB.metadataVersion <- Some s), Some(InternalCommandLineOption("metadataversion", rangeCmdArgs)), None) ] @@ -1240,17 +1240,17 @@ let deprecatedFlagsBoth tcConfigB = [ CompilerOption ("light", tagNone, - OptionUnit (fun () -> tcConfigB.light <- Some(true)), + OptionUnit (fun () -> tcConfigB.light <- Some true), Some(DeprecatedCommandLineOptionNoDescription("--light", rangeCmdArgs)), None) CompilerOption ("indentation-syntax", tagNone, - OptionUnit (fun () -> tcConfigB.light <- Some(true)), + OptionUnit (fun () -> tcConfigB.light <- Some true), Some(DeprecatedCommandLineOptionNoDescription("--indentation-syntax", rangeCmdArgs)), None) CompilerOption ("no-indentation-syntax", tagNone, - OptionUnit (fun () -> tcConfigB.light <- Some(false)), + OptionUnit (fun () -> tcConfigB.light <- Some false), Some(DeprecatedCommandLineOptionNoDescription("--no-indentation-syntax", rangeCmdArgs)), None) ] @@ -1352,7 +1352,7 @@ let deprecatedFlagsFsc tcConfigB = CompilerOption ("Ooff", tagNone, - OptionUnit (fun () -> SetOptimizeOff(tcConfigB)), + OptionUnit (fun () -> SetOptimizeOff tcConfigB), Some(DeprecatedCommandLineOptionSuggestAlternative("-Ooff", "--optimize-", rangeCmdArgs)), None) mlKeywordsFlag @@ -1543,10 +1543,10 @@ let GetCoreFsiCompilerOptions (tcConfigB: TcConfigBuilder) = let ApplyCommandLineArgs(tcConfigB: TcConfigBuilder, sourceFiles: string list, commandLineArgs) = try - let sourceFilesAcc = ResizeArray(sourceFiles) - let collect name = if not (Filename.isDll name) then sourceFilesAcc.Add(name) + let sourceFilesAcc = ResizeArray sourceFiles + let collect name = if not (Filename.isDll name) then sourceFilesAcc.Add name ParseCompilerOptions(collect, GetCoreServiceCompilerOptions tcConfigB, commandLineArgs) - ResizeArray.toList(sourceFilesAcc) + ResizeArray.toList sourceFilesAcc with e -> errorRecovery e range0 sourceFiles @@ -1621,13 +1621,13 @@ let ReportTime (tcConfig:TcConfig) descr = // make this call unless showTimes has been turned on. let timeNow = System.Diagnostics.Process.GetCurrentProcess().UserProcessorTime.TotalSeconds let maxGen = System.GC.MaxGeneration - let gcNow = [| for i in 0 .. maxGen -> System.GC.CollectionCount(i) |] + let gcNow = [| for i in 0 .. maxGen -> System.GC.CollectionCount i |] let ptime = System.Diagnostics.Process.GetCurrentProcess() let wsNow = ptime.WorkingSet64/1000000L match !tPrev, !nPrev with | Some (timePrev, gcPrev:int []), Some prevDescr -> - let spanGC = [| for i in 0 .. maxGen -> System.GC.CollectionCount(i) - gcPrev.[i] |] + let spanGC = [| for i in 0 .. maxGen -> System.GC.CollectionCount i - gcPrev.[i] |] dprintf "TIME: %4.1f Delta: %4.1f Mem: %3d" timeNow (timeNow - timePrev) wsNow @@ -1647,7 +1647,7 @@ let ReportTime (tcConfig:TcConfig) descr = let AddExternalCcuToOpimizationEnv tcGlobals optEnv (ccuinfo: ImportedAssembly) = match ccuinfo.FSharpOptimizationData.Force() with | None -> optEnv - | Some(data) -> Optimizer.BindCcu ccuinfo.FSharpViewOfMetadata data optEnv tcGlobals + | Some data -> Optimizer.BindCcu ccuinfo.FSharpViewOfMetadata data optEnv tcGlobals //---------------------------------------------------------------------------- // OPTIMIZATION - support - optimize @@ -1752,7 +1752,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let implFiles, implFileOptDatas = List.unzip results let assemblyOptData = Optimizer.UnionOptimizationInfos implFileOptDatas - let tassembly = TypedAssemblyAfterOptimization(implFiles) + let tassembly = TypedAssemblyAfterOptimization implFiles PrintWholeAssemblyImplementation tcConfig outfile "pass-end" (List.map fst implFiles) ReportTime tcConfig ("Ending Optimizations") diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 196edd054..53c0f93c5 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -1480,8 +1480,8 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = // This is important for calls to operators on generated provided types. There is an (unchecked) condition // that generative providers do not re=order arguments or insert any more information into operator calls. match callMethInfoOpt, callExpr with - | Some methInfo, Expr.Op(TOp.ILCall(_useCallVirt, _isProtected, _, _isNewObj, NormalValUse, _isProp, _noTailCall, ilMethRef, _actualTypeInst, actualMethInst, _ilReturnTys), [], args, m) - when (args, (objArgVars@allArgVars)) ||> List.lengthsEqAndForall2 (fun a b -> match a with Expr.Val(v, _, _) -> valEq v.Deref b | _ -> false) -> + | Some methInfo, Expr.Op (TOp.ILCall (_useCallVirt, _isProtected, _, _isNewObj, NormalValUse, _isProp, _noTailCall, ilMethRef, _actualTypeInst, actualMethInst, _ilReturnTys), [], args, m) + when (args, (objArgVars@allArgVars)) ||> List.lengthsEqAndForall2 (fun a b -> match a with Expr.Val (v, _, _) -> valEq v.Deref b | _ -> false) -> let declaringType = Import.ImportProvidedType amap m (methInfo.PApply((fun x -> x.DeclaringType), m)) if isILAppTy g declaringType then let extOpt = None // EXTENSION METHODS FROM TYPE PROVIDERS: for extension methods coming from the type providers we would have something here. @@ -2817,7 +2817,7 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra if minfo.IsStruct && minfo.IsInstance && (match argExprs with [] -> false | h :: _ -> not (isByrefTy g (tyOfExpr g h))) then let h, t = List.headAndTail argExprs let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m - ResultD (Some (wrap (Expr.Op(TOp.TraitCall(traitInfo), [], (h' :: t), m)))) + ResultD (Some (wrap (Expr.Op (TOp.TraitCall (traitInfo), [], (h' :: t), m)))) else ResultD (Some (MakeMethInfoCall amap m minfo methArgTys argExprs )) diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index 7272e3398..5a97ce98c 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -150,7 +150,7 @@ let (|TyappAndApp|_|) e = match e with | Expr.App (f, fty, tys, args, m) -> match stripExpr f with - | Expr.App(f2, fty2, tys2, [], m2) -> Some(f2, fty2, tys2 @ tys, args, m2) + | Expr.App (f2, fty2, tys2, [], m2) -> Some(f2, fty2, tys2 @ tys, args, m2) | Expr.App _ -> Some(f, fty, tys, args, m) (* has args, so not combine ty args *) | f -> Some(f, fty, tys, args, m) | _ -> None @@ -278,15 +278,15 @@ module GlobalUsageAnalysis = // NO: app but function is not val noInterceptF z origExpr - | Expr.Op(TOp.TupleFieldGet (tupInfo, n), ts, [x], _) when not (evalTupInfoIsStruct tupInfo) -> + | Expr.Op (TOp.TupleFieldGet (tupInfo, n), ts, [x], _) when not (evalTupInfoIsStruct tupInfo) -> let context = TupleGet (n, ts) :: context recognise context x // lambdas end top-level status - | Expr.Lambda(_id, _ctorThisValOpt, _baseValOpt, _vs, body, _, _) -> + | Expr.Lambda (_id, _ctorThisValOpt, _baseValOpt, _vs, body, _, _) -> foldUnderLambda exprF z body - | Expr.TyLambda(_id, _tps, body, _, _) -> + | Expr.TyLambda (_id, _tps, body, _, _) -> foldUnderLambda exprF z body | _ -> @@ -360,7 +360,7 @@ let checkTS = function /// explicit tuple-structure in expr let rec uncheckedExprTS expr = match expr with - | Expr.Op(TOp.Tuple tupInfo, _tys, args, _) when not (evalTupInfoIsStruct tupInfo) -> + | Expr.Op (TOp.Tuple tupInfo, _tys, args, _) when not (evalTupInfoIsStruct tupInfo) -> TupleTS (List.map uncheckedExprTS args) | _ -> UnknownTS @@ -686,7 +686,7 @@ let rec collapseArg env bindings ts (x: Expr) = | UnknownTS, x -> let bindings, vx = noEffectExpr env bindings x bindings, [vx] - | TupleTS tss, Expr.Op(TOp.Tuple tupInfo, _xtys, xs, _) when not (evalTupInfoIsStruct tupInfo) -> + | TupleTS tss, Expr.Op (TOp.Tuple tupInfo, _xtys, xs, _) when not (evalTupInfoIsStruct tupInfo) -> let env = suffixE env "'" collapseArgs env bindings 1 tss xs | TupleTS tss, x -> diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index cb43aded1..33ebd7b2c 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -130,9 +130,9 @@ let rec AttachRange m (exn:exn) = match exn with // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException -> AttachRange m exn.InnerException - | UnresolvedReferenceNoRange(a) -> UnresolvedReferenceError(a, m) + | UnresolvedReferenceNoRange a -> UnresolvedReferenceError(a, m) | UnresolvedPathReferenceNoRange(a, p) -> UnresolvedPathReference(a, p, m) - | Failure(msg) -> InternalError(msg + " (Failure)", m) + | Failure msg -> InternalError(msg + " (Failure)", m) | :? System.ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) | notARangeDual -> notARangeDual @@ -146,9 +146,9 @@ type Exiter = let QuitProcessExiter = { new Exiter with - member __.Exit(n) = + member __.Exit n = try - System.Environment.Exit(n) + System.Environment.Exit n with _ -> () FSComp.SR.elSysEnvExitDidntExit() @@ -334,14 +334,14 @@ module ErrorLoggerExtensions = // This uses a simple heuristic to detect it (the vsversion is < 16.0) let tryAndDetectDev15 = let vsVersion = Environment.GetEnvironmentVariable("VisualStudioVersion") - match Double.TryParse(vsVersion) with + match Double.TryParse vsVersion with | true, v -> v < 16.0 | _ -> false /// Instruct the exception not to reset itself when thrown again. - let PreserveStackTrace(exn) = + let PreserveStackTrace exn = try - if not(tryAndDetectDev15) then + if not tryAndDetectDev15 then let preserveStackTrace = typeof.GetMethod("InternalPreserveStackTrace", BindingFlags.Instance ||| BindingFlags.NonPublic) preserveStackTrace.Invoke(exn, null) |> ignore with _ -> @@ -363,7 +363,7 @@ module ErrorLoggerExtensions = | :? System.UnauthorizedAccessException -> () | Failure _ // This gives reports for compiler INTERNAL ERRORs | :? System.SystemException -> - PreserveStackTrace(exn) + PreserveStackTrace exn raise exn | _ -> () #endif @@ -379,7 +379,7 @@ module ErrorLoggerExtensions = match exn with | StopProcessing | ReportedError _ -> - PreserveStackTrace(exn) + PreserveStackTrace exn raise exn | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), true) @@ -387,7 +387,7 @@ module ErrorLoggerExtensions = match exn with | StopProcessing | ReportedError _ -> - PreserveStackTrace(exn) + PreserveStackTrace exn raise exn | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), false) @@ -395,11 +395,11 @@ module ErrorLoggerExtensions = x.ErrorR exn raise (ReportedError (Some exn)) - member x.SimulateError (ph:PhasedDiagnostic) = + member x.SimulateError (ph: PhasedDiagnostic) = x.DiagnosticSink (ph, true) raise (ReportedError (Some ph.Exception)) - member x.ErrorRecovery (exn:exn) (m:range) = + member x.ErrorRecovery (exn: exn) (m: range) = // Never throws ReportedError. // Throws StopProcessing and exceptions raised by the DiagnosticSink(exn) handler. match exn with @@ -410,12 +410,12 @@ module ErrorLoggerExtensions = #endif | ReportedError _ | WrappedError(ReportedError _, _) -> () | StopProcessing | WrappedError(StopProcessing, _) -> - PreserveStackTrace(exn) + PreserveStackTrace exn raise exn | _ -> try x.ErrorR (AttachRange m exn) // may raise exceptions, e.g. an fsi error sink raises StopProcessing. - ReraiseIfWatsonable(exn) + ReraiseIfWatsonable exn with | ReportedError _ | WrappedError(ReportedError _, _) -> () @@ -463,7 +463,7 @@ let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer : ErrorLogger -> #Err newInstalled := false } let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase -let SetThreadErrorLoggerNoUnwind(errorLogger) = CompileThreadStatic.ErrorLogger <- errorLogger +let SetThreadErrorLoggerNoUnwind errorLogger = CompileThreadStatic.ErrorLogger <- errorLogger // Global functions are still used by parser and TAST ops. @@ -494,8 +494,8 @@ let deprecatedWithError s m = errorR(Deprecated(s, m)) // Note: global state, but only for compiling FSharp.Core.dll let mutable reportLibraryOnlyFeatures = true -let libraryOnlyError m = if reportLibraryOnlyFeatures then errorR(LibraryUseOnly(m)) -let libraryOnlyWarning m = if reportLibraryOnlyFeatures then warning(LibraryUseOnly(m)) +let libraryOnlyError m = if reportLibraryOnlyFeatures then errorR(LibraryUseOnly m) +let libraryOnlyWarning m = if reportLibraryOnlyFeatures then warning(LibraryUseOnly m) let deprecatedOperator m = deprecatedWithError (FSComp.SR.elDeprecatedOperator()) m let mlCompatWarning s m = warning(UserCompilerMessage(FSComp.SR.mlCompatMessage s, 62, m)) @@ -506,10 +506,10 @@ let suppressErrorReporting f = { new ErrorLogger("suppressErrorReporting") with member __.DiagnosticSink(_phasedError, _isError) = () member __.ErrorCount = 0 } - SetThreadErrorLoggerNoUnwind(errorLogger) + SetThreadErrorLoggerNoUnwind errorLogger f() finally - SetThreadErrorLoggerNoUnwind(errorLogger) + SetThreadErrorLoggerNoUnwind errorLogger let conditionallySuppressErrorReporting cond f = if cond then suppressErrorReporting f else f() @@ -581,8 +581,8 @@ type TrackErrorsBuilder() = member x.Combine(expr1, expr2) = expr1 ++ expr2 member x.While(gd, k) = WhileD gd k member x.Zero() = CompleteD - member x.Delay(fn) = fun () -> fn () - member x.Run(fn) = fn () + member x.Delay fn = fun () -> fn () + member x.Run fn = fn () let trackErrors = TrackErrorsBuilder() @@ -645,15 +645,15 @@ let NormalizeErrorString (text : string) = match text.[i] with | '\r' when i + 1 < text.Length && text.[i + 1] = '\n' -> // handle \r\n sequence - replace it with one single space - buf.Append(stringThatIsAProxyForANewlineInFlatErrors) |> ignore + buf.Append stringThatIsAProxyForANewlineInFlatErrors |> ignore 2 | '\n' | '\r' -> - buf.Append(stringThatIsAProxyForANewlineInFlatErrors) |> ignore + buf.Append stringThatIsAProxyForANewlineInFlatErrors |> ignore 1 | c -> // handle remaining chars: control - replace with space, others - keep unchanged - let c = if Char.IsControl(c) then ' ' else c - buf.Append(c) |> ignore + let c = if Char.IsControl c then ' ' else c + buf.Append c |> ignore 1 i <- i + delta buf.ToString() diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index 9bf54e3be..5de51f2ea 100755 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -84,8 +84,8 @@ module internal ExtensionTyping = let designTimeAssemblyPath = Path.Combine (dir, subdir, designTimeAssemblyName) if FileSystem.SafeExists designTimeAssemblyPath then yield loadFromLocation designTimeAssemblyPath - match Path.GetDirectoryName(dir) with - | s when s = "" || s = null || Path.GetFileName(dir) = "packages" || s = dir -> () + match Path.GetDirectoryName dir with + | s when s = "" || s = null || Path.GetFileName dir = "packages" || s = dir -> () | parentDir -> yield! searchParentDirChain parentDir designTimeAssemblyName } @@ -119,7 +119,7 @@ module internal ExtensionTyping = // never in the GAC these days and "x.DesignTIme, Version= ..." specifications are never used. try let asmName = System.Reflection.AssemblyName designTimeAssemblyNameString - Some (FileSystem.AssemblyLoad (asmName)) + Some (FileSystem.AssemblyLoad asmName) with e -> raiseError e @@ -181,7 +181,7 @@ module internal ExtensionTyping = protect (fun () -> Activator.CreateInstance(typeProviderImplementationType, [| box e|]) :?> ITypeProvider ) elif typeProviderImplementationType.GetConstructor [| |] <> null then - protect (fun () -> Activator.CreateInstance(typeProviderImplementationType) :?> ITypeProvider ) + protect (fun () -> Activator.CreateInstance typeProviderImplementationType :?> ITypeProvider ) else // No appropriate constructor found @@ -228,7 +228,7 @@ module internal ExtensionTyping = tpe.Iter(fun e -> errorR(NumberedError((e.Number, e.ContextualErrorMessage), m)) ) [] - let providers = Tainted<_>.CreateAll(providerSpecs) + let providers = Tainted<_>.CreateAll providerSpecs providers @@ -339,7 +339,7 @@ module internal ExtensionTyping = let mutable res = Unchecked.defaultof<_> if d.TryGetValue(st, &res) then Some res else None - member ctxt.TryGetTyconRef(st) = + member ctxt.TryGetTyconRef st = match ctxt with | NoEntries -> None | Entries(_, d) -> @@ -364,9 +364,9 @@ module internal ExtensionTyping = inherit ProvidedMemberInfo(x, ctxt) let provide () = ProvidedCustomAttributeProvider.Create (fun _provider -> x.CustomAttributes) interface IProvidedCustomAttributeProvider with - member __.GetHasTypeProviderEditorHideMethodsAttribute(provider) = provide().GetHasTypeProviderEditorHideMethodsAttribute(provider) - member __.GetDefinitionLocationAttribute(provider) = provide().GetDefinitionLocationAttribute(provider) - member __.GetXmlDocAttributes(provider) = provide().GetXmlDocAttributes(provider) + member __.GetHasTypeProviderEditorHideMethodsAttribute provider = provide().GetHasTypeProviderEditorHideMethodsAttribute provider + member __.GetDefinitionLocationAttribute provider = provide().GetDefinitionLocationAttribute provider + member __.GetXmlDocAttributes provider = provide().GetXmlDocAttributes provider // The type provider spec distinguishes between // - calls that can be made on provided types (i.e. types given by ReturnType, ParameterType, and generic argument types) @@ -383,29 +383,29 @@ module internal ExtensionTyping = member __.IsArray = x.IsArray member __.Assembly = x.Assembly |> ProvidedAssembly.Create ctxt member __.GetInterfaces() = x.GetInterfaces() |> ProvidedType.CreateArray ctxt - member __.GetMethods() = x.GetMethods(bindingFlags) |> ProvidedMethodInfo.CreateArray ctxt - member __.GetEvents() = x.GetEvents(bindingFlags) |> ProvidedEventInfo.CreateArray ctxt + member __.GetMethods() = x.GetMethods bindingFlags |> ProvidedMethodInfo.CreateArray ctxt + member __.GetEvents() = x.GetEvents bindingFlags |> ProvidedEventInfo.CreateArray ctxt member __.GetEvent nm = x.GetEvent(nm, bindingFlags) |> ProvidedEventInfo.Create ctxt - member __.GetProperties() = x.GetProperties(bindingFlags) |> ProvidedPropertyInfo.CreateArray ctxt + member __.GetProperties() = x.GetProperties bindingFlags |> ProvidedPropertyInfo.CreateArray ctxt member __.GetProperty nm = x.GetProperty(nm, bindingFlags) |> ProvidedPropertyInfo.Create ctxt - member __.GetConstructors() = x.GetConstructors(bindingFlags) |> ProvidedConstructorInfo.CreateArray ctxt - member __.GetFields() = x.GetFields(bindingFlags) |> ProvidedFieldInfo.CreateArray ctxt + member __.GetConstructors() = x.GetConstructors bindingFlags |> ProvidedConstructorInfo.CreateArray ctxt + member __.GetFields() = x.GetFields bindingFlags |> ProvidedFieldInfo.CreateArray ctxt member __.GetField nm = x.GetField(nm, bindingFlags) |> ProvidedFieldInfo.Create ctxt member __.GetAllNestedTypes() = x.GetNestedTypes(bindingFlags ||| BindingFlags.NonPublic) |> ProvidedType.CreateArray ctxt - member __.GetNestedTypes() = x.GetNestedTypes(bindingFlags) |> ProvidedType.CreateArray ctxt + member __.GetNestedTypes() = x.GetNestedTypes bindingFlags |> ProvidedType.CreateArray ctxt /// Type.GetNestedType(string) can return null if there is no nested type with given name member __.GetNestedType nm = x.GetNestedType (nm, bindingFlags) |> ProvidedType.Create ctxt /// Type.GetGenericTypeDefinition() either returns type or throws exception, null is not permitted member __.GetGenericTypeDefinition() = x.GetGenericTypeDefinition() |> ProvidedType.CreateWithNullCheck ctxt "GenericTypeDefinition" /// Type.BaseType can be null when Type is interface or object member __.BaseType = x.BaseType |> ProvidedType.Create ctxt - member __.GetStaticParameters(provider: ITypeProvider) = provider.GetStaticParameters(x) |> ProvidedParameterInfo.CreateArray ctxt + member __.GetStaticParameters(provider: ITypeProvider) = provider.GetStaticParameters x |> ProvidedParameterInfo.CreateArray ctxt /// Type.GetElementType can be null if i.e. Type is not array\pointer\byref type member __.GetElementType() = x.GetElementType() |> ProvidedType.Create ctxt member __.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt member __.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: obj[]) = provider.ApplyStaticArguments(x, fullTypePathAfterArguments, staticArgs) |> ProvidedType.Create ctxt - member __.IsVoid = (typeof.Equals(x) || (x.Namespace = "System" && x.Name = "Void")) + member __.IsVoid = (typeof.Equals x || (x.Namespace = "System" && x.Name = "Void")) member __.IsGenericParameter = x.IsGenericParameter member __.IsValueType = x.IsValueType member __.IsByRef = x.IsByRef @@ -453,7 +453,7 @@ module internal ExtensionTyping = let findAttrib (ty: System.Type) a = findAttribByName ty.FullName a { new IProvidedCustomAttributeProvider with member __.GetAttributeConstructorArgs (provider, attribName) = - attributes(provider) + attributes provider |> Seq.tryFind (findAttribByName attribName) |> Option.map (fun a -> let ctorArgs = @@ -467,19 +467,19 @@ module internal ExtensionTyping = ctorArgs, namedArgs) member __.GetHasTypeProviderEditorHideMethodsAttribute provider = - attributes(provider) + attributes provider |> Seq.exists (findAttrib typeof) - member __.GetDefinitionLocationAttribute(provider) = - attributes(provider) + member __.GetDefinitionLocationAttribute provider = + attributes provider |> Seq.tryFind (findAttrib typeof) |> Option.map (fun a -> (defaultArg (a.NamedArguments |> Seq.tryPick (function Member "FilePath" (Arg (:? string as v)) -> Some v | _ -> None)) null, defaultArg (a.NamedArguments |> Seq.tryPick (function Member "Line" (Arg (:? int as v)) -> Some v | _ -> None)) 0, defaultArg (a.NamedArguments |> Seq.tryPick (function Member "Column" (Arg (:? int as v)) -> Some v | _ -> None)) 0)) - member __.GetXmlDocAttributes(provider) = - attributes(provider) + member __.GetXmlDocAttributes provider = + attributes provider |> Seq.choose (fun a -> if findAttrib typeof a then match a.ConstructorArguments |> Seq.toList with @@ -496,9 +496,9 @@ module internal ExtensionTyping = /// DeclaringType can be null if MemberInfo belongs to Module, not to Type member __.DeclaringType = ProvidedType.Create ctxt x.DeclaringType interface IProvidedCustomAttributeProvider with - member __.GetHasTypeProviderEditorHideMethodsAttribute(provider) = provide().GetHasTypeProviderEditorHideMethodsAttribute(provider) - member __.GetDefinitionLocationAttribute(provider) = provide().GetDefinitionLocationAttribute(provider) - member __.GetXmlDocAttributes(provider) = provide().GetXmlDocAttributes(provider) + member __.GetHasTypeProviderEditorHideMethodsAttribute provider = provide().GetHasTypeProviderEditorHideMethodsAttribute provider + member __.GetDefinitionLocationAttribute provider = provide().GetDefinitionLocationAttribute provider + member __.GetXmlDocAttributes provider = provide().GetXmlDocAttributes provider member __.GetAttributeConstructorArgs (provider, attribName) = provide().GetAttributeConstructorArgs (provider, attribName) and [] @@ -515,9 +515,9 @@ module internal ExtensionTyping = static member Create ctxt x = match x with null -> null | t -> ProvidedParameterInfo (t, ctxt) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedParameterInfo.Create ctxt) // TODO null wrong? interface IProvidedCustomAttributeProvider with - member __.GetHasTypeProviderEditorHideMethodsAttribute(provider) = provide().GetHasTypeProviderEditorHideMethodsAttribute(provider) - member __.GetDefinitionLocationAttribute(provider) = provide().GetDefinitionLocationAttribute(provider) - member __.GetXmlDocAttributes(provider) = provide().GetXmlDocAttributes(provider) + member __.GetHasTypeProviderEditorHideMethodsAttribute provider = provide().GetHasTypeProviderEditorHideMethodsAttribute provider + member __.GetDefinitionLocationAttribute provider = provide().GetDefinitionLocationAttribute provider + member __.GetXmlDocAttributes provider = provide().GetXmlDocAttributes provider member __.GetAttributeConstructorArgs (provider, attribName) = provide().GetAttributeConstructorArgs (provider, attribName) member __.Handle = x override __.Equals y = assert false; match y with :? ProvidedParameterInfo as y -> x.Equals y.Handle | _ -> false @@ -527,7 +527,7 @@ module internal ExtensionTyping = ProvidedAssembly (x: System.Reflection.Assembly, _ctxt) = member __.GetName() = x.GetName() member __.FullName = x.FullName - member __.GetManifestModuleContents(provider: ITypeProvider) = provider.GetGeneratedAssemblyContents(x) + member __.GetManifestModuleContents(provider: ITypeProvider) = provider.GetGeneratedAssemblyContents x static member Create ctxt x = match x with null -> null | t -> ProvidedAssembly (t, ctxt) member __.Handle = x override __.Equals y = assert false; match y with :? ProvidedAssembly as y -> x.Equals y.Handle | _ -> false @@ -562,7 +562,7 @@ module internal ExtensionTyping = let staticParams = match provider with | :? ITypeProvider2 as itp2 -> - itp2.GetStaticParametersForMethod(x) + itp2.GetStaticParametersForMethod x | _ -> // To allow a type provider to depend only on FSharp.Core 4.3.0.0, it can alternatively implement an appropriate method called GetStaticParametersForMethod let meth = provider.GetType().GetMethod( "GetStaticParametersForMethod", bindingFlags, null, [| typeof |], null) @@ -763,7 +763,7 @@ module internal ExtensionTyping = /// Detect a provided new-tuple expression let (|ProvidedNewTupleExpr|_|) (x: ProvidedExpr) = match x.Handle with - | Quotations.Patterns.NewTuple(args) -> Some (ProvidedExpr.CreateArray x.Context (Array.ofList args)) + | Quotations.Patterns.NewTuple args -> Some (ProvidedExpr.CreateArray x.Context (Array.ofList args)) | _ -> None /// Detect a provided tuple-get expression @@ -805,7 +805,7 @@ module internal ExtensionTyping = #if PROVIDED_ADDRESS_OF let (|ProvidedAddressOfExpr|_|) (x: ProvidedExpr) = match x.Handle with - | Quotations.Patterns.AddressOf(e) -> Some (ProvidedExpr.Create x.Context e) + | Quotations.Patterns.AddressOf e -> Some (ProvidedExpr.Create x.Context e) | _ -> None #endif @@ -852,7 +852,7 @@ module internal ExtensionTyping = /// Get the provided invoker expression for a particular use of a method. let GetInvokerExpression (provider: ITypeProvider, methodBase: ProvidedMethodBase, paramExprs: ProvidedVar[]) = - provider.GetInvokerExpression(methodBase.Handle, [| for p in paramExprs -> Quotations.Expr.Var(p.Handle) |]) |> ProvidedExpr.Create methodBase.Context + provider.GetInvokerExpression(methodBase.Handle, [| for p in paramExprs -> Quotations.Expr.Var (p.Handle) |]) |> ProvidedExpr.Create methodBase.Context /// Compute the Name or FullName property of a provided type, reporting appropriate errors let CheckAndComputeProvidedNameProperty(m, st: Tainted, proj, propertyString) = @@ -862,16 +862,16 @@ module internal ExtensionTyping = let newError = tpe.MapText((fun msg -> FSComp.SR.etProvidedTypeWithNameException(propertyString, msg)), st.TypeProviderDesignation, m) raise newError if String.IsNullOrEmpty name then - raise (TypeProviderError(FSComp.SR.etProvidedTypeWithNullOrEmptyName(propertyString), st.TypeProviderDesignation, m)) + raise (TypeProviderError(FSComp.SR.etProvidedTypeWithNullOrEmptyName propertyString, st.TypeProviderDesignation, m)) name /// Verify that this type provider has supported attributes let ValidateAttributesOfProvidedType (m, st: Tainted) = let fullName = CheckAndComputeProvidedNameProperty(m, st, (fun st -> st.FullName), "FullName") if TryTypeMember(st, fullName, "IsGenericType", m, false, fun st->st.IsGenericType) |> unmarshal then - errorR(Error(FSComp.SR.etMustNotBeGeneric(fullName), m)) + errorR(Error(FSComp.SR.etMustNotBeGeneric fullName, m)) if TryTypeMember(st, fullName, "IsArray", m, false, fun st->st.IsArray) |> unmarshal then - errorR(Error(FSComp.SR.etMustNotBeAnArray(fullName), m)) + errorR(Error(FSComp.SR.etMustNotBeAnArray fullName, m)) TryTypeMemberNonNull(st, fullName, "GetInterfaces", m, [||], fun st -> st.GetInterfaces()) |> ignore @@ -908,13 +908,13 @@ module internal ExtensionTyping = // Must be able to call (GetMethods|GetEvents|GetPropeties|GetNestedTypes|GetConstructors)(bindingFlags). let usedMembers : Tainted[] = // These are the members the compiler will actually use - [| for x in TryTypeMemberArray(st, fullName, "GetMethods", m, fun st -> st.GetMethods()) -> x.Coerce(m) - for x in TryTypeMemberArray(st, fullName, "GetEvents", m, fun st -> st.GetEvents()) -> x.Coerce(m) - for x in TryTypeMemberArray(st, fullName, "GetFields", m, fun st -> st.GetFields()) -> x.Coerce(m) - for x in TryTypeMemberArray(st, fullName, "GetProperties", m, fun st -> st.GetProperties()) -> x.Coerce(m) + [| for x in TryTypeMemberArray(st, fullName, "GetMethods", m, fun st -> st.GetMethods()) -> x.Coerce m + for x in TryTypeMemberArray(st, fullName, "GetEvents", m, fun st -> st.GetEvents()) -> x.Coerce m + for x in TryTypeMemberArray(st, fullName, "GetFields", m, fun st -> st.GetFields()) -> x.Coerce m + for x in TryTypeMemberArray(st, fullName, "GetProperties", m, fun st -> st.GetProperties()) -> x.Coerce m // These will be validated on-demand - //for x in TryTypeMemberArray(st, fullName, "GetNestedTypes", m, fun st -> st.GetNestedTypes(bindingFlags)) -> x.Coerce() - for x in TryTypeMemberArray(st, fullName, "GetConstructors", m, fun st -> st.GetConstructors()) -> x.Coerce(m) |] + //for x in TryTypeMemberArray(st, fullName, "GetNestedTypes", m, fun st -> st.GetNestedTypes bindingFlags) -> x.Coerce() + for x in TryTypeMemberArray(st, fullName, "GetConstructors", m, fun st -> st.GetConstructors()) -> x.Coerce m |] fullName, namespaceName, usedMembers // We scrutinize namespaces for invalid characters on open, but this provides better diagnostics @@ -926,11 +926,11 @@ module internal ExtensionTyping = // This needs to be a *shallow* exploration. Otherwise, as in Freebase sample the entire database could be explored. for mi in usedMembers do match mi with - | Tainted.Null -> errorR(Error(FSComp.SR.etNullMember(fullName), m)) + | Tainted.Null -> errorR(Error(FSComp.SR.etNullMember fullName, m)) | _ -> let memberName = TryMemberMember(mi, fullName, "Name", "Name", m, "invalid provided type member name", fun mi -> mi.Name) |> unmarshal - if String.IsNullOrEmpty(memberName) then - errorR(Error(FSComp.SR.etNullOrEmptyMemberName(fullName), m)) + if String.IsNullOrEmpty memberName then + errorR(Error(FSComp.SR.etNullOrEmptyMemberName fullName, m)) else let miDeclaringType = TryMemberMember(mi, fullName, memberName, "DeclaringType", m, ProvidedType.CreateNoContext(typeof), fun mi -> mi.DeclaringType) match miDeclaringType with @@ -1015,7 +1015,7 @@ module internal ExtensionTyping = | -1 -> () | n -> errorR(Error(FSComp.SR.etIllegalCharactersInTypeName(string expectedName.[n], expectedName), m)) - let staticParameters = st.PApplyWithProvider((fun (st, provider) -> st.GetStaticParameters(provider)), range=m) + let staticParameters = st.PApplyWithProvider((fun (st, provider) -> st.GetStaticParameters provider), range=m) if staticParameters.PUntaint((fun a -> a.Length), m) = 0 then ValidateProvidedTypeAfterStaticInstantiation(m, st, expectedPath, expectedName) @@ -1095,7 +1095,7 @@ module internal ExtensionTyping = else let mangledName = let nm = methBeforeArgs.PUntaint((fun x -> x.Name), m) - let staticParams = methBeforeArgs.PApplyWithProvider((fun (mb, resolver) -> mb.GetStaticParametersForMethod(resolver)), range=m) + let staticParams = methBeforeArgs.PApplyWithProvider((fun (mb, resolver) -> mb.GetStaticParametersForMethod resolver), range=m) let mangledName = ComputeMangledNameForApplyStaticParameters(nm, staticArgs, staticParams, m) mangledName @@ -1122,7 +1122,7 @@ module internal ExtensionTyping = // Otherwise, use the full path of the erased type, including mangled arguments let nm = typeBeforeArguments.PUntaint((fun x -> x.Name), m) let enc, _ = ILPathToProvidedType (typeBeforeArguments, m) - let staticParams = typeBeforeArguments.PApplyWithProvider((fun (mb, resolver) -> mb.GetStaticParameters(resolver)), range=m) + let staticParams = typeBeforeArguments.PApplyWithProvider((fun (mb, resolver) -> mb.GetStaticParameters resolver), range=m) let mangledName = ComputeMangledNameForApplyStaticParameters(nm, staticArgs, staticParams, m) enc @ [ mangledName ] @@ -1145,7 +1145,7 @@ module internal ExtensionTyping = try PrettyNaming.demangleProvidedTypeName typeLogicalName with PrettyNaming.InvalidMangledStaticArg piece -> - error(Error(FSComp.SR.etProvidedTypeReferenceInvalidText(piece), range0)) + error(Error(FSComp.SR.etProvidedTypeReferenceInvalidText piece, range0)) let argSpecsTable = dict argNamesAndValues let typeBeforeArguments = ResolveProvidedType(resolver, range0, moduleOrNamespace, typeName) @@ -1155,7 +1155,7 @@ module internal ExtensionTyping = | _ -> // Take the static arguments (as strings, taken from the text in the reference we're relinking), // and convert them to objects of the appropriate type, based on the expected kind. - let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, resolver) -> typeBeforeArguments.GetStaticParameters(resolver)), range=range0) + let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, resolver) -> typeBeforeArguments.GetStaticParameters resolver), range=range0) let staticParameters = staticParameters.PApplyArray(id, "", m) @@ -1163,7 +1163,7 @@ module internal ExtensionTyping = staticParameters |> Array.map (fun sp -> let typeBeforeArgumentsName = typeBeforeArguments.PUntaint ((fun st -> st.Name), m) let spName = sp.PUntaint ((fun sp -> sp.Name), m) - match argSpecsTable.TryGetValue(spName) with + match argSpecsTable.TryGetValue spName with | true, arg -> /// Find the name of the representation type for the static parameter let spReprTypeName = @@ -1196,7 +1196,7 @@ module internal ExtensionTyping = | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, typeBeforeArgumentsName, typeBeforeArgumentsName, spName), range0)) | v -> v else - error(Error(FSComp.SR.etProvidedTypeReferenceMissingArgument(spName), range0))) + error(Error(FSComp.SR.etProvidedTypeReferenceMissingArgument spName, range0))) match TryApplyProvidedType(typeBeforeArguments, None, staticArgs, range0) with diff --git a/src/fsharp/FSharp.Core/Linq.fs b/src/fsharp/FSharp.Core/Linq.fs index 84802d1cd..68e8fde5f 100644 --- a/src/fsharp/FSharp.Core/Linq.fs +++ b/src/fsharp/FSharp.Core/Linq.fs @@ -213,7 +213,7 @@ module LeafExpressionConverter = let SubstHelperRaw (q:Expr, x:Var[], y:obj[]) : Expr = let d = Map.ofArray (Array.zip x y) - q.Substitute(fun v -> v |> d.TryFind |> Option.map (fun x -> Expr.Value(x, v.Type))) + q.Substitute(fun v -> v |> d.TryFind |> Option.map (fun x -> Expr.Value (x, v.Type))) let SubstHelper<'T> (q:Expr, x:Var[], y:obj[]) : Expr<'T> = SubstHelperRaw(q, x, y) |> Expr.Cast @@ -846,9 +846,9 @@ module LeafExpressionConverter = | Value (obj, _) -> obj | _ -> let ty = e.Type - let e = Expr.NewDelegate(Expression.GetFuncType([|typeof; ty |]), [new Var("unit", typeof)], e) + let e = Expr.NewDelegate (Expression.GetFuncType([|typeof; ty |]), [new Var("unit", typeof)], e) let linqExpr = (ConvExprToLinq e:?> LambdaExpression) - let d = linqExpr.Compile() + let d = linqExpr.Compile () try d.DynamicInvoke [| box () |] with :? System.Reflection.TargetInvocationException as exn -> diff --git a/src/fsharp/FSharp.Core/Query.fs b/src/fsharp/FSharp.Core/Query.fs index 7a4f9b2f5..1a0d2cf14 100644 --- a/src/fsharp/FSharp.Core/Query.fs +++ b/src/fsharp/FSharp.Core/Query.fs @@ -316,7 +316,7 @@ module Query = let asExpr x = (x :> Expression) let (|Getter|_|) (prop: PropertyInfo) = - match prop.GetGetMethod(true) with + match prop.GetGetMethod true with | null -> None | v -> Some v @@ -400,18 +400,18 @@ module Query = let MakeGenericStaticMethod (methHandle:System.RuntimeMethodHandle) = let methInfo = methHandle |> System.Reflection.MethodInfo.GetMethodFromHandle :?> MethodInfo - (fun (tyargs: Type list, args: Expr list) -> Expr.Call(BindGenericStaticMethod methInfo tyargs, args)) + (fun (tyargs: Type list, args: Expr list) -> Expr.Call (BindGenericStaticMethod methInfo tyargs, args)) let MakeGenericInstanceMethod (methHandle:System.RuntimeMethodHandle) = let methInfo = methHandle |> System.Reflection.MethodInfo.GetMethodFromHandle :?> MethodInfo - (fun (obj:Expr, tyargs: Type list, args: Expr list) -> Expr.Call(obj, BindGenericStaticMethod methInfo tyargs, args)) + (fun (obj:Expr, tyargs: Type list, args: Expr list) -> Expr.Call (obj, BindGenericStaticMethod methInfo tyargs, args)) let ImplicitExpressionConversionHelperMethodInfo = methodhandleof (fun e -> LeafExpressionConverter.ImplicitExpressionConversionHelper e) |> System.Reflection.MethodInfo.GetMethodFromHandle :?> MethodInfo - let MakeImplicitExpressionConversion (x:Expr) = Expr.Call(ImplicitExpressionConversionHelperMethodInfo.MakeGenericMethod [| x.Type |], [ x ]) + let MakeImplicitExpressionConversion (x:Expr) = Expr.Call (ImplicitExpressionConversionHelperMethodInfo.MakeGenericMethod [| x.Type |], [ x ]) let NT = typedefof> @@ -447,7 +447,7 @@ module Query = let qTyIsIQueryable (ty : System.Type) = not (ty.Equals(typeof)) let FuncExprToDelegateExpr (srcTy, targetTy, v, body) = - Expr.NewDelegate(Linq.Expressions.Expression.GetFuncType [| srcTy; targetTy |], [v], body) + Expr.NewDelegate (Linq.Expressions.Expression.GetFuncType [| srcTy; targetTy |], [v], body) /// Project F# function expressions to Linq LambdaExpression nodes let FuncExprToLinqFunc2Expression (srcTy, targetTy, v, body) = @@ -611,9 +611,9 @@ module Query = // The F# implementation needs a QuerySource as a parameter. let qTy = typeof let ctor = typedefof>.MakeGenericType([|srcItemTy; qTy|]).GetConstructors().[0] - let src = Expr.NewObject(ctor, [src]) + let src = Expr.NewObject (ctor, [src]) // The F# implementation needs an FSharpFunc as a parameter. - let selector = Expr.Lambda(v, res) + let selector = Expr.Lambda (v, res) ME (qb, [srcItemTy; qTy; resTyNoNullable], [src; selector]) let Call (qb:obj, isIQ, srcItemTy:Type, resTyNoNullable:Type, src:obj, resTy:Type, v:Var, res:Expr) = @@ -740,7 +740,7 @@ module Query = let MakeCount, CallCount = MakeOrCallSimpleOp (methodhandleof (fun x -> System.Linq.Queryable.Count x)) (methodhandleof (fun x -> Enumerable.Count x)) - let MakeDefaultIfEmpty = MakeGenericStaticMethod (methodhandleof (fun x -> Enumerable.DefaultIfEmpty(x))) + let MakeDefaultIfEmpty = MakeGenericStaticMethod (methodhandleof (fun x -> Enumerable.DefaultIfEmpty x)) /// Indicates if we can eliminate redundant 'Select(x=>x)' nodes type CanEliminate = @@ -756,11 +756,11 @@ module Query = // Eliminate degenerate 'Select(x => x)', except for the very outer-most cases match f with - | Patterns.Var(v2) when v = v2 && canElim = CanEliminate.Yes -> src + | Patterns.Var v2 when v = v2 && canElim = CanEliminate.Yes -> src | _ -> let srcItemTy = v.Type let targetTy = f.Type - let selector = Expr.NewDelegate(MakeQueryFuncTy(srcItemTy, targetTy), [v], f) + let selector = Expr.NewDelegate (MakeQueryFuncTy(srcItemTy, targetTy), [v], f) if isIQ then let selector = MakeImplicitExpressionConversion selector @@ -785,11 +785,11 @@ module Query = let MakeEnumerableEmpty = let F = MakeGenericStaticMethod (methodhandleof (fun _x -> Enumerable.Empty())) - fun (ty) -> + fun ty -> F ([ty], []) let MakeEmpty = - fun (ty) -> + fun ty -> MakeAsQueryable (ty, MakeEnumerableEmpty ty) let MakeSelectMany = @@ -798,8 +798,8 @@ module Query = fun (isIQ, resTy:Type, src:Expr, srcItemVar:Var, interimSelectorBody:Expr, interimVar:Var, targetSelectorBody:Expr) -> let srcItemTy = srcItemVar.Type let interimTy = interimVar.Type - let interimSelector = Expr.NewDelegate(MakeQueryFuncTy(srcItemTy, MakeIEnumerableTy interimTy), [srcItemVar], interimSelectorBody) - let targetSelector = Expr.NewDelegate(MakeQueryFunc2Ty(srcItemTy, interimTy, resTy), [srcItemVar; interimVar], targetSelectorBody) + let interimSelector = Expr.NewDelegate (MakeQueryFuncTy(srcItemTy, MakeIEnumerableTy interimTy), [srcItemVar], interimSelectorBody) + let targetSelector = Expr.NewDelegate (MakeQueryFunc2Ty(srcItemTy, interimTy, resTy), [srcItemVar; interimVar], targetSelectorBody) if isIQ then let interimSelector = MakeImplicitExpressionConversion interimSelector @@ -812,7 +812,7 @@ module Query = let FQ = MakeGenericStaticMethod (methodhandleof (fun (x, y:Expression>) -> System.Linq.Queryable.Where(x, y))) let FE = MakeGenericStaticMethod (methodhandleof (fun (x, y:Func<_, _>) -> Enumerable.Where(x, y))) fun (isIQ, src:Expr, v:Var, f) -> - let selector = Expr.NewDelegate(MakeQueryFuncTy(v.Type, typeof), [v], f) + let selector = Expr.NewDelegate (MakeQueryFuncTy(v.Type, typeof), [v], f) if isIQ then let selector = MakeImplicitExpressionConversion selector @@ -824,7 +824,7 @@ module Query = fun (isIQ, src:Expr, v:Var, keySelector:Expr) -> let srcItemTy = v.Type let keyItemTy = keySelector.Type - let selector = Expr.NewDelegate(MakeQueryFuncTy(srcItemTy, keyItemTy), [v], keySelector) + let selector = Expr.NewDelegate (MakeQueryFuncTy(srcItemTy, keyItemTy), [v], keySelector) if isIQ then let selector = MakeImplicitExpressionConversion selector FQ ([srcItemTy; keyItemTy], [src; selector]) @@ -865,7 +865,7 @@ module Query = let FE = MakeGenericStaticMethod FE fun (isIQ, src:Expr, v:Var, predicate) -> let srcItemTy = v.Type - let selector = Expr.NewDelegate(MakeQueryFuncTy(srcItemTy, boolTy), [v], predicate) + let selector = Expr.NewDelegate (MakeQueryFuncTy(srcItemTy, boolTy), [v], predicate) if isIQ then let selector = MakeImplicitExpressionConversion selector FQ ([srcItemTy], [src; selector]) @@ -916,7 +916,7 @@ module Query = fun (isIQ, src:Expr, v:Var, keySelector:Expr) -> let srcItemTy = v.Type let keyTy = keySelector.Type - let keySelector = Expr.NewDelegate(MakeQueryFuncTy(srcItemTy, keyTy), [v], keySelector) + let keySelector = Expr.NewDelegate (MakeQueryFuncTy(srcItemTy, keyTy), [v], keySelector) if isIQ then let keySelector = MakeImplicitExpressionConversion keySelector @@ -928,8 +928,8 @@ module Query = let FQ = MakeGenericStaticMethod (methodhandleof (fun (x, y:Expression>, z:Expression>) -> System.Linq.Queryable.GroupBy(x, y, z))) let FE = MakeGenericStaticMethod (methodhandleof (fun (x, y:Func<_, _>, z:Func<_, _>) -> Enumerable.GroupBy(x, y, z))) fun (isIQ, srcItemTy, keyTy, elementTy, src:Expr, v1, keySelector, v2, elementSelector) -> - let keySelector = Expr.NewDelegate(MakeQueryFuncTy(srcItemTy, keyTy), [v1], keySelector) - let elementSelector = Expr.NewDelegate(MakeQueryFuncTy(srcItemTy, elementTy), [v2], elementSelector) + let keySelector = Expr.NewDelegate (MakeQueryFuncTy(srcItemTy, keyTy), [v1], keySelector) + let elementSelector = Expr.NewDelegate (MakeQueryFuncTy(srcItemTy, elementTy), [v2], elementSelector) if isIQ then let keySelector = MakeImplicitExpressionConversion keySelector @@ -942,9 +942,9 @@ module Query = let FQ = MakeGenericStaticMethod (methodhandleof (fun (a1, a2, a3:Expression>, a4:Expression>, a5:Expression>) -> System.Linq.Queryable.Join(a1, a2, a3, a4, a5))) let FE = MakeGenericStaticMethod (methodhandleof (fun (a1, a2, a3:Func<_, _>, a4:Func<_, _>, a5:Func<_, _, _>) -> Enumerable.Join(a1, a2, a3, a4, a5))) fun (isIQ, outerSourceTy, innerSourceTy, keyTy, resTy, outerSource:Expr, innerSource:Expr, outerKeyVar, outerKeySelector, innerKeyVar, innerKeySelector, outerResultKeyVar, innerResultKeyVar, elementSelector) -> - let outerKeySelector = Expr.NewDelegate(MakeQueryFuncTy(outerSourceTy, keyTy), [outerKeyVar], outerKeySelector) - let innerKeySelector = Expr.NewDelegate(MakeQueryFuncTy(innerSourceTy, keyTy), [innerKeyVar], innerKeySelector) - let elementSelector = Expr.NewDelegate(MakeQueryFunc2Ty(outerSourceTy, innerSourceTy, resTy), [outerResultKeyVar; innerResultKeyVar], elementSelector) + let outerKeySelector = Expr.NewDelegate (MakeQueryFuncTy(outerSourceTy, keyTy), [outerKeyVar], outerKeySelector) + let innerKeySelector = Expr.NewDelegate (MakeQueryFuncTy(innerSourceTy, keyTy), [innerKeyVar], innerKeySelector) + let elementSelector = Expr.NewDelegate (MakeQueryFunc2Ty(outerSourceTy, innerSourceTy, resTy), [outerResultKeyVar; innerResultKeyVar], elementSelector) if isIQ then let outerKeySelector = MakeImplicitExpressionConversion outerKeySelector @@ -958,9 +958,9 @@ module Query = let FQ = MakeGenericStaticMethod (methodhandleof (fun (a1, a2, a3:Expression>, a4:Expression>, a5:Expression>) -> System.Linq.Queryable.GroupJoin(a1, a2, a3, a4, a5))) let FE = MakeGenericStaticMethod (methodhandleof (fun (a1, a2, a3:Func<_, _>, a4:Func<_, _>, a5:Func<_, _, _>) -> Enumerable.GroupJoin(a1, a2, a3, a4, a5))) fun (isIQ, outerSourceTy, innerSourceTy, keyTy, resTy, outerSource:Expr, innerSource:Expr, outerKeyVar, outerKeySelector, innerKeyVar, innerKeySelector, outerResultKeyVar, innerResultGroupVar, elementSelector) -> - let outerKeySelector = Expr.NewDelegate(MakeQueryFuncTy(outerSourceTy, keyTy), [outerKeyVar], outerKeySelector) - let innerKeySelector = Expr.NewDelegate(MakeQueryFuncTy(innerSourceTy, keyTy), [innerKeyVar], innerKeySelector) - let elementSelector = Expr.NewDelegate(MakeQueryFunc2Ty(outerSourceTy, MakeIEnumerableTy(innerSourceTy), resTy), [outerResultKeyVar; innerResultGroupVar], elementSelector) + let outerKeySelector = Expr.NewDelegate (MakeQueryFuncTy(outerSourceTy, keyTy), [outerKeyVar], outerKeySelector) + let innerKeySelector = Expr.NewDelegate (MakeQueryFuncTy(innerSourceTy, keyTy), [innerKeyVar], innerKeySelector) + let elementSelector = Expr.NewDelegate (MakeQueryFunc2Ty(outerSourceTy, MakeIEnumerableTy innerSourceTy, resTy), [outerResultKeyVar; innerResultGroupVar], elementSelector) if isIQ then let outerKeySelector = MakeImplicitExpressionConversion outerKeySelector let innerKeySelector = MakeImplicitExpressionConversion innerKeySelector @@ -976,7 +976,7 @@ module Query = | None -> match p with | ExprShape.ShapeCombination(comb, args) -> ExprShape.RebuildShapeCombination(comb, List.map walk args) - | ExprShape.ShapeLambda(v, body) -> Expr.Lambda(v, walk body) + | ExprShape.ShapeLambda(v, body) -> Expr.Lambda (v, walk body) | ExprShape.ShapeVar _ -> p walk q @@ -999,7 +999,7 @@ module Query = Some body // Macro - | PropertyGet(None, Getter(MethodWithReflectedDefinition(body)), []) -> + | PropertyGet(None, Getter(MethodWithReflectedDefinition body), []) -> Some body // Macro @@ -1009,7 +1009,7 @@ module Query = ||> List.map2 (fun vs arg -> match vs, arg with | [v], arg -> [(v, arg)] - | vs, NewTuple(args) -> List.zip vs args + | vs, NewTuple args -> List.zip vs args | _ -> List.zip vs [arg]) |> List.concat |> Map.ofSeq let body = body.Substitute tab.TryFind @@ -1045,11 +1045,11 @@ module Query = | MacroReduction reduced -> Some (walk reduced) | _ -> None) - let (|CallQueryBuilderRunQueryable|_|) : Quotations.Expr -> _ = (|SpecificCallToMethod|_|) (methodhandleof (fun (b :QueryBuilder, v) -> b.Run(v))) + let (|CallQueryBuilderRunQueryable|_|) : Quotations.Expr -> _ = (|SpecificCallToMethod|_|) (methodhandleof (fun (b :QueryBuilder, v) -> b.Run v)) - let (|CallQueryBuilderRunValue|_|) : Quotations.Expr -> _ = (|SpecificCallToMethod|_|) (methodhandleof (fun (b : QueryBuilder, v : Expr<'a>) -> b.Run(v)) : 'a) + let (|CallQueryBuilderRunValue|_|) : Quotations.Expr -> _ = (|SpecificCallToMethod|_|) (methodhandleof (fun (b : QueryBuilder, v : Expr<'a>) -> b.Run v) : 'a) - let (|CallQueryBuilderRunEnumerable|_|) : Quotations.Expr -> _ = (|SpecificCallToMethod|_|) (methodhandleof (fun (b : QueryBuilder, v : Expr> ) -> b.Run(v))) + let (|CallQueryBuilderRunEnumerable|_|) : Quotations.Expr -> _ = (|SpecificCallToMethod|_|) (methodhandleof (fun (b : QueryBuilder, v : Expr> ) -> b.Run v)) let (|CallQueryBuilderFor|_|) : Quotations.Expr -> _ = (|SpecificCallToMethod|_|) (methodhandleof (fun (b:QueryBuilder, source:QuerySource, body) -> b.For(source, body))) @@ -1109,7 +1109,7 @@ module Query = let (|CallForAll|_|) = (|SpecificCall2|_|) (methodhandleof (fun (query:QueryBuilder, arg1, arg2) -> query.All(arg1, arg2))) - let (|CallDistinct|_|) = (|SpecificCall1|_|) (methodhandleof (fun (query:QueryBuilder, keySelector) -> query.Distinct(keySelector))) + let (|CallDistinct|_|) = (|SpecificCall1|_|) (methodhandleof (fun (query:QueryBuilder, keySelector) -> query.Distinct keySelector)) let (|CallTake|_|) = (|SpecificCall2|_|) (methodhandleof (fun (query:QueryBuilder, arg1, arg2) -> query.Take(arg1, arg2))) @@ -1137,9 +1137,9 @@ module Query = let (|CallSumByNullable|_|) = (|SpecificCall2|_|) (methodhandleof (fun (query:QueryBuilder, arg1:QuerySource, arg2:(double->Nullable)) -> query.SumByNullable(arg1, arg2))) - let (|CallCount|_|) = (|SpecificCall1|_|) (methodhandleof (fun (query:QueryBuilder, arg1) -> query.Count(arg1))) + let (|CallCount|_|) = (|SpecificCall1|_|) (methodhandleof (fun (query:QueryBuilder, arg1) -> query.Count arg1)) - let (|CallHead|_|) = (|SpecificCall1|_|) (methodhandleof (fun (query:QueryBuilder, arg1) -> query.Head(arg1))) + let (|CallHead|_|) = (|SpecificCall1|_|) (methodhandleof (fun (query:QueryBuilder, arg1) -> query.Head arg1)) let (|CallFind|_|) = (|SpecificCall2|_|) (methodhandleof (fun (query:QueryBuilder, arg1, arg2) -> query.Find(arg1, arg2))) @@ -1157,7 +1157,7 @@ module Query = | TupleConv convs -> Expr.NewTuple (convs |> List.mapi (fun i conv -> ConvMutableToImmutable conv (AnonymousObjectGet (mutExpr, i)))) | RecordConv (typ, convs) -> - Expr.NewRecord(typ, convs |> List.mapi (fun i conv -> ConvMutableToImmutable conv (AnonymousObjectGet (mutExpr, i)))) + Expr.NewRecord (typ, convs |> List.mapi (fun i conv -> ConvMutableToImmutable conv (AnonymousObjectGet (mutExpr, i)))) | SeqConv conv -> @@ -1166,7 +1166,7 @@ module Query = let isIQ = IsIQueryableTy mutExpr.Type assert (IsIEnumerableTy mutExpr.Type || IsIQueryableTy mutExpr.Type) let mutElemTy = mutExpr.Type.GetGenericArguments().[0] - let mutExpr = if isIQ then Expr.Coerce(mutExpr, MakeIEnumerableTy mutElemTy) else mutExpr + let mutExpr = if isIQ then Expr.Coerce (mutExpr, MakeIEnumerableTy mutElemTy) else mutExpr // Generate "source.Select(fun v -> ...)" (remembering that Select is an extension member, i.e. static) let mutVar = new Var("v", mutElemTy) let mutToImmutConvExpr = ConvMutableToImmutable conv (Expr.Var mutVar) @@ -1187,10 +1187,10 @@ module Query = // Construct an IGrouping let args = - [ Expr.PropertyGet(mutExpr, mutExpr.Type.GetProperty "Key") + [ Expr.PropertyGet (mutExpr, mutExpr.Type.GetProperty "Key") MakeSelect(CanEliminate.Yes, false, mutExpr, var, convExpr) ] - Expr.Coerce(Expr.NewObject(immutGroupingTy.GetConstructors().[0], args), immutIGroupingTy) + Expr.Coerce (Expr.NewObject (immutGroupingTy.GetConstructors().[0], args), immutIGroupingTy) | NoConv -> mutExpr @@ -1252,7 +1252,7 @@ module Query = // We eliminate the Select here to keep the information in 'mutSource' available, i.e. whether // the mutSource is a TransInnerResult.Source after elimination match mutSelectorBody with - | Patterns.Var(v2) when mutSelectorVar = v2 && canElim = CanEliminate.Yes -> mutSource + | Patterns.Var v2 when mutSelectorVar = v2 && canElim = CanEliminate.Yes -> mutSource | _ -> Select(canElim, isQTy, mutSource, mutSelectorVar, mutSelectorBody) @@ -1340,7 +1340,7 @@ module Query = | _ -> let mutInterimSelectorBody = CommitTransInnerResult mutSelectorBodyInfo let mutInterimVar = Var("x", mutElemTy) - let mutTargetSelector = Expr.Var(mutInterimVar) + let mutTargetSelector = Expr.Var mutInterimVar mutInterimSelectorBody, mutInterimVar, mutTargetSelector // IQueryable.SelectMany expects an IEnumerable return @@ -1350,7 +1350,7 @@ module Query = mutInterimSelectorBodyPreCoerce else let mutSeqTy = MakeIEnumerableTy mutInterimVar.Type - Expr.Coerce(mutInterimSelectorBodyPreCoerce, mutSeqTy) + Expr.Coerce (mutInterimSelectorBodyPreCoerce, mutSeqTy) TransInnerResult.Other(MakeSelectMany(qTyIsIQueryable qTy, mutElemTy, CommitTransInnerResult mutSource, mutSelectorVar, mutInterimSelectorBody, mutInterimVar, mutTargetSelector)), selectorConv @@ -1374,22 +1374,22 @@ module Query = | CallQueryBuilderYield (_, [elemTy; qTy], immutSelectorBody) -> let immutSelectorBody = CleanupLeaf immutSelectorBody - let enumExpr = Expr.Coerce(Expr.NewArray(elemTy, [ immutSelectorBody ]), MakeIEnumerableTy elemTy) + let enumExpr = Expr.Coerce (Expr.NewArray (elemTy, [ immutSelectorBody ]), MakeIEnumerableTy elemTy) let expr = if qTyIsIQueryable qTy then MakeAsQueryable(elemTy, enumExpr) else enumExpr - TransInnerResult.Other(expr), NoConv + TransInnerResult.Other expr, NoConv | IfThenElse (g, t, e) -> match MacroExpand e with | ZeroOnElseBranch -> let t, tConv = TransInnerAndCommit CanEliminate.Yes check t - TransInnerResult.Other(Expr.IfThenElse(g, t, MakeEmpty t.Type)), tConv + TransInnerResult.Other(Expr.IfThenElse (g, t, MakeEmpty t.Type)), tConv | _ -> if check then raise (NotSupportedException (SR.GetString(SR.unsupportedIfThenElse)) ) - TransInnerResult.Other(e), NoConv + TransInnerResult.Other e, NoConv | CallSortBy (_, [_; qTy; _], source, Lambda(v, keySelector)) -> let source, sourceConv, v, keySelector = TransInnerApplicativeAndCommit check source (v, keySelector) @@ -1555,10 +1555,10 @@ module Query = TransInner canElim check reduced | CallQueryBuilderSourceIQueryable(_, _, expr) -> - TransInnerResult.Source(expr), NoConv + TransInnerResult.Source expr, NoConv | CallQueryBuilderSourceIEnumerable (_, _, expr) -> - TransInnerResult.Source(expr), NoConv + TransInnerResult.Source expr, NoConv | Call (_, meth, _) when check -> raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryCall), meth.ToString()))) @@ -1622,7 +1622,7 @@ module Query = // if result type of nested query is derived from IQueryable but not IQueryable itself (i.e. IOrderedQueryable) // then add coercion to IQueryable so result type will match expected signature of QuerySource.Run if (IQueryableTySpec.IsAssignableFrom replNestedQuery.Type) && not (IQueryableTySpec.Equals replNestedQuery.Type) then - Expr.Coerce(replNestedQuery, IQueryableTySpec) + Expr.Coerce (replNestedQuery, IQueryableTySpec) else replNestedQuery replNestedQuery, MakeSeqConv conv @@ -1934,8 +1934,8 @@ module Query = do ForwardDeclarations.Query <- { new ForwardDeclarations.IQueryMethods with - member this.Execute(q) = QueryExecute q - member this.EliminateNestedQueries(e) = EliminateNestedQueries e + member this.Execute q = QueryExecute q + member this.EliminateNestedQueries e = EliminateNestedQueries e } diff --git a/src/fsharp/FSharp.Core/QueryExtensions.fs b/src/fsharp/FSharp.Core/QueryExtensions.fs index 1b7054f74..103232555 100644 --- a/src/fsharp/FSharp.Core/QueryExtensions.fs +++ b/src/fsharp/FSharp.Core/QueryExtensions.fs @@ -130,7 +130,7 @@ module internal Adapters = let typ = anonObjectTypes.[args.Length - 1] let typ = typ.MakeGenericType [| for a in args -> a.Type |] let ctor = typ.GetConstructors().[0] - let res = Expr.NewObject(ctor, args) + let res = Expr.NewObject (ctor, args) assert (match res with NewAnonymousObject _ -> true | _ -> false) res @@ -149,7 +149,7 @@ module internal Adapters = // Get property (at most the last one) let propInfo = newType.GetProperty ("Item" + string (1 + min i 7)) - let res = Expr.PropertyGet(inst, propInfo) + let res = Expr.PropertyGet (inst, propInfo) // Do we need to add another property get for the last property? if i < 7 then res else walk (i - 7) res (newType.GetGenericArguments().[7]) @@ -240,7 +240,7 @@ module internal Adapters = let expr = match expr with | ExprShape.ShapeCombination(comb,args) -> match args with [] -> expr | _ -> ExprShape.RebuildShapeCombination(comb,List.map CleanupLeaf args) - | ExprShape.ShapeLambda(v,body) -> Expr.Lambda(v, CleanupLeaf body) + | ExprShape.ShapeLambda(v,body) -> Expr.Lambda (v, CleanupLeaf body) | ExprShape.ShapeVar _ -> expr match expr with @@ -249,13 +249,13 @@ module internal Adapters = | ObjectConstruction(var, init, propSets) -> // Wrap object initialization into a value ( let methInfo = MemberInitializationHelperMeth.MakeGenericMethod [| var.Type |] - Expr.Call(methInfo, [ List.reduceBack (fun a b -> Expr.Sequential(a,b)) (propSets @ [init]) ]) + Expr.Call (methInfo, [ List.reduceBack (fun a b -> Expr.Sequential (a,b)) (propSets @ [init]) ]) // Detect all anonymous type constructions - wrap them in 'NewAnonymousObjectHelper' // so that it can be translated to Expression.New with member arguments. | NewAnonymousObject(ctor, args) -> let methInfo = NewAnonymousObjectHelperMeth.MakeGenericMethod [| ctor.DeclaringType |] - Expr.Call(methInfo, [ Expr.NewObject(ctor,args) ]) + Expr.Call (methInfo, [ Expr.NewObject (ctor,args) ]) | expr -> expr @@ -265,7 +265,7 @@ module internal Adapters = let e = match e with | ExprShape.ShapeCombination(comb,args) -> ExprShape.RebuildShapeCombination(comb,List.map SimplifyConsumingExpr args) - | ExprShape.ShapeLambda(v,body) -> Expr.Lambda(v, SimplifyConsumingExpr body) + | ExprShape.ShapeLambda(v,body) -> Expr.Lambda (v, SimplifyConsumingExpr body) | ExprShape.ShapeVar _ -> e match e with | Patterns.TupleGet(Patterns.NewTuple els,i) -> els.[i] diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index 0e94edde2..11b56781f 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -4,7 +4,7 @@ namespace Microsoft.FSharp.Control #nowarn "40" #nowarn "52" // The value has been copied to ensure the original is not mutated by this operation - + open System open System.Diagnostics open System.Reflection @@ -21,20 +21,20 @@ namespace Microsoft.FSharp.Control open ReflectionAdapters #endif - type LinkedSubSource(cancellationToken : CancellationToken) = - + type LinkedSubSource(cancellationToken: CancellationToken) = + let failureCTS = new CancellationTokenSource() let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, failureCTS.Token) - + member this.Token = linkedCTS.Token member this.Cancel() = failureCTS.Cancel() - member this.Dispose() = + member this.Dispose() = linkedCTS.Dispose() failureCTS.Dispose() - + interface IDisposable with member this.Dispose() = this.Dispose() @@ -44,9 +44,9 @@ namespace Microsoft.FSharp.Control let associationTable = ConditionalWeakTable() - type ExceptionDispatchInfo with + type ExceptionDispatchInfo with - member edi.GetAssociatedSourceException() = + member edi.GetAssociatedSourceException() = let exn = edi.SourceException // Try to store the entry in the association table to allow us to recover it later. try associationTable.Add(exn, edi) with _ -> () @@ -54,13 +54,13 @@ namespace Microsoft.FSharp.Control // Capture, but prefer the saved information if available [] - static member RestoreOrCapture(exn) = - match associationTable.TryGetValue(exn) with + static member RestoreOrCapture exn = + match associationTable.TryGetValue exn with | true, edi -> edi | _ -> - ExceptionDispatchInfo.Capture(exn) + ExceptionDispatchInfo.Capture exn - member inline edi.ThrowAny() = + member inline edi.ThrowAny() = edi.Throw() Unchecked.defaultof<'T> // Note, this line should not be reached, but gives a generic return type @@ -76,28 +76,28 @@ namespace Microsoft.FSharp.Control type ccont = (OperationCanceledException -> AsyncReturn) [] - type Trampoline() = + type Trampoline() = let fake () = Unchecked.defaultof let unfake (_ : AsyncReturn) = () [] - static let bindLimitBeforeHijack = 300 + static let bindLimitBeforeHijack = 300 [] - static val mutable private thisThreadHasTrampoline : bool + static val mutable private thisThreadHasTrampoline: bool - static member ThisThreadHasTrampoline = + static member ThisThreadHasTrampoline = Trampoline.thisThreadHasTrampoline - + let mutable storedCont = None let mutable storedExnCont = None let mutable bindCount = 0 - + /// Use this trampoline on the synchronous stack if none exists, and execute /// the given function. The function might write its continuation into the trampoline. [] - member __.Execute (firstAction : unit -> AsyncReturn) = + member __.Execute (firstAction: unit -> AsyncReturn) = let thisIsTopTrampoline = if Trampoline.thisThreadHasTrampoline then @@ -108,69 +108,69 @@ namespace Microsoft.FSharp.Control try let mutable keepGoing = true let mutable action = firstAction - while keepGoing do - try + while keepGoing do + try action() |> unfake match storedCont with | None -> keepGoing <- false - | Some cont -> + | Some cont -> storedCont <- None action <- cont // Let the exception propagate all the way to the trampoline to get a full .StackTrace entry - with exn -> + with exn -> match storedExnCont with | None -> reraise() - | Some econt -> + | Some econt -> storedExnCont <- None let edi = ExceptionDispatchInfo.RestoreOrCapture exn action <- (fun () -> econt edi) - + finally if thisIsTopTrampoline then Trampoline.thisThreadHasTrampoline <- false fake() - + /// Increment the counter estimating the size of the synchronous stack and /// return true if time to jump on trampoline. member __.IncrementBindCount() = bindCount <- bindCount + 1 bindCount >= bindLimitBeforeHijack - + /// Prepare to abandon the synchronous stack of the current execution and save the continuation in the trampoline. - member __.Set action = + member __.Set action = assert storedCont.IsNone bindCount <- 0 storedCont <- Some action fake() /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member __.OnExceptionRaised (action: econt) = + member __.OnExceptionRaised (action: econt) = assert storedExnCont.IsNone storedExnCont <- Some action type TrampolineHolder() as this = let mutable trampoline = null - + let fake () = Unchecked.defaultof static let unfake (_: AsyncReturn) = () // Preallocate this delegate and keep it in the trampoline holder. - let sendOrPostCallbackWithTrampoline = + let sendOrPostCallbackWithTrampoline = SendOrPostCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) // Preallocate this delegate and keep it in the trampoline holder. - let waitCallbackForQueueWorkItemWithTrampoline = + let waitCallbackForQueueWorkItemWithTrampoline = WaitCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) #if !FX_NO_PARAMETERIZED_THREAD_START // Preallocate this delegate and keep it in the trampoline holder. - let threadStartCallbackForStartThreadWithTrampoline = + let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) @@ -181,26 +181,26 @@ namespace Microsoft.FSharp.Control member __.ExecuteWithTrampoline firstAction = trampoline <- new Trampoline() trampoline.Execute firstAction - - member this.PostWithTrampoline (syncCtxt: SynchronizationContext) (f : unit -> AsyncReturn) = + + member this.PostWithTrampoline (syncCtxt: SynchronizationContext) (f: unit -> AsyncReturn) = syncCtxt.Post (sendOrPostCallbackWithTrampoline, state=(f |> box)) fake() - member this.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) = + member this.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) = if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then failwith "failed to queue user work item" fake() - member this.PostOrQueueWithTrampoline (syncCtxt : SynchronizationContext) f = - match syncCtxt with - | null -> this.QueueWorkItemWithTrampoline f - | _ -> this.PostWithTrampoline syncCtxt f - + member this.PostOrQueueWithTrampoline (syncCtxt: SynchronizationContext) f = + match syncCtxt with + | null -> this.QueueWorkItemWithTrampoline f + | _ -> this.PostWithTrampoline syncCtxt f + #if FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member this.StartThreadWithTrampoline (f : unit -> AsyncReturn) = + member this.StartThreadWithTrampoline (f: unit -> AsyncReturn) = #if FX_NO_THREAD - this.QueueWorkItemWithTrampoline(f) + this.QueueWorkItemWithTrampoline f #else (new Thread((fun _ -> this.Execute f |> unfake), IsBackground=true)).Start() fake() @@ -208,48 +208,48 @@ namespace Microsoft.FSharp.Control #else // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member __.StartThreadWithTrampoline (f : unit -> AsyncReturn) = - (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start(f|>box) + member __.StartThreadWithTrampoline (f: unit -> AsyncReturn) = + (new Thread(threadStartCallbackForStartThreadWithTrampoline, IsBackground=true)).Start(f|>box) fake() #endif - + /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member inline __.OnExceptionRaised(econt) = + member inline __.OnExceptionRaised econt = trampoline.OnExceptionRaised econt /// Call a continuation, but first check if an async computation should trampoline on its synchronous stack. - member inline __.HijackCheckThenCall (cont : 'T -> AsyncReturn) res = + member inline __.HijackCheckThenCall (cont: 'T -> AsyncReturn) res = if trampoline.IncrementBindCount() then trampoline.Set (fun () -> cont res) else // NOTE: this must be a tailcall cont res - + [] [] /// Represents rarely changing components of an in-flight async computation type AsyncActivationAux = { /// The active cancellation token - token : CancellationToken + token: CancellationToken /// The exception continuation - econt : econt + econt: econt /// The cancellation continuation - ccont : ccont + ccont: ccont /// Holds some commonly-allocated callbacks and a mutable location to use for a trampoline - trampolineHolder : TrampolineHolder } - + trampolineHolder: TrampolineHolder } + [] [] /// Represents context for an in-flight async computation type AsyncActivationContents<'T> = { /// The success continuation - cont : cont<'T> + cont: cont<'T> /// The rarely changing components - aux : AsyncActivationAux } + aux: AsyncActivationAux } /// A struct wrapper around AsyncActivationContents. Using a struct wrapper allows us to change representation of the /// contents at a later point, e.g. to change the contents to a .NET Task or some other representation. @@ -257,19 +257,19 @@ namespace Microsoft.FSharp.Control type AsyncActivation<'T>(contents: AsyncActivationContents<'T>) = /// Produce a new execution context for a composite async - member ctxt.WithCancellationContinuation ccont = AsyncActivation<'T> { contents with aux = { ctxt.aux with ccont = ccont } } + member ctxt.WithCancellationContinuation ccont = AsyncActivation<'T> { contents with aux = { ctxt.aux with ccont = ccont } } /// Produce a new execution context for a composite async - member ctxt.WithExceptionContinuation econt = AsyncActivation<'T> { contents with aux = { ctxt.aux with econt = econt } } + member ctxt.WithExceptionContinuation econt = AsyncActivation<'T> { contents with aux = { ctxt.aux with econt = econt } } /// Produce a new execution context for a composite async - member ctxt.WithContinuation(cont) = AsyncActivation<'U> { cont = cont; aux = contents.aux } + member ctxt.WithContinuation cont = AsyncActivation<'U> { cont = cont; aux = contents.aux } /// Produce a new execution context for a composite async - member ctxt.WithContinuations(cont, econt) = AsyncActivation<'U> { cont = cont; aux = { contents.aux with econt = econt } } + member ctxt.WithContinuations(cont, econt) = AsyncActivation<'U> { cont = cont; aux = { contents.aux with econt = econt } } /// Produce a new execution context for a composite async - member ctxt.WithContinuations(cont, econt, ccont) = AsyncActivation<'T> { contents with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } + member ctxt.WithContinuations(cont, econt, ccont) = AsyncActivation<'T> { contents with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } /// The extra information relevant to the execution of the async member ctxt.aux = contents.aux @@ -316,28 +316,28 @@ namespace Microsoft.FSharp.Control member ctxt.OnExceptionRaised() = contents.aux.trampolineHolder.OnExceptionRaised contents.aux.econt - /// Make an initial async activation. + /// Make an initial async activation. static member Create cancellationToken trampolineHolder cont econt ccont : AsyncActivation<'T> = AsyncActivation { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } - + /// Queue the success continuation of the asynchronous execution context as a work item in the thread pool /// after installing a trampoline - member ctxt.QueueContinuationWithTrampoline (result: 'T) = + member ctxt.QueueContinuationWithTrampoline (result: 'T) = let ctxt = ctxt ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline(fun () -> ctxt.cont result) /// Call the success continuation of the asynchronous execution context - member ctxt.CallContinuation(result: 'T) = + member ctxt.CallContinuation(result: 'T) = ctxt.cont result /// Represents an asynchronous computation [] type Async<'T> = - { Invoke : (AsyncActivation<'T> -> AsyncReturn) } + { Invoke: (AsyncActivation<'T> -> AsyncReturn) } /// Mutable register to help ensure that code is only executed once [] - type Latch() = + type Latch() = let mutable i = 0 /// Execute the latch @@ -360,7 +360,7 @@ namespace Microsoft.FSharp.Control | Error of ExceptionDispatchInfo | Canceled of OperationCanceledException - /// Get the result of an asynchronous computation + /// Get the result of an asynchronous computation [] member res.Commit () = match res with @@ -392,14 +392,14 @@ namespace Microsoft.FSharp.Control let mutable result = Unchecked.defaultof<_> let mutable ok = false - try + try result <- userCode arg ok <- true finally - if not ok then + if not ok then ctxt.OnExceptionRaised() - if ok then + if ok then ctxt.HijackCheckThenCall ctxt.cont result else fake() @@ -412,14 +412,14 @@ namespace Microsoft.FSharp.Control let mutable result = Unchecked.defaultof<_> let mutable ok = false - try + try result <- part2 result1 ok <- true finally - if not ok then + if not ok then ctxt.OnExceptionRaised() - if ok then + if ok then Invoke result ctxt else fake() @@ -430,43 +430,43 @@ namespace Microsoft.FSharp.Control let mutable res = Unchecked.defaultof<_> let mutable ok = false - try + try res <- userCode result1 ok <- true finally - if not ok then + if not ok then ctxt.OnExceptionRaised() - if ok then + if ok then res.Invoke ctxt - else + else fake() /// Apply 'catchFilter' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' - /// then send 'result1' to the exception continuation. + /// then send 'result1' to the exception continuation. [] let CallFilterThenInvoke (ctxt: AsyncActivation<'T>) catchFilter (edi: ExceptionDispatchInfo) : AsyncReturn = let mutable resOpt = Unchecked.defaultof<_> let mutable ok = false - try + try resOpt <- catchFilter (edi.GetAssociatedSourceException()) ok <- true finally - if not ok then + if not ok then ctxt.OnExceptionRaised() - if ok then - match resOpt with - | None -> + if ok then + match resOpt with + | None -> ctxt.HijackCheckThenCall ctxt.econt edi - | Some res -> + | Some res -> Invoke res ctxt else fake() /// Internal way of making an async from code, for exact code compat. - /// Perform a cancellation check and ensure that any exceptions raised by + /// Perform a cancellation check and ensure that any exceptions raised by /// the immediate execution of "userCode" are sent to the exception continuation. [] let ProtectedCode (ctxt: AsyncActivation<'T>) userCode = @@ -474,12 +474,12 @@ namespace Microsoft.FSharp.Control ctxt.OnCancellation () else let mutable ok = false - try + try let res = userCode ctxt ok <- true res finally - if not ok then + if not ok then ctxt.OnExceptionRaised() /// Build a primitive without any exception or resync protection @@ -502,15 +502,15 @@ namespace Microsoft.FSharp.Control else // The new continuation runs the finallyFunction and resumes the old continuation // If an exception is thrown we continue with the previous exception continuation. - let cont result = + let cont result = CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.cont result)) // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. // If an exception is thrown we continue with the previous exception continuation. - let econt exn = + let econt exn = CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.econt exn)) // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) - let ccont cexn = + let ccont cexn = CallThenContinue finallyFunction () (ctxt.WithContinuations(cont=(fun () -> ctxt.ccont cexn), econt = (fun _ -> ctxt.ccont cexn))) let newCtxt = ctxt.WithContinuations(cont=cont, econt=econt, ccont=ccont) computation.Invoke newCtxt @@ -518,15 +518,15 @@ namespace Microsoft.FSharp.Control /// Re-route the exception continuation to call to catchFunction. If catchFunction returns None then call the exception continuation. /// If it returns Some, invoke the resulting async. [] - let TryWith (ctxt: AsyncActivation<'T>) computation catchFunction = + let TryWith (ctxt: AsyncActivation<'T>) computation catchFunction = if ctxt.IsCancellationRequested then ctxt.OnCancellation () - else - let newCtxt = - ctxt.WithExceptionContinuation(fun edi -> + else + let newCtxt = + ctxt.WithExceptionContinuation(fun edi -> if ctxt.IsCancellationRequested then ctxt.OnCancellation () - else + else CallFilterThenInvoke ctxt catchFunction edi) computation.Invoke newCtxt @@ -545,26 +545,26 @@ namespace Microsoft.FSharp.Control | AsyncResult.Canceled oce -> ctxt.ccont oce) // Generate async computation which calls its continuation with the given result - let inline CreateReturnAsync res = + let inline CreateReturnAsync res = // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> ctxt.OnSuccess res) - + // The primitive bind operation. Generate a process that runs the first process, takes - // its result, applies f and then runs the new process produced. Hijack if necessary and + // its result, applies f and then runs the new process produced. Hijack if necessary and // run 'f' with exception protection let inline CreateBindAsync part1 part2 = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> + MakeAsync (fun ctxt -> Bind ctxt part1 part2) - // Call the given function with exception protection, but first + // Call the given function with exception protection, but first // check for cancellation. let inline CreateCallAsync part2 result1 = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> + MakeAsync (fun ctxt -> if ctxt.IsCancellationRequested then ctxt.OnCancellation () - else + else CallThenInvoke ctxt result1 part2) let inline CreateDelayAsync computation = @@ -572,7 +572,7 @@ namespace Microsoft.FSharp.Control CreateCallAsync computation () /// Implements the sequencing construct of async computation expressions - let inline CreateSequentialAsync part1 part2 = + let inline CreateSequentialAsync part1 part2 = // Note: this code ends up in user assemblies via inlining CreateBindAsync part1 (fun () -> part2) @@ -585,23 +585,23 @@ namespace Microsoft.FSharp.Control MakeAsync (fun ctxt -> TryWith ctxt computation (fun edi -> catchFunction edi)) /// Create an async for a try/with filtering - let inline CreateTryWithAsync catchFunction computation = + let inline CreateTryWithAsync catchFunction computation = CreateTryWithFilterAsync (fun exn -> Some (catchFunction exn)) computation - /// Call the finallyFunction if the computation results in a cancellation, and then continue with cancellation. + /// Call the finallyFunction if the computation results in a cancellation, and then continue with cancellation. /// If the finally function gives an exception then continue with cancellation regardless. - let CreateWhenCancelledAsync (finallyFunction : OperationCanceledException -> unit) computation = + let CreateWhenCancelledAsync (finallyFunction: OperationCanceledException -> unit) computation = MakeAsync (fun ctxt -> let ccont = ctxt.ccont - let newCtxt = - ctxt.WithCancellationContinuation(fun exn -> + let newCtxt = + ctxt.WithCancellationContinuation(fun exn -> CallThenContinue finallyFunction exn (ctxt.WithContinuations(cont = (fun _ -> ccont exn), econt = (fun _ -> ccont exn)))) computation.Invoke newCtxt) /// A single pre-allocated computation that fetched the current cancellation token let cancellationTokenAsync = MakeAsync (fun ctxt -> ctxt.cont ctxt.aux.token) - + /// A single pre-allocated computation that returns a unit result let unitAsync = CreateReturnAsync() @@ -614,16 +614,16 @@ namespace Microsoft.FSharp.Control Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource CreateTryFinallyAsync disposeFunction (CreateCallAsync computation resource) |> CreateWhenCancelledAsync disposeFunction - let inline CreateIgnoreAsync computation = + let inline CreateIgnoreAsync computation = CreateBindAsync computation (fun _ -> unitAsync) /// Implement the while loop construct of async computation expressions let CreateWhileAsync guardFunc computation = - if guardFunc() then + if guardFunc() then let mutable whileAsync = Unchecked.defaultof<_> - whileAsync <- CreateBindAsync computation (fun () -> if guardFunc() then whileAsync else unitAsync) + whileAsync <- CreateBindAsync computation (fun () -> if guardFunc() then whileAsync else unitAsync) whileAsync - else + else unitAsync /// Implement the for loop construct of async commputation expressions @@ -642,66 +642,66 @@ namespace Microsoft.FSharp.Control ctxt.trampolineHolder.StartThreadWithTrampoline ctxt.cont) let CreateSwitchToThreadPoolAsync() = - CreateProtectedAsync (fun ctxt -> + CreateProtectedAsync (fun ctxt -> ctxt.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont) /// Post back to the sync context regardless of which continuation is taken - let DelimitSyncContext (ctxt: AsyncActivation<_>) = + let DelimitSyncContext (ctxt: AsyncActivation<_>) = match SynchronizationContext.Current with | null -> ctxt - | syncCtxt -> + | syncCtxt -> ctxt.WithContinuations(cont = (fun x -> ctxt.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)), econt = (fun x -> ctxt.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.econt x)), ccont = (fun x -> ctxt.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.ccont x))) // When run, ensures that each of the continuations of the process are run in the same synchronization context. - let CreateDelimitedUserCodeAsync f = - CreateProtectedAsync (fun ctxt -> + let CreateDelimitedUserCodeAsync f = + CreateProtectedAsync (fun ctxt -> let ctxtWithSync = DelimitSyncContext ctxt f ctxtWithSync) [] - [] - type SuspendedAsync<'T>(ctxt : AsyncActivation<'T>) = + [] + type SuspendedAsync<'T>(ctxt: AsyncActivation<'T>) = let syncCtxt = SynchronizationContext.Current - let thread = + let thread = match syncCtxt with | null -> null // saving a thread-local access - | _ -> Thread.CurrentThread + | _ -> Thread.CurrentThread let trampolineHolder = ctxt.trampolineHolder - member __.ContinueImmediate res = + member __.ContinueImmediate res = let action () = ctxt.cont res let inline executeImmediately () = trampolineHolder.ExecuteWithTrampoline action - let currentSyncCtxt = SynchronizationContext.Current + let currentSyncCtxt = SynchronizationContext.Current match syncCtxt, currentSyncCtxt with - | null, null -> + | null, null -> executeImmediately () // See bug 370350; this logic is incorrect from the perspective of how SynchronizationContext is meant to work, // but the logic works for mainline scenarios (WinForms/WPF/ASP.NET) and we won't change it again. | _ when Object.Equals(syncCtxt, currentSyncCtxt) && thread.Equals(Thread.CurrentThread) -> executeImmediately () - | _ -> + | _ -> trampolineHolder.PostOrQueueWithTrampoline syncCtxt action member __.ContinueWithPostOrQueue res = trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> ctxt.cont res) - /// A utility type to provide a synchronization point between an asynchronous computation + /// A utility type to provide a synchronization point between an asynchronous computation /// and callers waiting on the result of that computation. /// - /// Use with care! - [] - [] + /// Use with care! + [] + [] type ResultCell<'T>() = let mutable result = None // The continuations for the result - let mutable savedConts : list> = [] + let mutable savedConts: list> = [] // The WaitHandle event for the result. Only created if needed, and set to null when disposed. let mutable resEvent = null @@ -712,31 +712,31 @@ namespace Microsoft.FSharp.Control let syncRoot = new Object() member x.GetWaitHandle() = - lock syncRoot (fun () -> - if disposed then + lock syncRoot (fun () -> + if disposed then raise (System.ObjectDisposedException("ResultCell")) - match resEvent with + match resEvent with | null -> // Start in signalled state if a result is already present. let ev = new ManualResetEvent(result.IsSome) resEvent <- ev (ev :> WaitHandle) - | ev -> + | ev -> (ev :> WaitHandle)) member x.Close() = lock syncRoot (fun () -> - if not disposed then + if not disposed then disposed <- true match resEvent with | null -> () - | ev -> + | ev -> #if FX_NO_EVENTWAITHANDLE_IDISPOSABLE - ev.Dispose() - System.GC.SuppressFinalize(ev) -#else + ev.Dispose() + System.GC.SuppressFinalize ev +#else ev.Close() -#endif +#endif resEvent <- null) interface IDisposable with @@ -749,22 +749,22 @@ namespace Microsoft.FSharp.Control /// Record the result in the ResultCell. member x.RegisterResult (res:'T, reuseThread) = - let grabbedConts = + let grabbedConts = lock syncRoot (fun () -> // Ignore multiple sets of the result. This can happen, e.g. for a race between a cancellation and a success - if x.ResultAvailable then + if x.ResultAvailable then [] // invalidOp "multiple results registered for asynchronous operation" 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 // If the resEvent exists then set it. If not we can skip setting it altogether and it won't be // created match resEvent with - | null -> + | null -> () | ev -> // Setting the event need to happen under lock so as not to race with Close() @@ -774,32 +774,32 @@ namespace Microsoft.FSharp.Control // Run the action outside the lock match grabbedConts with | [] -> fake() - | [cont] -> + | [cont] -> if reuseThread then - cont.ContinueImmediate(res) + cont.ContinueImmediate res else - cont.ContinueWithPostOrQueue(res) + cont.ContinueWithPostOrQueue res | otherwise -> - otherwise |> List.iter (fun cont -> cont.ContinueWithPostOrQueue(res) |> unfake) |> fake - + otherwise |> List.iter (fun cont -> cont.ContinueWithPostOrQueue res |> unfake) |> fake + member x.ResultAvailable = result.IsSome /// Await the result of a result cell, without a direct timeout or direct /// cancellation. That is, the underlying computation must fill the result /// if cancellation or timeout occurs. member x.AwaitResult_NoDirectCancelOrTimeout = - MakeAsync (fun ctxt -> - // Check if a result is available synchronously + MakeAsync (fun ctxt -> + // Check if a result is available synchronously let resOpt = match result with | Some _ -> result - | None -> + | None -> lock syncRoot (fun () -> match result with | Some _ -> result | None -> - // Otherwise save the continuation and call it in RegisterResult + // Otherwise save the continuation and call it in RegisterResult savedConts <- (SuspendedAsync<_>(ctxt))::savedConts None ) @@ -823,15 +823,15 @@ namespace Microsoft.FSharp.Control r | None -> // OK, let's really wait for the Set signal. This may block. - let timeout = defaultArg timeout Threading.Timeout.Infinite + let timeout = defaultArg timeout Threading.Timeout.Infinite #if FX_NO_EXIT_CONTEXT_FLAGS #if FX_NO_WAITONE_MILLISECONDS - let ok = resHandle.WaitOne(TimeSpan(int64(timeout)*10000L)) + let ok = resHandle.WaitOne(TimeSpan(int64 timeout*10000L)) #else - let ok = resHandle.WaitOne(millisecondsTimeout= timeout) -#endif + let ok = resHandle.WaitOne(millisecondsTimeout= timeout) +#endif #else - let ok = resHandle.WaitOne(millisecondsTimeout= timeout,exitContext=true) + let ok = resHandle.WaitOne(millisecondsTimeout= timeout, exitContext=true) #endif if ok then // Now the result really must be available @@ -843,8 +843,8 @@ namespace Microsoft.FSharp.Control /// Create an instance of an arbitrary delegate type delegating to the given F# function type FuncDelegate<'T>(f) = - member __.Invoke(sender:obj, a:'T) : unit = ignore(sender); f(a) - static member Create<'Delegate when 'Delegate :> Delegate>(f) = + member __.Invoke(sender:obj, a:'T) : unit = ignore sender; f a + static member Create<'Delegate when 'Delegate :> Delegate>(f) = let obj = FuncDelegate<'T>(f) let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate @@ -852,38 +852,38 @@ namespace Microsoft.FSharp.Control [] let QueueAsync cancellationToken cont econt ccont computation = let trampolineHolder = new TrampolineHolder() - trampolineHolder.QueueWorkItemWithTrampoline (fun () -> + trampolineHolder.QueueWorkItemWithTrampoline (fun () -> let ctxt = AsyncActivation.Create cancellationToken trampolineHolder cont econt ccont computation.Invoke ctxt) /// Run the asynchronous workflow and wait for its result. [] - let RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = - let token,innerCTS = + let RunSynchronouslyInAnotherThread (token:CancellationToken, computation, timeout) = + let token, innerCTS = // If timeout is provided, we govern the async by our own CTS, to cancel // when execution times out. Otherwise, the user-supplied token governs the async. - match timeout with + match timeout with | None -> token, None | Some _ -> let subSource = new LinkedSubSource(token) subSource.Token, Some subSource - + use resultCell = new ResultCell>() - QueueAsync - token - (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) - (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) - (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) - computation + QueueAsync + token + (fun res -> resultCell.RegisterResult(AsyncResult.Ok res, reuseThread=true)) + (fun edi -> resultCell.RegisterResult(AsyncResult.Error edi, reuseThread=true)) + (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled exn, reuseThread=true)) + computation |> unfake let res = resultCell.TryWaitForResultSynchronously(?timeout = timeout) match res with | None -> // timed out // issue cancellation signal - if innerCTS.IsSome then innerCTS.Value.Cancel() + if innerCTS.IsSome then innerCTS.Value.Cancel() // wait for computation to quiesce; drop result on the floor - resultCell.TryWaitForResultSynchronously() |> ignore + resultCell.TryWaitForResultSynchronously() |> ignore // dispose the CancellationTokenSource if innerCTS.IsSome then innerCTS.Value.Dispose() raise (System.TimeoutException()) @@ -894,18 +894,18 @@ namespace Microsoft.FSharp.Control res.Commit() [] - let RunSynchronouslyInCurrentThread (cancellationToken:CancellationToken,computation) = + let RunSynchronouslyInCurrentThread (cancellationToken:CancellationToken, computation) = use resultCell = new ResultCell>() let trampolineHolder = new TrampolineHolder() trampolineHolder.ExecuteWithTrampoline (fun () -> - let ctxt = + let ctxt = AsyncActivation.Create cancellationToken trampolineHolder - (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) - (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) - (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) + (fun res -> resultCell.RegisterResult(AsyncResult.Ok res, reuseThread=true)) + (fun edi -> resultCell.RegisterResult(AsyncResult.Error edi, reuseThread=true)) + (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled exn, reuseThread=true)) computation.Invoke ctxt) |> unfake @@ -932,7 +932,7 @@ namespace Microsoft.FSharp.Control [] let Start cancellationToken (computation:Async) = - QueueAsync + QueueAsync cancellationToken (fun () -> fake()) // nothing to do on success (fun edi -> edi.ThrowAny()) // raise exception in child @@ -943,7 +943,7 @@ namespace Microsoft.FSharp.Control [] let StartWithContinuations cancellationToken (computation:Async<'T>) cont econt ccont = let trampolineHolder = new TrampolineHolder() - trampolineHolder.ExecuteWithTrampoline (fun () -> + trampolineHolder.ExecuteWithTrampoline (fun () -> let ctxt = AsyncActivation.Create cancellationToken trampolineHolder (cont >> fake) (econt >> fake) (ccont >> fake) computation.Invoke ctxt) |> unfake @@ -953,7 +953,7 @@ namespace Microsoft.FSharp.Control let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None let tcs = new TaskCompletionSource<_>(taskCreationOptions) - // The contract: + // The contract: // a) cancellation signal should always propagate to the computation // b) when the task IsCompleted -> nothing is running anymore let task = tcs.Task @@ -968,15 +968,15 @@ namespace Microsoft.FSharp.Control // Helper to attach continuation to the given task. [] - let taskContinueWith (task : Task<'T>) (ctxt: AsyncActivation<'T>) useCcontForTaskCancellation = + let taskContinueWith (task: Task<'T>) (ctxt: AsyncActivation<'T>) useCcontForTaskCancellation = let continuation (completedTask: Task<_>) : unit = ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () - else - let edi = ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask)) + else + let edi = ExceptionDispatchInfo.Capture(TaskCanceledException completedTask) ctxt.CallExceptionContinuation edi elif completedTask.IsFaulted then let edi = ExceptionDispatchInfo.RestoreOrCapture(completedTask.Exception) @@ -987,14 +987,14 @@ namespace Microsoft.FSharp.Control task.ContinueWith(Action>(continuation)) |> ignore |> fake [] - let taskContinueWithUnit (task: Task) (ctxt: AsyncActivation) useCcontForTaskCancellation = + let taskContinueWithUnit (task: Task) (ctxt: AsyncActivation) useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () - else + else let edi = ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask)) ctxt.CallExceptionContinuation edi elif completedTask.IsFaulted then @@ -1006,10 +1006,10 @@ namespace Microsoft.FSharp.Control task.ContinueWith(Action(continuation)) |> ignore |> fake [] - type AsyncIAsyncResult<'T>(callback: System.AsyncCallback,state:obj) = - // This gets set to false if the result is not available by the + type AsyncIAsyncResult<'T>(callback: System.AsyncCallback, state:obj) = + // This gets set to false if the result is not available by the // time the IAsyncResult is returned to the caller of Begin - let mutable completedSynchronously = true + let mutable completedSynchronously = true let mutable disposed = false @@ -1017,16 +1017,16 @@ namespace Microsoft.FSharp.Control let result = new ResultCell>() - member s.SetResult(v: AsyncResult<'T>) = - result.RegisterResult(v,reuseThread=true) |> unfake + member s.SetResult(v: AsyncResult<'T>) = + result.RegisterResult(v, reuseThread=true) |> unfake match callback with | null -> () - | d -> + | d -> // The IASyncResult becomes observable here d.Invoke (s :> System.IAsyncResult) - member s.GetResult() = - match result.TryWaitForResultSynchronously (-1) with + member s.GetResult() = + match result.TryWaitForResultSynchronously (-1) with | Some (AsyncResult.Ok v) -> v | Some (AsyncResult.Error edi) -> edi.ThrowAny() | Some (AsyncResult.Canceled err) -> raise err @@ -1034,18 +1034,18 @@ namespace Microsoft.FSharp.Control member x.IsClosed = disposed - member x.Close() = + member x.Close() = if not disposed then - disposed <- true + disposed <- true cts.Dispose() result.Close() - + member x.Token = cts.Token member x.CancelAsync() = cts.Cancel() - member x.CheckForNotSynchronous() = - if not result.ResultAvailable then + member x.CheckForNotSynchronous() = + if not result.ResultAvailable then completedSynchronously <- false interface System.IAsyncResult with @@ -1056,9 +1056,9 @@ namespace Microsoft.FSharp.Control interface System.IDisposable with member x.Dispose() = x.Close() - + module AsBeginEndHelpers = - let beginAction (computation, callback, state) = + let beginAction (computation, callback, state) = let aiar = new AsyncIAsyncResult<'T>(callback, state) let cont v = aiar.SetResult (AsyncResult.Ok v) let econt v = aiar.SetResult (AsyncResult.Error v) @@ -1066,28 +1066,28 @@ namespace Microsoft.FSharp.Control StartWithContinuations aiar.Token computation cont econt ccont aiar.CheckForNotSynchronous() (aiar :> IAsyncResult) - + let endAction<'T> (iar:IAsyncResult) = - match iar with + match iar with | :? AsyncIAsyncResult<'T> as aiar -> - if aiar.IsClosed then + if aiar.IsClosed then raise (System.ObjectDisposedException("AsyncResult")) else let res = aiar.GetResult() aiar.Close () res - | _ -> + | _ -> invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) let cancelAction<'T>(iar:IAsyncResult) = - match iar with + match iar with | :? AsyncIAsyncResult<'T> as aiar -> aiar.CancelAsync() - | _ -> + | _ -> invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) open AsyncPrimitives - + [] type AsyncBuilder() = member __.Zero () = unitAsync @@ -1115,17 +1115,17 @@ namespace Microsoft.FSharp.Control // member inline __.TryWithFilter (computation, catchHandler) = CreateTryWithFilterAsync catchHandler computation [] - module AsyncBuilderImpl = + module AsyncBuilderImpl = let async = AsyncBuilder() [] type Async = - + static member CancellationToken = cancellationTokenAsync static member CancelCheck () = unitAsync - static member FromContinuations (callback : ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> = + static member FromContinuations (callback: ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> = MakeAsync (fun ctxt -> if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -1134,20 +1134,20 @@ namespace Microsoft.FSharp.Control let mutable contToTailCall = None let thread = Thread.CurrentThread let latch = Latch() - let once cont x = + let once cont x = if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) - if Thread.CurrentThread.Equals(thread) && underCurrentThreadStack then + if Thread.CurrentThread.Equals thread && underCurrentThreadStack then contToTailCall <- Some(fun () -> cont x) else if Trampoline.ThisThreadHasTrampoline then let syncCtxt = SynchronizationContext.Current - ctxt.trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> cont x) |> unfake + ctxt.trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> cont x) |> unfake else ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake - try - callback (once ctxt.cont, (fun exn -> once ctxt.econt (ExceptionDispatchInfo.RestoreOrCapture(exn))), once ctxt.ccont) - with exn -> + try + callback (once ctxt.cont, (fun exn -> once ctxt.econt (ExceptionDispatchInfo.RestoreOrCapture exn)), once ctxt.ccont) + with exn -> if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) - let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) + let edi = ExceptionDispatchInfo.RestoreOrCapture exn ctxt.econt edi |> unfake underCurrentThreadStack <- false @@ -1155,7 +1155,7 @@ namespace Microsoft.FSharp.Control match contToTailCall with | Some k -> k() | _ -> fake()) - + static member DefaultCancellationToken = defaultCancellationTokenSource.Token static member CancelDefaultToken() = @@ -1168,18 +1168,18 @@ namespace Microsoft.FSharp.Control cts.Cancel() // we do not dispose the old default CTS - let GC collect it - + static member Catch (computation: Async<'T>) = MakeAsync (fun ctxt -> // Turn the success or exception into data - let newCtxt = ctxt.WithContinuations(cont = (fun res -> ctxt.cont (Choice1Of2 res)), + let newCtxt = ctxt.WithContinuations(cont = (fun res -> ctxt.cont (Choice1Of2 res)), econt = (fun edi -> ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())))) computation.Invoke newCtxt) - static member RunSynchronously (computation: Async<'T>,?timeout,?cancellationToken:CancellationToken) = + static member RunSynchronously (computation: Async<'T>, ?timeout, ?cancellationToken:CancellationToken) = let timeout, cancellationToken = match cancellationToken with - | None -> timeout,defaultCancellationTokenSource.Token + | None -> timeout, defaultCancellationTokenSource.Token | Some token when not token.CanBeCanceled -> timeout, token | Some token -> None, token AsyncPrimitives.RunSynchronously cancellationToken computation timeout @@ -1188,30 +1188,30 @@ namespace Microsoft.FSharp.Control let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token AsyncPrimitives.Start cancellationToken computation - static member StartAsTask (computation,?taskCreationOptions,?cancellationToken)= - let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + static member StartAsTask (computation, ?taskCreationOptions, ?cancellationToken)= + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions - - static member StartChildAsTask (computation,?taskCreationOptions) = - async { let! cancellationToken = cancellationTokenAsync + + static member StartChildAsTask (computation, ?taskCreationOptions) = + async { let! cancellationToken = cancellationTokenAsync return AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions } static member Parallel (computations: seq>) = MakeAsync (fun ctxt -> - let tasks, result = - try + let tasks, result = + try Seq.toArray computations, None // manually protect eval of seq - with exn -> - let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) + with exn -> + let edi = ExceptionDispatchInfo.RestoreOrCapture exn null, Some (ctxt.CallExceptionContinuation edi) match result with | Some r -> r | None -> - if tasks.Length = 0 then + if tasks.Length = 0 then // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior - ctxt.cont [| |] - else + ctxt.cont [| |] + else ProtectedCode ctxt (fun ctxt -> let ctxtWithSync = DelimitSyncContext ctxt // manually resync let mutable count = tasks.Length @@ -1219,38 +1219,38 @@ namespace Microsoft.FSharp.Control let results = Array.zeroCreate tasks.Length // Attempt to cancel the individual operations if an exception happens on any of the other threads let innerCTS = new LinkedSubSource(ctxtWithSync.token) - - let finishTask(remaining) = - if (remaining = 0) then + + let finishTask remaining = + if (remaining = 0) then innerCTS.Dispose() - match firstExn with + match firstExn with | None -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) | Some (Choice1Of2 exn) -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.econt exn) | Some (Choice2Of2 cexn) -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.ccont cexn) else fake() - // recordSuccess and recordFailure between them decrement count to 0 and + // recordSuccess and recordFailure between them decrement count to 0 and // as soon as 0 is reached dispose innerCancellationSource - - let recordSuccess i res = + + let recordSuccess i res = results.[i] <- res - finishTask(Interlocked.Decrement &count) + finishTask(Interlocked.Decrement &count) - let recordFailure exn = + let recordFailure exn = // capture first exception and then decrement the counter to avoid race when // - thread 1 decremented counter and preempted by the scheduler // - thread 2 decremented counter and called finishTask // since exception is not yet captured - finishtask will fall into success branch match Interlocked.CompareExchange(&firstExn, Some exn, None) with - | None -> + | None -> // signal cancellation before decrementing the counter - this guarantees that no other thread can sneak to finishTask and dispose innerCTS // NOTE: Cancel may introduce reentrancy - i.e. when handler registered for the cancellation token invokes cancel continuation that will call 'recordFailure' // to correctly handle this we need to return decremented value, not the current value of 'count' otherwise we may invoke finishTask with value '0' several times innerCTS.Cancel() | _ -> () finishTask(Interlocked.Decrement &count) - + tasks |> Array.iteri (fun i p -> QueueAsync innerCTS.Token @@ -1264,7 +1264,7 @@ namespace Microsoft.FSharp.Control |> unfake) fake())) - static member Choice(computations : Async<'T option> seq) : Async<'T option> = + static member Choice(computations: Async<'T option> seq) : Async<'T option> = MakeAsync (fun ctxt -> let result = try Seq.toArray computations |> Choice1Of2 @@ -1280,9 +1280,9 @@ namespace Microsoft.FSharp.Control let exnCount = ref 0 let innerCts = new LinkedSubSource(ctxtWithSync.token) - let scont (result : 'T option) = + let scont (result: 'T option) = match result with - | Some _ -> + | Some _ -> if Interlocked.Increment exnCount = 1 then innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) else @@ -1293,14 +1293,14 @@ namespace Microsoft.FSharp.Control innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) else fake() - - let econt (exn : ExceptionDispatchInfo) = - if Interlocked.Increment exnCount = 1 then + + let econt (exn: ExceptionDispatchInfo) = + if Interlocked.Increment exnCount = 1 then innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.econt exn) else fake() - - let ccont (exn : OperationCanceledException) = + + let ccont (exn: OperationCanceledException) = if Interlocked.Increment exnCount = 1 then innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.ccont exn) else @@ -1319,15 +1319,15 @@ namespace Microsoft.FSharp.Control static member StartWithContinuations(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = Async.StartWithContinuationsUsingDispatchInfo(computation, continuation, (fun edi -> exceptionContinuation (edi.GetAssociatedSourceException())), cancellationContinuation, ?cancellationToken=cancellationToken) - static member StartImmediateAsTask (computation : Async<'T>, ?cancellationToken ) : Task<'T>= + static member StartImmediateAsTask (computation: Async<'T>, ?cancellationToken ) : Task<'T>= let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token let ts = new TaskCompletionSource<'T>() let task = ts.Task Async.StartWithContinuations( - computation, - (fun k -> ts.SetResult k), - (fun exn -> ts.SetException exn), - (fun _ -> ts.SetCanceled()), + computation, + (fun k -> ts.SetResult k), + (fun exn -> ts.SetException exn), + (fun _ -> ts.SetCanceled()), cancellationToken) task @@ -1335,15 +1335,15 @@ namespace Microsoft.FSharp.Control let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token AsyncPrimitives.StartWithContinuations cancellationToken computation id (fun edi -> edi.ThrowAny()) ignore - static member Sleep(millisecondsDueTime) : Async = + static member Sleep millisecondsDueTime : Async = CreateDelimitedUserCodeAsync (fun ctxt -> - let mutable timer = None : Timer option + let mutable timer = None: Timer option let cont = ctxt.cont let ccont = ctxt.ccont let latch = new Latch() let registration = ctxt.token.Register( - (fun _ -> + (fun _ -> if latch.Enter() then match timer with | None -> () @@ -1355,7 +1355,7 @@ namespace Microsoft.FSharp.Control timer <- new Timer((fun _ -> if latch.Enter() then // NOTE: If the CTS for the token would have been disposed, disposal of the registration would throw - // However, our contract is that until async computation ceases execution (and invokes ccont) + // However, our contract is that until async computation ceases execution (and invokes ccont) // the CTS will not be disposed. Execution of savedCCont is guarded by latch, so we are safe unless // user violates the contract. registration.Dispose() @@ -1369,36 +1369,36 @@ namespace Microsoft.FSharp.Control // Now we're done, so call the continuation ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> cont()) |> unfake), null, dueTime=millisecondsDueTime, period = -1) |> Some - with exn -> - if latch.Enter() then + with exn -> + if latch.Enter() then // post exception to econt only if we successfully enter the latch (no other continuations were called) - edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) + edi <- ExceptionDispatchInfo.RestoreOrCapture exn - match edi with - | null -> + match edi with + | null -> fake() - | _ -> + | _ -> ctxt.econt edi) - + /// Wait for a wait handle. Both timeout and cancellation are supported static member AwaitWaitHandle(waitHandle: WaitHandle, ?millisecondsTimeout:int) = let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite - if millisecondsTimeout = 0 then + if millisecondsTimeout = 0 then async.Delay(fun () -> #if FX_NO_EXIT_CONTEXT_FLAGS #if FX_NO_WAITONE_MILLISECONDS - let ok = waitHandle.WaitOne(TimeSpan(0L)) + let ok = waitHandle.WaitOne(TimeSpan 0L) #else - let ok = waitHandle.WaitOne(0) -#endif + let ok = waitHandle.WaitOne 0 +#endif #else - let ok = waitHandle.WaitOne(0,exitContext=false) + let ok = waitHandle.WaitOne(0, exitContext=false) #endif async.Return ok) else CreateDelimitedUserCodeAsync(fun ctxt -> let aux = ctxt.aux - let rwh = ref (None : RegisteredWaitHandle option) + let rwh = ref (None: RegisteredWaitHandle option) let latch = Latch() let rec cancelHandler = Action(fun _ -> @@ -1408,11 +1408,11 @@ namespace Microsoft.FSharp.Control lock rwh (fun () -> match !rwh with | None -> () - | Some rwh -> rwh.Unregister(null) |> ignore) + | Some rwh -> rwh.Unregister null |> ignore) Async.Start (async { do (ctxt.ccont (OperationCanceledException(aux.token)) |> unfake) })) - and registration : CancellationTokenRegistration = aux.token.Register(cancelHandler, null) - + and registration: CancellationTokenRegistration = aux.token.Register(cancelHandler, null) + let savedCont = ctxt.cont try lock rwh (fun () -> @@ -1420,7 +1420,7 @@ namespace Microsoft.FSharp.Control (waitObject=waitHandle, callBack=WaitOrTimerCallback(fun _ timeOut -> if latch.Enter() then - lock rwh (fun () -> rwh.Value.Value.Unregister(null) |> ignore) + lock rwh (fun () -> rwh.Value.Value.Unregister null |> ignore) rwh := None registration.Dispose() ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), @@ -1428,16 +1428,16 @@ namespace Microsoft.FSharp.Control millisecondsTimeOutInterval=millisecondsTimeout, executeOnlyOnce=true)) fake()) - with _ -> + with _ -> if latch.Enter() then registration.Dispose() reraise() // reraise exception only if we successfully enter the latch (no other continuations were called) - else + else fake() ) static member AwaitIAsyncResult(iar: IAsyncResult, ?millisecondsTimeout): Async = - async { if iar.CompletedSynchronously then + async { if iar.CompletedSynchronously then return true else return! Async.AwaitWaitHandle(iar.AsyncWaitHandle, ?millisecondsTimeout=millisecondsTimeout) } @@ -1445,10 +1445,10 @@ namespace Microsoft.FSharp.Control /// Bind the result of a result cell, calling the appropriate continuation. static member BindResult (result: AsyncResult<'T>) : Async<'T> = - MakeAsync (fun ctxt -> - (match result with - | Ok v -> ctxt.cont v - | Error exn -> ctxt.CallExceptionContinuation exn + MakeAsync (fun ctxt -> + (match result with + | Ok v -> ctxt.cont v + | Error exn -> ctxt.CallExceptionContinuation exn | Canceled exn -> ctxt.ccont exn) ) /// Await and use the result of a result cell. The resulting async doesn't support cancellation @@ -1465,22 +1465,22 @@ namespace Microsoft.FSharp.Control /// directly, rather the underlying computation must fill the result if cancellation occurs. static member AwaitAndBindChildResult(innerCTS: CancellationTokenSource, resultCell: ResultCell>, millisecondsTimeout) : Async<'T> = match millisecondsTimeout with - | None | Some -1 -> + | None | Some -1 -> resultCell |> Async.AwaitAndBindResult_NoDirectCancelOrTimeout - | Some 0 -> - async { if resultCell.ResultAvailable then + | Some 0 -> + async { if resultCell.ResultAvailable then let res = resultCell.GrabResult() return res.Commit() else return raise (System.TimeoutException()) } | _ -> - async { try - if resultCell.ResultAvailable then + async { try + if resultCell.ResultAvailable then let res = resultCell.GrabResult() return res.Commit() else - let! ok = Async.AwaitWaitHandle (resultCell.GetWaitHandle(), ?millisecondsTimeout=millisecondsTimeout) + let! ok = Async.AwaitWaitHandle (resultCell.GetWaitHandle(), ?millisecondsTimeout=millisecondsTimeout) if ok then let res = resultCell.GrabResult() return res.Commit() @@ -1488,10 +1488,10 @@ namespace Microsoft.FSharp.Control // issue cancellation signal innerCTS.Cancel() // wait for computation to quiesce - let! _ = Async.AwaitWaitHandle (resultCell.GetWaitHandle()) + let! _ = Async.AwaitWaitHandle (resultCell.GetWaitHandle()) return raise (System.TimeoutException()) - finally - resultCell.Close() } + finally + resultCell.Close() } static member FromBeginEnd(beginAction, endAction, ?cancelAction): Async<'T> = @@ -1500,116 +1500,116 @@ namespace Microsoft.FSharp.Control let once = Once() - let registration : CancellationTokenRegistration = + let registration: CancellationTokenRegistration = - let onCancel (_:obj) = + let onCancel (_:obj) = // Call the cancellation routine - match cancelAction with - | None -> + match cancelAction with + | None -> // Register the result. This may race with a successful result, but // ResultCell allows a race and throws away whichever comes last. once.Do(fun () -> - let canceledResult = Canceled (OperationCanceledException(cancellationToken)) - resultCell.RegisterResult(canceledResult,reuseThread=true) |> unfake + let canceledResult = Canceled (OperationCanceledException cancellationToken) + resultCell.RegisterResult(canceledResult, reuseThread=true) |> unfake ) - | Some cancel -> + | Some cancel -> // If we get an exception from a cooperative cancellation function // we assume the operation has already completed. try cancel() with _ -> () cancellationToken.Register(Action(onCancel), null) - - let callback = - new System.AsyncCallback(fun iar -> - if not iar.CompletedSynchronously then + + let callback = + new System.AsyncCallback(fun iar -> + if not iar.CompletedSynchronously then // The callback has been activated, so ensure cancellation is not possible - // beyond this point. + // beyond this point. match cancelAction with - | Some _ -> + | Some _ -> registration.Dispose() - | None -> + | None -> once.Do(fun () -> registration.Dispose()) // Run the endAction and collect its result. - let res = - try - Ok(endAction iar) - with exn -> - let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) + let res = + try + Ok(endAction iar) + with exn -> + let edi = ExceptionDispatchInfo.RestoreOrCapture exn Error edi // Register the result. This may race with a cancellation result, but // ResultCell allows a race and throws away whichever comes last. - resultCell.RegisterResult(res,reuseThread=true) |> unfake) - - let (iar:IAsyncResult) = beginAction (callback,(null:obj)) - if iar.CompletedSynchronously then + resultCell.RegisterResult(res, reuseThread=true) |> unfake) + + let (iar:IAsyncResult) = beginAction (callback, (null:obj)) + if iar.CompletedSynchronously then registration.Dispose() - return endAction iar - else + return endAction iar + else // Note: ok to use "NoDirectCancel" here because cancellation has been registered above // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method - return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell) } + return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout resultCell } - static member FromBeginEnd(arg,beginAction,endAction,?cancelAction): Async<'T> = - Async.FromBeginEnd((fun (iar,state) -> beginAction(arg,iar,state)), endAction, ?cancelAction=cancelAction) + static member FromBeginEnd(arg, beginAction, endAction, ?cancelAction): Async<'T> = + Async.FromBeginEnd((fun (iar, state) -> beginAction(arg, iar, state)), endAction, ?cancelAction=cancelAction) - static member FromBeginEnd(arg1,arg2,beginAction,endAction,?cancelAction): Async<'T> = - Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,arg2,iar,state)), endAction, ?cancelAction=cancelAction) + static member FromBeginEnd(arg1, arg2, beginAction, endAction, ?cancelAction): Async<'T> = + Async.FromBeginEnd((fun (iar, state) -> beginAction(arg1, arg2, iar, state)), endAction, ?cancelAction=cancelAction) - static member FromBeginEnd(arg1,arg2,arg3,beginAction,endAction,?cancelAction): Async<'T> = - Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,arg2,arg3,iar,state)), endAction, ?cancelAction=cancelAction) + static member FromBeginEnd(arg1, arg2, arg3, beginAction, endAction, ?cancelAction): Async<'T> = + Async.FromBeginEnd((fun (iar, state) -> beginAction(arg1, arg2, arg3, iar, state)), endAction, ?cancelAction=cancelAction) - static member AsBeginEnd<'Arg,'T> (computation:('Arg -> Async<'T>)) : + static member AsBeginEnd<'Arg, 'T> (computation:('Arg -> Async<'T>)) : // The 'Begin' member - ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) * + ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) * // The 'End' member - (System.IAsyncResult -> 'T) * + (System.IAsyncResult -> 'T) * // The 'Cancel' member (System.IAsyncResult -> unit) = - let beginAction = fun (a1,callback,state) -> AsBeginEndHelpers.beginAction ((computation a1), callback, state) + let beginAction = fun (a1, callback, state) -> AsBeginEndHelpers.beginAction ((computation a1), callback, state) beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> - static member AwaitEvent(event:IEvent<'Delegate,'T>, ?cancelAction) : Async<'T> = + static member AwaitEvent(event:IEvent<'Delegate, 'T>, ?cancelAction) : Async<'T> = async { let! cancellationToken = cancellationTokenAsync let resultCell = new ResultCell<_>() // Set up the handlers to listen to events and cancellation let once = new Once() - let rec registration : CancellationTokenRegistration= + let rec registration: CancellationTokenRegistration= let onCancel _ = // We've been cancelled. Call the given cancellation routine - match cancelAction with - | None -> + match cancelAction with + | None -> // We've been cancelled without a cancel action. Stop listening to events - event.RemoveHandler(del) + event.RemoveHandler del // Register the result. This may race with a successful result, but // ResultCell allows a race and throws away whichever comes last. - once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException(cancellationToken)),reuseThread=true) |> unfake) - | Some cancel -> + once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException cancellationToken), reuseThread=true) |> unfake) + | Some cancel -> // If we get an exception from a cooperative cancellation function // we assume the operation has already completed. try cancel() with _ -> () cancellationToken.Register(Action(onCancel), null) - - and del = + + and del = FuncDelegate<'T>.Create<'Delegate>(fun eventArgs -> // Stop listening to events - event.RemoveHandler(del) + event.RemoveHandler del // The callback has been activated, so ensure cancellation is not possible beyond this point once.Do(fun () -> registration.Dispose()) - let res = Ok(eventArgs) + let res = Ok eventArgs // Register the result. This may race with a cancellation result, but // ResultCell allows a race and throws away whichever comes last. - resultCell.RegisterResult(res,reuseThread=true) |> unfake) + resultCell.RegisterResult(res, reuseThread=true) |> unfake) // Start listening to events - event.AddHandler(del) + event.AddHandler del // Return the async computation that allows us to await the result // Note: ok to use "NoDirectCancel" here because cancellation has been registered above // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method - return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell) } + return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout resultCell } static member Ignore (computation: Async<'T>) = CreateIgnoreAsync computation @@ -1617,35 +1617,35 @@ namespace Microsoft.FSharp.Control static member SwitchToThreadPool() = CreateSwitchToThreadPoolAsync() - static member StartChild (computation:Async<'T>,?millisecondsTimeout) = - async { + static member StartChild (computation:Async<'T>, ?millisecondsTimeout) = + async { let resultCell = new ResultCell<_>() let! cancellationToken = cancellationTokenAsync let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal let ctsRef = ref innerCTS let reg = cancellationToken.Register( - (fun _ -> + (fun _ -> match !ctsRef with | null -> () - | otherwise -> otherwise.Cancel()), + | otherwise -> otherwise.Cancel()), null) - do QueueAsync + do QueueAsync innerCTS.Token // since innerCTS is not ever Disposed, can call reg.Dispose() without a safety Latch - (fun res -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) - (fun edi -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Error edi,reuseThread=true)) - (fun err -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Canceled err,reuseThread=true)) + (fun res -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) + (fun edi -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Error edi, reuseThread=true)) + (fun err -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Canceled err, reuseThread=true)) computation |> unfake - + return Async.AwaitAndBindChildResult(innerCTS, resultCell, millisecondsTimeout) } static member SwitchToContext syncContext = - async { match syncContext with - | null -> + async { match syncContext with + | null -> // no synchronization context, just switch to the thread pool do! Async.SwitchToThreadPool() - | syncCtxt -> + | syncCtxt -> // post the continuation to the synchronization context return! CreateSwitchToAsync syncCtxt } @@ -1653,26 +1653,26 @@ namespace Microsoft.FSharp.Control async { let! cancellationToken = cancellationTokenAsync // latch protects CancellationTokenRegistration.Dispose from being called twice let latch = Latch() - let rec handler (_ : obj) = - try + let rec handler (_ : obj) = + try if latch.Enter() then registration.Dispose() - interruption () - with _ -> () - and registration : CancellationTokenRegistration = cancellationToken.Register(Action(handler), null) + interruption () + with _ -> () + and registration: CancellationTokenRegistration = cancellationToken.Register(Action(handler), null) return { new System.IDisposable with - member this.Dispose() = + member this.Dispose() = // dispose CancellationTokenRegistration only if cancellation was not requested. // otherwise - do nothing, disposal will be performed by the handler itself if not cancellationToken.IsCancellationRequested then if latch.Enter() then registration.Dispose() } } - static member TryCancelled (computation: Async<'T>,compensation) = + static member TryCancelled (computation: Async<'T>, compensation) = CreateWhenCancelledAsync compensation computation - static member AwaitTask (task:Task<'T>) : Async<'T> = + static member AwaitTask (task:Task<'T>) : Async<'T> = CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith task ctxt false) - static member AwaitTask (task:Task) : Async = + static member AwaitTask (task:Task) : Async = CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit task ctxt false) module CommonExtensions = @@ -1680,27 +1680,27 @@ namespace Microsoft.FSharp.Control type System.IO.Stream with [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member stream.AsyncRead(buffer: byte[],?offset,?count) = + member stream.AsyncRead(buffer: byte[], ?offset, ?count) = let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE // use combo CreateDelimitedUserCodeAsync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith (stream.ReadAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else - Async.FromBeginEnd (buffer,offset,count,stream.BeginRead,stream.EndRead) + Async.FromBeginEnd (buffer, offset, count, stream.BeginRead, stream.EndRead) #endif [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member stream.AsyncRead(count) = + member stream.AsyncRead count = async { let buffer = Array.zeroCreate count let i = ref 0 while !i < count do - let! n = stream.AsyncRead(buffer,!i,count - !i) + let! n = stream.AsyncRead(buffer, !i, count - !i) i := !i + n - if n = 0 then + if n = 0 then raise(System.IO.EndOfStreamException(SR.GetString(SR.failedReadEnoughBytes))) return buffer } - + [] // give the extension member a 'nice', unmangled compiled name, unique within this module member stream.AsyncWrite(buffer:byte[], ?offset:int, ?count:int) = let offset = defaultArg offset 0 @@ -1709,51 +1709,51 @@ namespace Microsoft.FSharp.Control // use combo CreateDelimitedUserCodeAsync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else - Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite) + Async.FromBeginEnd (buffer, offset, count, stream.BeginWrite, stream.EndWrite) #endif - - type IObservable<'Args> with + + type IObservable<'Args> with [] // give the extension member a 'nice', unmangled compiled name, unique within this module member x.Add(callback: 'Args -> unit) = x.Subscribe callback |> ignore [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member x.Subscribe(callback) = - x.Subscribe { new IObserver<'Args> with - member x.OnNext(args) = callback args - member x.OnError(e) = () - member x.OnCompleted() = () } + member x.Subscribe callback = + x.Subscribe { new IObserver<'Args> with + member x.OnNext args = callback args + member x.OnError e = () + member x.OnCompleted() = () } module WebExtensions = open AsyncPrimitives type System.Net.WebRequest with [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member req.AsyncGetResponse() : Async= - + member req.AsyncGetResponse() : Async= + let canceled = ref false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives // Use CreateTryWithFilterAsync to allow propagation of exception without losing stack - Async.FromBeginEnd(beginAction=req.BeginGetResponse, - endAction = req.EndGetResponse, + Async.FromBeginEnd(beginAction=req.BeginGetResponse, + endAction = req.EndGetResponse, cancelAction = fun() -> canceled := true; req.Abort()) |> CreateTryWithFilterAsync (fun exn -> - match exn with - | :? System.Net.WebException as webExn - when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> + match exn with + | :? System.Net.WebException as webExn + when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> Some (Async.BindResult(AsyncResult.Canceled (OperationCanceledException webExn.Message))) - | _ -> + | _ -> None) #if !FX_NO_WEB_CLIENT - + type System.Net.WebClient with member inline private this.Download(event: IEvent<'T, _>, handler: _ -> 'T, start, result) = let downloadAsync = Async.FromContinuations (fun (cont, econt, ccont) -> let userToken = new obj() - let rec delegate' (_: obj) (args : #ComponentModel.AsyncCompletedEventArgs) = + let rec delegate' (_: obj) (args: #ComponentModel.AsyncCompletedEventArgs) = // ensure we handle the completed event from correct download call if userToken = args.UserState then event.RemoveHandler handle @@ -1777,7 +1777,7 @@ namespace Microsoft.FSharp.Control member this.AsyncDownloadString (address:Uri) : Async = this.Download( event = this.DownloadStringCompleted, - handler = (fun action -> Net.DownloadStringCompletedEventHandler(action)), + handler = (fun action -> Net.DownloadStringCompletedEventHandler action), start = (fun userToken -> this.DownloadStringAsync(address, userToken)), result = (fun args -> args.Result) ) @@ -1786,7 +1786,7 @@ namespace Microsoft.FSharp.Control member this.AsyncDownloadData (address:Uri) : Async = this.Download( event = this.DownloadDataCompleted, - handler = (fun action -> Net.DownloadDataCompletedEventHandler(action)), + handler = (fun action -> Net.DownloadDataCompletedEventHandler action), start = (fun userToken -> this.DownloadDataAsync(address, userToken)), result = (fun args -> args.Result) ) @@ -1795,7 +1795,7 @@ namespace Microsoft.FSharp.Control member this.AsyncDownloadFile (address:Uri, fileName:string) : Async = this.Download( event = this.DownloadFileCompleted, - handler = (fun action -> ComponentModel.AsyncCompletedEventHandler(action)), + handler = (fun action -> ComponentModel.AsyncCompletedEventHandler action), start = (fun userToken -> this.DownloadFileAsync(address, fileName, userToken)), result = (fun _ -> ()) ) diff --git a/src/fsharp/FSharp.Core/mailbox.fs b/src/fsharp/FSharp.Core/mailbox.fs index f58a94b6f..453fcdd8f 100644 --- a/src/fsharp/FSharp.Core/mailbox.fs +++ b/src/fsharp/FSharp.Core/mailbox.fs @@ -13,18 +13,18 @@ namespace Microsoft.FSharp.Control /// We use our own internal implementation of queues to avoid a dependency on System.dll type Queue<'T>() = - + let mutable array = [| |] let mutable head = 0 let mutable size = 0 let mutable tail = 0 - let SetCapacity(capacity) = + let SetCapacity capacity = let destinationArray = Array.zeroCreate capacity - if (size > 0) then - if (head < tail) then + if (size > 0) then + if (head < tail) then Array.Copy(array, head, destinationArray, 0, size) - + else Array.Copy(array, head, destinationArray, 0, array.Length - head) Array.Copy(array, 0, destinationArray, array.Length - head, tail) @@ -41,11 +41,11 @@ namespace Microsoft.FSharp.Control size <- size - 1 local - member this.Enqueue(item) = - if (size = array.Length) then + member this.Enqueue item = + if (size = array.Length) then let capacity = int ((int64 array.Length * 200L) / 100L) let capacity = max capacity (array.Length + 4) - SetCapacity(capacity) + SetCapacity capacity array.[tail] <- item tail <- (tail + 1) % array.Length size <- size + 1 @@ -60,7 +60,7 @@ namespace Microsoft.FSharp.Control let resultCell = new ResultCell<_>() let! cancellationToken = Async.CancellationToken let start a f = - Async.StartWithContinuationsUsingDispatchInfo(a, + Async.StartWithContinuationsUsingDispatchInfo(a, (fun res -> resultCell.RegisterResult(f res |> AsyncResult.Ok, reuseThread=false) |> ignore), (fun edi -> resultCell.RegisterResult(edi |> AsyncResult.Error, reuseThread=false) |> ignore), (fun oce -> resultCell.RegisterResult(oce |> AsyncResult.Canceled, reuseThread=false) |> ignore), @@ -79,10 +79,10 @@ namespace Microsoft.FSharp.Control assert (msec >= 0) let resultCell = new ResultCell<_>() Async.StartWithContinuations( - computation=Async.Sleep(msec), + computation=Async.Sleep msec, continuation=(fun () -> resultCell.RegisterResult((), reuseThread = false) |> ignore), - exceptionContinuation=ignore, - cancellationContinuation=ignore, + exceptionContinuation=ignore, + cancellationContinuation=ignore, cancellationToken = cancellationToken) // Note: It is ok to use "NoDirectCancel" here because the started computations use the same // cancellation token and will register a cancelled result if cancellation occurs. @@ -90,14 +90,14 @@ namespace Microsoft.FSharp.Control resultCell.AwaitResult_NoDirectCancelOrTimeout [] - [] - type Mailbox<'Msg>(cancellationSupported: bool) = - let mutable inboxStore = null + [] + type Mailbox<'Msg>(cancellationSupported: bool) = + let mutable inboxStore = null let mutable arrivals = new Queue<'Msg>() let syncRoot = arrivals - // Control elements indicating the state of the reader. When the reader is "blocked" at an - // asynchronous receive, either + // Control elements indicating the state of the reader. When the reader is "blocked" at an + // asynchronous receive, either // -- "cont" is non-null and the reader is "activated" by re-scheduling cont in the thread pool; or // -- "pulse" is non-null and the reader is "activated" by setting this event let mutable savedCont : (bool -> AsyncReturn) option = None @@ -106,69 +106,69 @@ namespace Microsoft.FSharp.Control let mutable pulse : AutoResetEvent = null // Make sure that the "pulse" value is created - let ensurePulse() = - match pulse with - | null -> - pulse <- new AutoResetEvent(false); - | _ -> + let ensurePulse() = + match pulse with + | null -> + pulse <- new AutoResetEvent(false) + | _ -> () pulse - - let waitOneNoTimeoutOrCancellation = - MakeAsync (fun ctxt -> - match savedCont with - | None -> - let descheduled = + + let waitOneNoTimeoutOrCancellation = + MakeAsync (fun ctxt -> + match savedCont with + | None -> + let descheduled = // An arrival may have happened while we're preparing to deschedule - lock syncRoot (fun () -> - if arrivals.Count = 0 then + lock syncRoot (fun () -> + if arrivals.Count = 0 then // OK, no arrival so deschedule - savedCont <- Some(fun res -> ctxt.QueueContinuationWithTrampoline(res)) + savedCont <- Some(fun res -> ctxt.QueueContinuationWithTrampoline res) true else false) - if descheduled then + if descheduled then Unchecked.defaultof<_> - else + else // If we didn't deschedule then run the continuation immediately ctxt.CallContinuation true - | Some _ -> + | Some _ -> failwith "multiple waiting reader continuations for mailbox") - let waitOneWithCancellation timeout = + let waitOneWithCancellation timeout = Async.AwaitWaitHandle(ensurePulse(), millisecondsTimeout=timeout) - let waitOne timeout = - if timeout < 0 && not cancellationSupported then + let waitOne timeout = + if timeout < 0 && not cancellationSupported then waitOneNoTimeoutOrCancellation - else - waitOneWithCancellation(timeout) + else + waitOneWithCancellation timeout - member __.inbox = - match inboxStore with + member __.inbox = + match inboxStore with | null -> inboxStore <- new System.Collections.Generic.List<'Msg>(1) - | _ -> () + | _ -> () inboxStore - member x.CurrentQueueLength = + member x.CurrentQueueLength = lock syncRoot (fun () -> x.inbox.Count + arrivals.Count) - member x.ScanArrivalsUnsafe(f) = - if arrivals.Count = 0 then + member x.ScanArrivalsUnsafe f = + if arrivals.Count = 0 then None - else + else let msg = arrivals.Dequeue() match f msg with - | None -> - x.inbox.Add(msg) - x.ScanArrivalsUnsafe(f) + | None -> + x.inbox.Add msg + x.ScanArrivalsUnsafe f | res -> res // Lock the arrivals queue while we scan that - member x.ScanArrivals(f) = - lock syncRoot (fun () -> x.ScanArrivalsUnsafe(f)) + member x.ScanArrivals f = + lock syncRoot (fun () -> x.ScanArrivalsUnsafe f) - member x.ScanInbox(f,n) = + member x.ScanInbox(f, n) = match inboxStore with | null -> None | inbox -> @@ -177,178 +177,178 @@ namespace Microsoft.FSharp.Control else let msg = inbox.[n] match f msg with - | None -> x.ScanInbox (f,n+1) - | res -> inbox.RemoveAt(n); res + | None -> x.ScanInbox (f, n+1) + | res -> inbox.RemoveAt n; res member x.ReceiveFromArrivalsUnsafe() = - if arrivals.Count = 0 then + if arrivals.Count = 0 then None - else + else Some(arrivals.Dequeue()) - member x.ReceiveFromArrivals() = + member x.ReceiveFromArrivals() = lock syncRoot (fun () -> x.ReceiveFromArrivalsUnsafe()) member x.ReceiveFromInbox() = match inboxStore with | null -> None | inbox -> - if inbox.Count = 0 then + if inbox.Count = 0 then None else let x = inbox.[0] - inbox.RemoveAt(0) - Some(x) + inbox.RemoveAt 0 + Some x - member x.Post(msg) = + member x.Post msg = lock syncRoot (fun () -> // Add the message to the arrivals queue - arrivals.Enqueue(msg) + arrivals.Enqueue msg // Cooperatively unblock any waiting reader. If there is no waiting // reader we just leave the message in the incoming queue match savedCont with - | None -> - match pulse with - | null -> + | None -> + match pulse with + | null -> () // no one waiting, leaving the message in the queue is sufficient - | ev -> + | ev -> // someone is waiting on the wait handle ev.Set() |> ignore - | Some action -> + | Some action -> savedCont <- None action true |> ignore) member x.TryScan ((f: 'Msg -> (Async<'T>) option), timeout) : Async<'T option> = let rec scan timeoutAsync (timeoutCts:CancellationTokenSource) = - async { - match x.ScanArrivals(f) with - | None -> + async { + match x.ScanArrivals f with + | None -> // Deschedule and wait for a message. When it comes, rescan the arrivals let! ok = AsyncHelpers.awaitEither waitOneNoTimeoutOrCancellation timeoutAsync match ok with - | Choice1Of2 true -> + | Choice1Of2 true -> return! scan timeoutAsync timeoutCts | Choice1Of2 false -> return failwith "should not happen - waitOneNoTimeoutOrCancellation always returns true" | Choice2Of2 () -> - lock syncRoot (fun () -> + lock syncRoot (fun () -> // Cancel the outstanding wait for messages installed by waitOneWithCancellation // // HERE BE DRAGONS. This is bestowed on us because we only support // a single mailbox reader at any one time. // If awaitEither returned control because timeoutAsync has terminated, waitOneNoTimeoutOrCancellation - // might still be in-flight. In practical terms, it means that the push-to-async-result-cell + // might still be in-flight. In practical terms, it means that the push-to-async-result-cell // continuation that awaitEither registered on it is still pending, i.e. it is still in savedCont. // That continuation is a no-op now, but it is still a registered reader for arriving messages. // Therefore we just abandon it - a brutal way of canceling. // This ugly non-compositionality is only needed because we only support a single mailbox reader - // (i.e. the user is not allowed to run several Receive/TryReceive/Scan/TryScan in parallel) - otherwise + // (i.e. the user is not allowed to run several Receive/TryReceive/Scan/TryScan in parallel) - otherwise // we would just have an extra no-op reader in the queue. savedCont <- None) return None - | Some resP -> + | Some resP -> timeoutCts.Cancel() // cancel the timeout watcher let! res = resP return Some res } let rec scanNoTimeout () = - async { - match x.ScanArrivals(f) with - | None -> + async { + match x.ScanArrivals f with + | None -> let! ok = waitOne(Timeout.Infinite) if ok then return! scanNoTimeout() else return (failwith "Timed out with infinite timeout??") - | Some resP -> + | Some resP -> let! res = resP return Some res } // Look in the inbox first - async { - match x.ScanInbox(f,0) with - | None when timeout < 0 -> + async { + match x.ScanInbox(f, 0) with + | None when timeout < 0 -> return! scanNoTimeout() - | None -> + | None -> let! cancellationToken = Async.CancellationToken let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, CancellationToken.None) let timeoutAsync = AsyncHelpers.timeout timeout timeoutCts.Token return! scan timeoutAsync timeoutCts - | Some resP -> + | Some resP -> let! res = resP return Some res } member x.Scan((f: 'Msg -> (Async<'T>) option), timeout) = - async { - let! resOpt = x.TryScan(f,timeout) + async { + let! resOpt = x.TryScan(f, timeout) match resOpt with | None -> return raise(TimeoutException(SR.GetString(SR.mailboxScanTimedOut))) - | Some res -> return res + | Some res -> return res } - member x.TryReceive(timeout) = + member x.TryReceive timeout = let rec processFirstArrival() = - async { + async { match x.ReceiveFromArrivals() with - | None -> - // Make sure the pulse is created if it is going to be needed. - // If it isn't, then create it, and go back to the start to + | None -> + // Make sure the pulse is created if it is going to be needed. + // If it isn't, then create it, and go back to the start to // check arrivals again. match pulse with | null when timeout >= 0 || cancellationSupported -> ensurePulse() |> ignore return! processFirstArrival() - | _ -> + | _ -> // Wait until we have been notified about a message. When that happens, rescan the arrivals - let! ok = waitOne(timeout) - if ok then + let! ok = waitOne timeout + if ok then return! processFirstArrival() - else + else return None - | res -> return res + | res -> return res } // look in the inbox first - async { + async { match x.ReceiveFromInbox() with | None -> return! processFirstArrival() - | res -> return res + | res -> return res } - member x.Receive(timeout) = + member x.Receive timeout = let rec processFirstArrival() = - async { + async { match x.ReceiveFromArrivals() with - | None -> - // Make sure the pulse is created if it is going to be needed. - // If it isn't, then create it, and go back to the start to + | None -> + // Make sure the pulse is created if it is going to be needed. + // If it isn't, then create it, and go back to the start to // check arrivals again. match pulse with | null when timeout >= 0 || cancellationSupported -> ensurePulse() |> ignore return! processFirstArrival() - | _ -> + | _ -> // Wait until we have been notified about a message. When that happens, rescan the arrivals - let! ok = waitOne(timeout) - if ok then + let! ok = waitOne timeout + if ok then return! processFirstArrival() - else + else return raise(TimeoutException(SR.GetString(SR.mailboxReceiveTimedOut))) - | Some res -> return res + | Some res -> return res } // look in the inbox first - async { + async { match x.ReceiveFromInbox() with - | None -> return! processFirstArrival() - | Some res -> return res + | None -> return! processFirstArrival() + | Some res -> return res } interface System.IDisposable with @@ -357,14 +357,14 @@ namespace Microsoft.FSharp.Control #if DEBUG member x.UnsafeContents = - (x.inbox,arrivals,pulse,savedCont) |> box + (x.inbox, arrivals, pulse, savedCont) |> box #endif [] [] type AsyncReplyChannel<'Reply>(replyf : 'Reply -> unit) = - member x.Reply(value) = replyf(value) + member x.Reply value = replyf value [] [] @@ -380,9 +380,9 @@ namespace Microsoft.FSharp.Control member __.CurrentQueueLength = mailbox.CurrentQueueLength // nb. unprotected access gives an approximation of the queue length - member __.DefaultTimeout - with get() = defaultTimeout - and set(v) = defaultTimeout <- v + member __.DefaultTimeout + with get() = defaultTimeout + and set v = defaultTimeout <- v [] member __.Error = errorEvent.Publish @@ -400,82 +400,82 @@ namespace Microsoft.FSharp.Control // Protect the execution and send errors to the event. // Note that exception stack traces are lost in this design - in an extended design // the event could propagate an ExceptionDispatchInfo instead of an Exception. - let p = - async { try - do! body x - with exn -> + let p = + async { try + do! body x + with exn -> errorEvent.Trigger exn } Async.Start(computation=p, cancellationToken=cancellationToken) - member __.Post(message) = mailbox.Post(message) + member __.Post message = mailbox.Post message - member __.TryPostAndReply(buildMessage : (_ -> 'Msg), ?timeout) : 'Reply option = + member __.TryPostAndReply(buildMessage : (_ -> 'Msg), ?timeout) : 'Reply option = let timeout = defaultArg timeout defaultTimeout use resultCell = new ResultCell<_>() let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> // Note the ResultCell may have been disposed if the operation - // timed out. In this case RegisterResult drops the result on the floor. - resultCell.RegisterResult(reply,reuseThread=false) |> ignore)) - mailbox.Post(msg) - resultCell.TryWaitForResultSynchronously(timeout=timeout) + // timed out. In this case RegisterResult drops the result on the floor. + resultCell.RegisterResult(reply, reuseThread=false) |> ignore)) + mailbox.Post msg + resultCell.TryWaitForResultSynchronously(timeout=timeout) - member x.PostAndReply(buildMessage, ?timeout) : 'Reply = - match x.TryPostAndReply(buildMessage,?timeout=timeout) with + member x.PostAndReply(buildMessage, ?timeout) : 'Reply = + match x.TryPostAndReply(buildMessage, ?timeout=timeout) with | None -> raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndReplyTimedOut))) | Some res -> res - member __.PostAndTryAsyncReply(buildMessage, ?timeout) : Async<'Reply option> = + member __.PostAndTryAsyncReply(buildMessage, ?timeout) : Async<'Reply option> = let timeout = defaultArg timeout defaultTimeout let resultCell = new ResultCell<_>() let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> // Note the ResultCell may have been disposed if the operation // timed out. In this case RegisterResult drops the result on the floor. resultCell.RegisterResult(reply, reuseThread=false) |> ignore)) - mailbox.Post(msg) + mailbox.Post msg match timeout with - | Threading.Timeout.Infinite when not cancellationSupported -> + | Threading.Timeout.Infinite when not cancellationSupported -> async { let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout - return Some result } - + return Some result } + | _ -> async { use _disposeCell = resultCell let! ok = Async.AwaitWaitHandle(resultCell.GetWaitHandle(), millisecondsTimeout=timeout) let res = (if ok then Some(resultCell.GrabResult()) else None) return res } - - member x.PostAndAsyncReply(buildMessage, ?timeout:int) = + + member x.PostAndAsyncReply(buildMessage, ?timeout:int) = let timeout = defaultArg timeout defaultTimeout match timeout with - | Threading.Timeout.Infinite when not cancellationSupported -> + | Threading.Timeout.Infinite when not cancellationSupported -> // Nothing to dispose, no wait handles used let resultCell = new ResultCell<_>() - let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> resultCell.RegisterResult(reply,reuseThread=false) |> ignore)) - mailbox.Post(msg) + let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> resultCell.RegisterResult(reply, reuseThread=false) |> ignore)) + mailbox.Post msg resultCell.AwaitResult_NoDirectCancelOrTimeout - | _ -> - let asyncReply = x.PostAndTryAsyncReply(buildMessage,timeout=timeout) + | _ -> + let asyncReply = x.PostAndTryAsyncReply(buildMessage, timeout=timeout) async { let! res = asyncReply - match res with + match res with | None -> return! raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndAsyncReplyTimedOut))) | Some res -> return res } - - member __.Receive(?timeout) = + + member __.Receive(?timeout) = mailbox.Receive(timeout=defaultArg timeout defaultTimeout) - member __.TryReceive(?timeout) = + member __.TryReceive(?timeout) = mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout) - member __.Scan(scanner: 'Msg -> (Async<'T>) option,?timeout) = - mailbox.Scan(scanner,timeout=defaultArg timeout defaultTimeout) + member __.Scan(scanner: 'Msg -> (Async<'T>) option, ?timeout) = + mailbox.Scan(scanner, timeout=defaultArg timeout defaultTimeout) - member __.TryScan(scanner: 'Msg -> (Async<'T>) option,?timeout) = - mailbox.TryScan(scanner,timeout=defaultArg timeout defaultTimeout) + member __.TryScan(scanner: 'Msg -> (Async<'T>) option, ?timeout) = + mailbox.TryScan(scanner, timeout=defaultArg timeout defaultTimeout) interface System.IDisposable with member __.Dispose() = (mailbox :> IDisposable).Dispose() - static member Start(body,?cancellationToken) = - let mailboxProcessor = new MailboxProcessor<'Msg>(body,?cancellationToken=cancellationToken) + static member Start(body, ?cancellationToken) = + let mailboxProcessor = new MailboxProcessor<'Msg>(body, ?cancellationToken=cancellationToken) mailboxProcessor.Start() mailboxProcessor diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 93504de7f..cfb5eedf7 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -174,7 +174,7 @@ module MapTree = partitionAux comparer f l acc let partition (comparer: IComparer<'Key>) f m = - partitionAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) m (empty, empty) + partitionAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m (empty, empty) let filter1 (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) k v acc = if f.Invoke (k, v) then add comparer k v acc else acc @@ -189,7 +189,7 @@ module MapTree = filterAux comparer f r acc let filter (comparer: IComparer<'Key>) f m = - filterAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) m empty + filterAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m empty let rec spliceOutSuccessor (m: MapTree<'Key, 'Value>) = match m with @@ -234,7 +234,7 @@ module MapTree = | MapNode (k2, v2, l, r, _) -> iterOpt f l; f.Invoke (k2, v2); iterOpt f r let iter f m = - iterOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) m + iterOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m let rec tryPickOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) m = match m with @@ -250,7 +250,7 @@ module MapTree = tryPickOpt f r let tryPick f m = - tryPickOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) m + tryPickOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m let rec existsOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) m = match m with @@ -259,7 +259,7 @@ module MapTree = | MapNode (k2, v2, l, r, _) -> existsOpt f l || f.Invoke (k2, v2) || existsOpt f r let exists f m = - existsOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) m + existsOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m let rec forallOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) m = match m with @@ -268,7 +268,7 @@ module MapTree = | MapNode (k2, v2, l, r, _) -> forallOpt f l && f.Invoke (k2, v2) && forallOpt f r let forall f m = - forallOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) m + forallOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m let rec map f m = match m with @@ -291,7 +291,7 @@ module MapTree = MapNode (k, v2, l2, r2, h) let mapi f m = - mapiOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) m + mapiOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m let rec foldBackOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) m x = match m with @@ -303,7 +303,7 @@ module MapTree = foldBackOpt f l x let foldBack f m x = - foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(f)) m x + foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) m x let rec foldOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) x m = match m with @@ -315,7 +315,7 @@ module MapTree = foldOpt f x r let fold f x m = - foldOpt (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(f)) x m + foldOpt (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) x m let foldSectionOpt (comparer: IComparer<'Key>) lo hi (f: OptimizedClosures.FSharpFunc<_, _, _, _>) m x = let rec foldFromTo (f: OptimizedClosures.FSharpFunc<_, _, _, _>) m x = @@ -337,7 +337,7 @@ module MapTree = if comparer.Compare(lo, hi) = 1 then x else foldFromTo f m x let foldSection (comparer: IComparer<'Key>) lo hi f m x = - foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(f)) m x + foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) m x let toList m = let rec loop m acc = @@ -471,7 +471,7 @@ type Map<[]'Key, [] member __.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = - ignore(context) + ignore context serializedData <- MapTree.toArray tree |> Array.map (fun (k, v) -> KeyValuePair(k, v)) // Do not set this to null, since concurrent threads may also be serializing the data @@ -481,7 +481,7 @@ type Map<[]'Key, [] member __.OnDeserialized(context: System.Runtime.Serialization.StreamingContext) = - ignore(context) + ignore context comparer <- LanguagePrimitives.FastGenericComparer<'Key> tree <- serializedData |> Array.map (fun (KeyValue(k, v)) -> (k, v)) |> MapTree.ofArray comparer serializedData <- null @@ -562,7 +562,7 @@ type Map<[]'Key, []'Key, [] value: byref<'Value>) = MapTree.tryGetValue comparer key &value tree - member m.TryFind(key) = + member m.TryFind key = #if TRACE_SETS_AND_MAPS MapTree.report() MapTree.numLookups <- MapTree.numLookups + 1 @@ -590,7 +590,7 @@ type Map<[]'Key, [ = + static member ofList l : Map<'Key, 'Value> = let comparer = LanguagePrimitives.FastGenericComparer<'Key> new Map<_, _>(comparer, MapTree.ofList comparer l) @@ -602,7 +602,7 @@ type Map<[]'Key, [ as that -> use e1 = (this :> seq<_>).GetEnumerator() @@ -637,20 +637,20 @@ type Map<[]'Key, [> with - member __.Add(x) = ignore(x); raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) + member __.Add x = ignore x; raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) member __.Clear() = raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) - member __.Remove(x) = ignore(x); raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) + member __.Remove x = ignore x; raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) - member m.Contains(x) = m.ContainsKey(x.Key) && Unchecked.equals m.[x.Key] x.Value + member m.Contains x = m.ContainsKey(x.Key) && Unchecked.equals m.[x.Key] x.Value member __.CopyTo(arr, i) = MapTree.copyToArray tree arr i @@ -675,7 +675,7 @@ type Map<[]'Key, [ with - member m.Item with get(key) = m.[key] + member m.Item with get key = m.[key] member m.Keys = seq { for kvp in m -> kvp.Key } @@ -797,19 +797,19 @@ module Map = [] let findKey predicate (table : Map<_, _>) = - table |> toSeq |> Seq.pick (fun (k, v) -> if predicate k v then Some(k) else None) + table |> toSeq |> Seq.pick (fun (k, v) -> if predicate k v then Some k else None) [] let tryFindKey predicate (table : Map<_, _>) = - table |> toSeq |> Seq.tryPick (fun (k, v) -> if predicate k v then Some(k) else None) + table |> toSeq |> Seq.tryPick (fun (k, v) -> if predicate k v then Some k else None) [] let ofList (elements: ('Key * 'Value) list) = - Map<_, _>.ofList(elements) + Map<_, _>.ofList elements [] let ofSeq elements = - Map<_, _>.Create(elements) + Map<_, _>.Create elements [] let ofArray (elements: ('Key * 'Value) array) = diff --git a/src/fsharp/FSharp.Core/printf.fs b/src/fsharp/FSharp.Core/printf.fs index eb0996da0..9b7f239dc 100644 --- a/src/fsharp/FSharp.Core/printf.fs +++ b/src/fsharp/FSharp.Core/printf.fs @@ -160,7 +160,7 @@ module internal PrintfImpl = else raise (ArgumentException("Missing format specifier")) else - buf.Append(c) |> ignore + buf.Append c |> ignore go (i + 1) buf go i (Text.StringBuilder()) @@ -617,7 +617,7 @@ module internal PrintfImpl = (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) -> (fun (f: 'State -> 'Residue) -> let env = env() - env.Write(s1) + env.Write s1 env.WriteT(f env.State) env.Write s2 env.Finish() @@ -628,10 +628,10 @@ module internal PrintfImpl = (fun (f: 'State -> 'Residue) -> let env() = let env = env() - env.Write(s1) + env.Write s1 env.WriteT(f env.State) env - next(env): 'Tail + next env: 'Tail ) ) @@ -883,7 +883,7 @@ module internal PrintfImpl = prefixForPositives + (if w = 0 then str else str.PadLeft(w - prefixForPositives.Length, '0')) // save space to else if str.[0] = '-' then - let str = str.Substring(1) + let str = str.Substring 1 "-" + (if w = 0 then str else str.PadLeft(w - 1, '0')) else str.PadLeft(w, '0') @@ -1115,7 +1115,7 @@ module internal PrintfImpl = let ch = spec.TypeChar - match Type.GetTypeCode(ty) with + match Type.GetTypeCode ty with | TypeCode.Int32 -> numberToString ch spec identity (uint32: int -> uint32) | TypeCode.Int64 -> numberToString ch spec identity (uint64: int64 -> uint64) | TypeCode.Byte -> numberToString ch spec identity (byte: byte -> byte) @@ -1140,7 +1140,7 @@ module internal PrintfImpl = let basicFloatToString ty spec = let defaultFormat = getFormatForFloat spec.TypeChar DefaultPrecision - match Type.GetTypeCode(ty) with + match Type.GetTypeCode ty with | TypeCode.Single -> floatWithPadding spec (getFormatForFloat spec.TypeChar) defaultFormat (fun fmt (v: float32) -> toFormattedString fmt v) | TypeCode.Double -> floatWithPadding spec (getFormatForFloat spec.TypeChar) defaultFormat (fun fmt (v: float) -> toFormattedString fmt v) | TypeCode.Decimal -> decimalWithPadding spec (getFormatForFloat spec.TypeChar) defaultFormat (fun fmt (v: decimal) -> toFormattedString fmt v) @@ -1170,11 +1170,11 @@ module internal PrintfImpl = basicFloatToString ty spec | 'A' -> let mi = typeof.GetMethod("GenericToString", NonPublicStatics) - let mi = mi.MakeGenericMethod(ty) + let mi = mi.MakeGenericMethod ty mi.Invoke(null, [| box spec |]) | 'O' -> let mi = typeof.GetMethod("ObjectToString", NonPublicStatics) - let mi = mi.MakeGenericMethod(ty) + let mi = mi.MakeGenericMethod ty mi.Invoke(null, [| box spec |]) | _ -> raise (ArgumentException(SR.GetString(SR.printfBadFormatSpecifier))) @@ -1196,8 +1196,8 @@ module internal PrintfImpl = go ty 0 type private PrintfBuilderStack() = - let args = Stack(10) - let types = Stack(5) + let args = Stack 10 + let types = Stack 5 let stackToArray size start count (s: Stack<_>) = let arr = Array.zeroCreate size @@ -1244,7 +1244,7 @@ module internal PrintfImpl = args.Push value types.Push ty - member __.HasContinuationOnStack(expectedNumberOfArguments) = + member __.HasContinuationOnStack expectedNumberOfArguments = types.Count = expectedNumberOfArguments + 1 member __.IsEmpty = @@ -1338,7 +1338,7 @@ module internal PrintfImpl = mi, [| box prefix; box suffix |] else let argTy = argTys.[argTys.Length - 2] - let mi = mi.MakeGenericMethod(argTy) + let mi = mi.MakeGenericMethod argTy let conv = getValueConverter argTy spec mi, [| box prefix; box conv; box suffix |] @@ -1366,7 +1366,7 @@ module internal PrintfImpl = #if DEBUG verifyMethodInfoWasTaken mi #endif - let mi = mi.MakeGenericMethod(argTypes) + let mi = mi.MakeGenericMethod argTypes mi.Invoke(null, args) let buildPlainChained(args: obj[], argTypes: Type[]) = @@ -1382,7 +1382,7 @@ module internal PrintfImpl = #if DEBUG verifyMethodInfoWasTaken mi #endif - let mi = mi.MakeGenericMethod(argTypes) + let mi = mi.MakeGenericMethod argTypes mi.Invoke(null, args) let builderStack = PrintfBuilderStack() @@ -1458,7 +1458,7 @@ module internal PrintfImpl = builderStack.PushContinuationWithType(currentCont, funcTy) ContinuationOnStack else - let hasCont = builderStack.HasContinuationOnStack(numberOfArgs) + let hasCont = builderStack.HasContinuationOnStack numberOfArgs let expectedNumberOfItemsOnStack = numberOfArgs * 2 let sizeOfTypesArray = @@ -1529,7 +1529,7 @@ module internal PrintfImpl = /// printf is called in tight loop /// 2nd level is global dictionary that maps format string to the corresponding PrintfFactory type Cache<'T, 'State, 'Residue, 'Result>() = - static let generate(fmt) = PrintfBuilder<'State, 'Residue, 'Result>().Build<'T>(fmt) + static let generate fmt = PrintfBuilder<'State, 'Residue, 'Result>().Build<'T>(fmt) static let mutable map = System.Collections.Concurrent.ConcurrentDictionary>() static let getOrAddFunc = Func<_, _>(generate) static let get(key: string) = map.GetOrAdd(key, getOrAddFunc) @@ -1553,11 +1553,11 @@ module internal PrintfImpl = let buf: string[] = Array.zeroCreate n let mutable ptr = 0 - override __.Finish() : 'Result = k (String.Concat(buf)) + override __.Finish() : 'Result = k (String.Concat buf) override __.Write(s: string) = buf.[ptr] <- s ptr <- ptr + 1 - override __.WriteT(s) = + override __.WriteT s = buf.[ptr] <- s ptr <- ptr + 1 @@ -1568,12 +1568,12 @@ module internal PrintfImpl = override __.Finish() : 'Result = k c override __.Write(s: string) = if isNull c then c <- s else c <- c + s - override __.WriteT(s) = if isNull c then c <- s else c <- c + s + override __.WriteT s = if isNull c then c <- s else c <- c + s type StringBuilderPrintfEnv<'Result>(k, buf) = inherit PrintfEnv(buf) override __.Finish() : 'Result = k () - override __.Write(s: string) = ignore(buf.Append(s)) + override __.Write(s: string) = ignore(buf.Append s) override __.WriteT(()) = () type TextWriterPrintfEnv<'Result>(k, tw: IO.TextWriter) = @@ -1584,7 +1584,7 @@ module internal PrintfImpl = let inline doPrintf fmt f = let formatter, n = Cache<_, _, _, _>.Get fmt - let env() = f(n) + let env() = f n formatter env [] @@ -1606,7 +1606,7 @@ module Printf = let ksprintf continuation (format: StringFormat<'T, 'Result>) : 'T = doPrintf format (fun n -> if n <= 2 then - SmallStringPrintfEnv(continuation) :> PrintfEnv<_, _, _> + SmallStringPrintfEnv continuation :> PrintfEnv<_, _, _> else StringPrintfEnv(continuation, n) :> PrintfEnv<_, _, _> ) @@ -1615,7 +1615,7 @@ module Printf = let sprintf (format: StringFormat<'T>) = doPrintf format (fun n -> if n <= 2 then - SmallStringPrintfEnv(id) :> PrintfEnv<_, _, _> + SmallStringPrintfEnv id :> PrintfEnv<_, _, _> else StringPrintfEnv(id, n) :> PrintfEnv<_, _, _> ) diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index 58d0ef293..60a0ca003 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -71,7 +71,7 @@ module Helpers = false let getDelegateInvoke ty = - if not (isDelegateType(ty)) then invalidArg "ty" (SR.GetString(SR.delegateExpected)) + if not (isDelegateType ty) then invalidArg "ty" (SR.GetString(SR.delegateExpected)) ty.GetMethod("Invoke", instanceBindingFlags) @@ -198,7 +198,7 @@ and [] member x.Tree = term member x.CustomAttributes = attribs - override x.Equals(obj) = + override x.Equals obj = match obj with | :? Expr as y -> let rec eq t1 t2 = @@ -216,13 +216,13 @@ and [] override x.GetHashCode() = x.Tree.GetHashCode() - override x.ToString() = x.ToString(false) + override x.ToString() = x.ToString false - member x.ToString(full) = - Microsoft.FSharp.Text.StructuredPrintfImpl.Display.layout_to_string Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions.Default (x.GetLayout(full)) + member x.ToString full = + Microsoft.FSharp.Text.StructuredPrintfImpl.Display.layout_to_string Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions.Default (x.GetLayout full) - member x.GetLayout(long) = - let expr (e:Expr ) = e.GetLayout(long) + member x.GetLayout long = + let expr (e:Expr ) = e.GetLayout long let exprs (es:Expr list) = es |> List.map expr let parens ls = bracketL (commaListL ls) let pairL l1 l2 = bracketL (l1 ^^ sepL Literals.comma ^^ l2) @@ -251,40 +251,40 @@ and [] match x.Tree with | CombTerm(AppOp, args) -> combL "Application" (exprs args) | CombTerm(IfThenElseOp, args) -> combL "IfThenElse" (exprs args) - | CombTerm(LetRecOp, [IteratedLambda(vs, E(CombTerm(LetRecCombOp, b2::bs)))]) -> combL "LetRecursive" [listL (List.map2 pairL (List.map varL vs) (exprs bs) ); b2.GetLayout(long)] - | CombTerm(LetOp, [e;E(LambdaTerm(v, b))]) -> combL "Let" [varL v; e.GetLayout(long); b.GetLayout(long)] - | CombTerm(NewRecordOp(ty), args) -> combL "NewRecord" (typeL ty :: exprs args) - | CombTerm(NewUnionCaseOp(unionCase), args) -> combL "NewUnionCase" (ucaseL unionCase :: exprs args) - | CombTerm(UnionCaseTestOp(unionCase), args) -> combL "UnionCaseTest" (exprs args@ [ucaseL unionCase]) + | CombTerm(LetRecOp, [IteratedLambda(vs, E(CombTerm(LetRecCombOp, b2::bs)))]) -> combL "LetRecursive" [listL (List.map2 pairL (List.map varL vs) (exprs bs) ); b2.GetLayout long] + | CombTerm(LetOp, [e;E(LambdaTerm(v, b))]) -> combL "Let" [varL v; e.GetLayout long; b.GetLayout long] + | CombTerm(NewRecordOp ty, args) -> combL "NewRecord" (typeL ty :: exprs args) + | CombTerm(NewUnionCaseOp unionCase, args) -> combL "NewUnionCase" (ucaseL unionCase :: exprs args) + | CombTerm(UnionCaseTestOp unionCase, args) -> combL "UnionCaseTest" (exprs args@ [ucaseL unionCase]) | CombTerm(NewTupleOp _, args) -> combL "NewTuple" (exprs args) | CombTerm(TupleGetOp (_, i), [arg]) -> combL "TupleGet" ([expr arg] @ [objL i]) | CombTerm(ValueOp(v, _, Some nm), []) -> combL "ValueWithName" [objL v; wordL (tagLocal nm)] | CombTerm(ValueOp(v, _, None), []) -> combL "Value" [objL v] | CombTerm(WithValueOp(v, _), [defn]) -> combL "WithValue" [objL v; expr defn] - | CombTerm(InstanceMethodCallOp(minfo), obj::args) -> combL "Call" [someL obj; minfoL minfo; listL (exprs args)] - | CombTerm(StaticMethodCallOp(minfo), args) -> combL "Call" [noneL; minfoL minfo; listL (exprs args)] - | CombTerm(InstancePropGetOp(pinfo), (obj::args)) -> combL "PropertyGet" [someL obj; pinfoL pinfo; listL (exprs args)] - | CombTerm(StaticPropGetOp(pinfo), args) -> combL "PropertyGet" [noneL; pinfoL pinfo; listL (exprs args)] - | CombTerm(InstancePropSetOp(pinfo), (obj::args)) -> combL "PropertySet" [someL obj; pinfoL pinfo; listL (exprs args)] - | CombTerm(StaticPropSetOp(pinfo), args) -> combL "PropertySet" [noneL; pinfoL pinfo; listL (exprs args)] - | CombTerm(InstanceFieldGetOp(finfo), [obj]) -> combL "FieldGet" [someL obj; finfoL finfo] - | CombTerm(StaticFieldGetOp(finfo), []) -> combL "FieldGet" [noneL; finfoL finfo] - | CombTerm(InstanceFieldSetOp(finfo), [obj;v]) -> combL "FieldSet" [someL obj; finfoL finfo; expr v;] - | CombTerm(StaticFieldSetOp(finfo), [v]) -> combL "FieldSet" [noneL; finfoL finfo; expr v;] - | CombTerm(CoerceOp(ty), [arg]) -> combL "Coerce" [ expr arg; typeL ty] + | CombTerm(InstanceMethodCallOp minfo, obj::args) -> combL "Call" [someL obj; minfoL minfo; listL (exprs args)] + | CombTerm(StaticMethodCallOp minfo, args) -> combL "Call" [noneL; minfoL minfo; listL (exprs args)] + | CombTerm(InstancePropGetOp pinfo, (obj::args)) -> combL "PropertyGet" [someL obj; pinfoL pinfo; listL (exprs args)] + | CombTerm(StaticPropGetOp pinfo, args) -> combL "PropertyGet" [noneL; pinfoL pinfo; listL (exprs args)] + | CombTerm(InstancePropSetOp pinfo, (obj::args)) -> combL "PropertySet" [someL obj; pinfoL pinfo; listL (exprs args)] + | CombTerm(StaticPropSetOp pinfo, args) -> combL "PropertySet" [noneL; pinfoL pinfo; listL (exprs args)] + | CombTerm(InstanceFieldGetOp finfo, [obj]) -> combL "FieldGet" [someL obj; finfoL finfo] + | CombTerm(StaticFieldGetOp finfo, []) -> combL "FieldGet" [noneL; finfoL finfo] + | CombTerm(InstanceFieldSetOp finfo, [obj;v]) -> combL "FieldSet" [someL obj; finfoL finfo; expr v;] + | CombTerm(StaticFieldSetOp finfo, [v]) -> combL "FieldSet" [noneL; finfoL finfo; expr v;] + | CombTerm(CoerceOp ty, [arg]) -> combL "Coerce" [ expr arg; typeL ty] | CombTerm(NewObjectOp cinfo, args) -> combL "NewObject" ([ cinfoL cinfo ] @ exprs args) - | CombTerm(DefaultValueOp(ty), args) -> combL "DefaultValue" ([ typeL ty ] @ exprs args) - | CombTerm(NewArrayOp(ty), args) -> combL "NewArray" ([ typeL ty ] @ exprs args) - | CombTerm(TypeTestOp(ty), args) -> combL "TypeTest" ([ typeL ty] @ exprs args) + | CombTerm(DefaultValueOp ty, args) -> combL "DefaultValue" ([ typeL ty ] @ exprs args) + | CombTerm(NewArrayOp ty, args) -> combL "NewArray" ([ typeL ty ] @ exprs args) + | CombTerm(TypeTestOp ty, args) -> combL "TypeTest" ([ typeL ty] @ exprs args) | CombTerm(AddressOfOp, args) -> combL "AddressOf" (exprs args) - | CombTerm(VarSetOp, [E(VarTerm(v)); e]) -> combL "VarSet" [varL v; expr e] + | CombTerm(VarSetOp, [E(VarTerm v); e]) -> combL "VarSet" [varL v; expr e] | CombTerm(AddressSetOp, args) -> combL "AddressSet" (exprs args) | CombTerm(ForIntegerRangeLoopOp, [e1;e2;E(LambdaTerm(v, e3))]) -> combL "ForIntegerRangeLoop" [varL v; expr e1; expr e2; expr e3] | CombTerm(WhileLoopOp, args) -> combL "WhileLoop" (exprs args) | CombTerm(TryFinallyOp, args) -> combL "TryFinally" (exprs args) | CombTerm(TryWithOp, [e1;Lambda(v1, e2);Lambda(v2, e3)]) -> combL "TryWith" [expr e1; varL v1; expr e2; varL v2; expr e3] | CombTerm(SequentialOp, args) -> combL "Sequential" (exprs args) - | CombTerm(NewDelegateOp(ty), [e]) -> + | CombTerm(NewDelegateOp ty, [e]) -> let nargs = (getDelegateInvoke ty).GetParameters().Length if nargs = 0 then match e with @@ -296,7 +296,7 @@ and [] | NLambdas nargs (vs, e) -> combL "NewDelegate" ([typeL ty] @ (vs |> List.map varL) @ [expr e]) | _ -> combL "NewDelegate" [typeL ty; expr e] //| CombTerm(_, args) -> combL "??" (exprs args) - | VarTerm(v) -> wordL (tagLocal v.Name) + | VarTerm v -> wordL (tagLocal v.Name) | LambdaTerm(v, b) -> combL "Lambda" [varL v; expr b] | HoleTerm _ -> wordL (tagLocal "_") | CombTerm(QuoteOp _, args) -> combL "Quote" (exprs args) @@ -370,7 +370,7 @@ module Patterns = // Active patterns for decomposing quotations //-------------------------------------------------------------------------- - let (|Comb0|_|) (E x) = match x with CombTerm(k, []) -> Some(k) | _ -> None + let (|Comb0|_|) (E x) = match x with CombTerm(k, []) -> Some k | _ -> None let (|Comb1|_|) (E x) = match x with CombTerm(k, [x]) -> Some(k, x) | _ -> None @@ -400,19 +400,19 @@ module Patterns = let (|IfThenElse|_|) input = match input with Comb3(IfThenElseOp, e1, e2, e3) -> Some(e1, e2, e3) | _ -> None [] - let (|NewTuple|_|) input = match input with E(CombTerm(NewTupleOp(_), es)) -> Some(es) | _ -> None + let (|NewTuple|_|) input = match input with E(CombTerm(NewTupleOp(_), es)) -> Some es | _ -> None [] - let (|DefaultValue|_|) input = match input with E(CombTerm(DefaultValueOp(ty), [])) -> Some(ty) | _ -> None + let (|DefaultValue|_|) input = match input with E(CombTerm(DefaultValueOp ty, [])) -> Some ty | _ -> None [] - let (|NewRecord|_|) input = match input with E(CombTerm(NewRecordOp(x), es)) -> Some(x, es) | _ -> None + let (|NewRecord|_|) input = match input with E(CombTerm(NewRecordOp x, es)) -> Some(x, es) | _ -> None [] - let (|NewUnionCase|_|) input = match input with E(CombTerm(NewUnionCaseOp(unionCase), es)) -> Some(unionCase, es) | _ -> None + let (|NewUnionCase|_|) input = match input with E(CombTerm(NewUnionCaseOp unionCase, es)) -> Some(unionCase, es) | _ -> None [] - let (|UnionCaseTest|_|) input = match input with Comb1(UnionCaseTestOp(unionCase), e) -> Some(e, unionCase) | _ -> None + let (|UnionCaseTest|_|) input = match input with Comb1(UnionCaseTestOp unionCase, e) -> Some(e, unionCase) | _ -> None [] let (|TupleGet|_|) input = match input with Comb1(TupleGetOp(_, n), e) -> Some(e, n) | _ -> None @@ -436,13 +436,13 @@ module Patterns = let (|TryWith|_|) input = match input with E(CombTerm(TryWithOp, [e1;Lambda(v1, e2);Lambda(v2, e3)])) -> Some(e1, v1, e2, v2, e3) | _ -> None [] - let (|VarSet|_| ) input = match input with E(CombTerm(VarSetOp, [E(VarTerm(v)); e])) -> Some(v, e) | _ -> None + let (|VarSet|_| ) input = match input with E(CombTerm(VarSetOp, [E(VarTerm v); e])) -> Some(v, e) | _ -> None [] let (|Value|_|) input = match input with E(CombTerm(ValueOp (v, ty, _), _)) -> Some(v, ty) | _ -> None [] - let (|ValueObj|_|) input = match input with E(CombTerm(ValueOp (v, _, _), _)) -> Some(v) | _ -> None + let (|ValueObj|_|) input = match input with E(CombTerm(ValueOp (v, _, _), _)) -> Some v | _ -> None [] let (|ValueWithName|_|) input = @@ -459,7 +459,7 @@ module Patterns = [] let (|AddressOf|_|) input = match input with - | Comb1(AddressOfOp, e) -> Some(e) + | Comb1(AddressOfOp, e) -> Some e | _ -> None [] @@ -484,14 +484,14 @@ module Patterns = let (|PropertyGet|_|) input = match input with | E(CombTerm(StaticPropGetOp pinfo, args)) -> Some(None, pinfo, args) - | E(CombTerm(InstancePropGetOp pinfo, obj::args)) -> Some(Some(obj), pinfo, args) + | E(CombTerm(InstancePropGetOp pinfo, obj::args)) -> Some(Some obj, pinfo, args) | _ -> None [] let (|PropertySet|_|) input = match input with | E(CombTerm(StaticPropSetOp pinfo, FrontAndBack(args, v))) -> Some(None, pinfo, args, v) - | E(CombTerm(InstancePropSetOp pinfo, obj::FrontAndBack(args, v))) -> Some(Some(obj), pinfo, args, v) + | E(CombTerm(InstancePropSetOp pinfo, obj::FrontAndBack(args, v))) -> Some(Some obj, pinfo, args, v) | _ -> None @@ -499,14 +499,14 @@ module Patterns = let (|FieldGet|_|) input = match input with | E(CombTerm(StaticFieldGetOp finfo, [])) -> Some(None, finfo) - | E(CombTerm(InstanceFieldGetOp finfo, [obj])) -> Some(Some(obj), finfo) + | E(CombTerm(InstanceFieldGetOp finfo, [obj])) -> Some(Some obj, finfo) | _ -> None [] let (|FieldSet|_|) input = match input with | E(CombTerm(StaticFieldSetOp finfo, [v])) -> Some(None, finfo, v) - | E(CombTerm(InstanceFieldSetOp finfo, [obj;v])) -> Some(Some(obj), finfo, v) + | E(CombTerm(InstanceFieldSetOp finfo, [obj;v])) -> Some(Some obj, finfo, v) | _ -> None [] @@ -518,7 +518,7 @@ module Patterns = let (|Call|_|) input = match input with | E(CombTerm(StaticMethodCallOp minfo, args)) -> Some(None, minfo, args) - | E(CombTerm(InstanceMethodCallOp minfo, (obj::args))) -> Some(Some(obj), minfo, args) + | E(CombTerm(InstanceMethodCallOp minfo, (obj::args))) -> Some(Some obj, minfo, args) | _ -> None let (|LetRaw|_|) input = @@ -528,7 +528,7 @@ module Patterns = let (|LetRecRaw|_|) input = match input with - | Comb1(LetRecOp, e1) -> Some(e1) + | Comb1(LetRecOp, e1) -> Some e1 | _ -> None [] @@ -548,7 +548,7 @@ module Patterns = [] let (|NewDelegate|_|) input = match input with - | Comb1(NewDelegateOp(ty), e) -> + | Comb1(NewDelegateOp ty, e) -> let nargs = (getDelegateInvoke ty).GetParameters().Length if nargs = 0 then match e with @@ -581,7 +581,7 @@ module Patterns = let getUnionCaseInfo(ty, unionCaseName) = let cases = FSharpType.GetUnionCases(ty, publicOrPrivateBindingFlags) match cases |> Array.tryFind (fun ucase -> ucase.Name = unionCaseName) with - | Some(case) -> case + | Some case -> case | _ -> invalidArg "unionCaseName" (String.Format(SR.GetString(SR.QmissingUnionCase), ty.FullName, unionCaseName)) let getUnionCaseInfoField(unionCase:UnionCaseInfo, index) = @@ -664,7 +664,7 @@ module Patterns = // t2 is inherited from t1 / t2 implements interface t1 or t2 == t1 let assignableFrom (t1:Type) (t2:Type) = - t1.IsAssignableFrom(t2) + t1.IsAssignableFrom t2 let checkTypesSR (expectedType: Type) (receivedType : Type) name (threeHoleSR : string) = if (expectedType <> receivedType) then @@ -707,7 +707,7 @@ module Patterns = let getUnionCaseFields ty str = let cases = FSharpType.GetUnionCases(ty, publicOrPrivateBindingFlags) match cases |> Array.tryFind (fun ucase -> ucase.Name = str) with - | Some(case) -> case.GetFields() + | Some case -> case.GetFields() | _ -> invalidArg "ty" (String.Format(SR.GetString(SR.notAUnionType), ty.FullName)) let checkBind(v:Var, e) = @@ -728,8 +728,8 @@ module Patterns = let mkUnit () = mkValue(null, typeof) let mkAddressOf v = mkFE1 AddressOfOp v let mkSequential (e1, e2) = mkFE2 SequentialOp (e1, e2) - let mkTypeTest (e, ty) = mkFE1 (TypeTestOp(ty)) e - let mkVarSet (v, e) = mkFE2 VarSetOp (mkVar(v), e) + let mkTypeTest (e, ty) = mkFE1 (TypeTestOp ty) e + let mkVarSet (v, e) = mkFE2 VarSetOp (mkVar v, e) let mkAddressSet (e1, e2) = mkFE2 AddressSetOp (e1, e2) let mkLambda(var, body) = E(LambdaTerm(var, (body:>Expr))) let mkTryWith(e1, v1, e2, v2, e3) = mkFE3 TryWithOp (e1, mkLambda(v1, e2), mkLambda(v2, e3)) @@ -938,7 +938,7 @@ module Patterns = | Unique of 'T | Ambiguous of 'R - let typeEquals (s:Type) (t:Type) = s.Equals(t) + let typeEquals (s:Type) (t:Type) = s.Equals t let typesEqual (ss:Type list) (tt:Type list) = (ss.Length = tt.Length) && List.forall2 typeEquals ss tt @@ -952,9 +952,9 @@ module Patterns = if tc.IsGenericType then tc.GetGenericArguments().Length else 0 let bindMethodBySearch (parentT:Type, nm, marity, argtys, rty) = - let methInfos = parentT.GetMethods(staticOrInstanceBindingFlags) |> Array.toList + let methInfos = parentT.GetMethods staticOrInstanceBindingFlags |> Array.toList // First, filter on name, if unique, then binding "done" - let tyargTs = getGenericArguments(parentT) + let tyargTs = getGenericArguments parentT let methInfos = methInfos |> List.filter (fun methInfo -> methInfo.Name = nm) match methInfos with | [methInfo] -> @@ -997,7 +997,7 @@ module Patterns = match parentT.GetMethod(nm, staticOrInstanceBindingFlags, null, argTs, null) with #endif | null -> None - | res -> Some(res) + | res -> Some res with :? AmbiguousMatchException -> None match methInfo with | Some methInfo when (typeEquals resT methInfo.ReturnType) -> methInfo @@ -1013,7 +1013,7 @@ module Patterns = // tries to locate unique function in a given type // in case of multiple candidates returns None so bindModuleFunctionWithCallSiteArgs will be used for more precise resolution let bindModuleFunction (ty:Type, nm) = - match ty.GetMethods(staticBindingFlags) |> Array.filter (fun mi -> mi.Name = nm) with + match ty.GetMethods staticBindingFlags |> Array.filter (fun mi -> mi.Name = nm) with | [||] -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) | [| res |] -> Some res | _ -> None @@ -1029,14 +1029,14 @@ module Patterns = match ty.GetMethod(nm, staticOrInstanceBindingFlags, null, argTypes, null) with #endif | null -> None - | res -> Some(res) + | res -> Some res with :? AmbiguousMatchException -> None match methInfo with | Some methInfo -> methInfo | _ -> // narrow down set of candidates by removing methods with a different name\number of arguments\number of type parameters let candidates = - ty.GetMethods(staticBindingFlags) + ty.GetMethods staticBindingFlags |> Array.filter(fun mi -> mi.Name = nm && mi.GetParameters().Length = argTypes.Length && @@ -1106,13 +1106,13 @@ module Patterns = | null -> raise (new ArgumentNullException(arg, err)) | _ -> y - let inst (tyargs:Type list) (i: Instantiable<'T>) = i (fun idx -> tyargs.[idx]) // Note, O(n) looks, but #tyargs is always small + let inst (tyargs:Type list) (i: Instantiable<'T>) = i (fun idx -> tyargs.[idx]) // Note, O n looks, but #tyargs is always small let bindPropBySearchIfCandidateIsNull (ty : Type) propName retType argTypes candidate = match candidate with | null -> let props = - ty.GetProperties(staticOrInstanceBindingFlags) + ty.GetProperties staticOrInstanceBindingFlags |> Array.filter (fun pi -> let paramTypes = getTypesFromParamInfos (pi.GetIndexParameters()) pi.Name = propName && @@ -1129,7 +1129,7 @@ module Patterns = match candidate with | null -> let ctors = - ty.GetConstructors(instanceBindingFlags) + ty.GetConstructors instanceBindingFlags |> Array.filter (fun ci -> let paramTypes = getTypesFromParamInfos (ci.GetParameters()) Array.length argTypes = paramTypes.Length && @@ -1167,7 +1167,7 @@ module Patterns = let argtyps = instFormal (getGenericArguments tc) argTypes #if FX_RESHAPED_REFLECTION let argTypes = Array.ofList argtyps - tc.GetConstructor(argTypes) + tc.GetConstructor argTypes |> bindCtorBySearchIfCandidateIsNull tc argTypes |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) #else @@ -1179,7 +1179,7 @@ module Patterns = let argtyps = argTypes |> inst tyargs #if FX_RESHAPED_REFLECTION let argTypes = Array.ofList argtyps - typ.GetConstructor(argTypes) + typ.GetConstructor argTypes |> bindCtorBySearchIfCandidateIsNull typ argTypes |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) #else @@ -1297,7 +1297,7 @@ module Patterns = let u_uniq (tbl: _ array) st = let n = u_int st - if n < 0 || n >= tbl.Length then failwith ("u_uniq: out of range, n = "+string n+ ", sizeof(tab) = " + string tbl.Length) + if n < 0 || n >= tbl.Length then failwith ("u_uniq: out of range, n = "+string n+ ", sizeof tab = " + string tbl.Length) tbl.[n] let u_string st = u_uniq st.istrings st @@ -1337,12 +1337,12 @@ module Patterns = let decodeArrayTy n (tys: Type list) = match tys with - | [ty] -> if (n = 1) then ty.MakeArrayType() else ty.MakeArrayType(n) - // typeof.MakeArrayType(1) returns "Int[*]" but we need "Int[]" + | [ty] -> if (n = 1) then ty.MakeArrayType() else ty.MakeArrayType n + // typeof.MakeArrayType 1 returns "Int[*]" but we need "Int[]" | _ -> invalidArg "tys" (SR.GetString(SR.QexpectedOneType)) let mkNamedTycon (tcName, assembly:Assembly) = - match assembly.GetType(tcName) with + match assembly.GetType tcName with | null -> // For some reason we can get 'null' returned here even when a type with the right name exists... Hence search the slow way... match (assembly.GetTypes() |> Array.tryFind (fun a -> a.FullName = tcName)) with @@ -1361,9 +1361,9 @@ module Patterns = elif a = "." then st.localAssembly else #if FX_RESHAPED_REFLECTION - match System.Reflection.Assembly.Load(AssemblyName(a)) with + match System.Reflection.Assembly.Load(AssemblyName a) with #else - match System.Reflection.Assembly.Load(a) with + match System.Reflection.Assembly.Load a with #endif | null -> raise <| System.InvalidOperationException(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString())) | assembly -> assembly @@ -1396,7 +1396,7 @@ module Patterns = let rec u_dtype st : (int -> Type) -> Type = let tag = u_byte_as_int st match tag with - | 0 -> u_int st |> (fun x env -> env(x)) + | 0 -> u_int st |> (fun x env -> env x) | 1 -> u_tup2 u_tyconstSpec (u_list u_dtype) st |> (fun (a, b) env -> a (appL b env)) | _ -> failwith "u_dtype" @@ -1499,7 +1499,7 @@ module Patterns = if isProp then Unique(StaticPropGetOp(bindModuleProperty(ty, nm))) else match bindModuleFunction(ty, nm) with - | Some mi -> Unique(StaticMethodCallOp(mi)) + | Some mi -> Unique(StaticMethodCallOp mi) | None -> Ambiguous(fun argTypes tyargs -> StaticMethodCallOp(bindModuleFunctionWithCallSiteArgs(ty, nm, argTypes, tyargs))) and u_MethodInfoData st = @@ -1516,8 +1516,8 @@ module Patterns = match tag with | 0 -> match u_ModuleDefn st with - | Unique(StaticMethodCallOp(minfo)) -> (minfo :> MethodBase) - | Unique(StaticPropGetOp(pinfo)) -> (pinfo.GetGetMethod(true) :> MethodBase) + | Unique(StaticMethodCallOp minfo) -> (minfo :> MethodBase) + | Unique(StaticPropGetOp pinfo) -> (pinfo.GetGetMethod true :> MethodBase) | Ambiguous(_) -> raise (System.Reflection.AmbiguousMatchException()) | _ -> failwith "unreachable" | 1 -> @@ -1526,11 +1526,11 @@ module Patterns = let cinfo = bindGenericCctor tc (cinfo :> MethodBase) else - let minfo = bindGenericMeth(data) + let minfo = bindGenericMeth data (minfo :> MethodBase) | 2 -> let data = u_CtorInfoData st - let cinfo = bindGenericCtor(data) in + let cinfo = bindGenericCtor data (cinfo :> MethodBase) | _ -> failwith "u_MethodBase" @@ -1540,12 +1540,12 @@ module Patterns = if tag = 1 then let bindModuleDefn r tyargs = match r with - | StaticMethodCallOp(minfo) -> StaticMethodCallOp(instMeth(minfo, tyargs)) + | StaticMethodCallOp minfo -> StaticMethodCallOp(instMeth(minfo, tyargs)) // OK to throw away the tyargs here since this only non-generic values in modules get represented by static properties | x -> x match u_ModuleDefn st with - | Unique(r) -> Unique(bindModuleDefn r) - | Ambiguous(f) -> Ambiguous(fun argTypes tyargs -> bindModuleDefn (f argTypes tyargs) tyargs) + | Unique r -> Unique(bindModuleDefn r) + | Ambiguous f -> Ambiguous(fun argTypes tyargs -> bindModuleDefn (f argTypes tyargs) tyargs) else let constSpec = match tag with @@ -1556,44 +1556,44 @@ module Patterns = | 5 -> u_UnionCaseInfo st |> (fun unionCase tyargs -> NewUnionCaseOp(unionCase tyargs)) | 6 -> u_UnionCaseField st |> (fun prop tyargs -> InstancePropGetOp(prop tyargs) ) | 7 -> u_UnionCaseInfo st |> (fun unionCase tyargs -> UnionCaseTestOp(unionCase tyargs)) - | 8 -> u_void st |> (fun () (OneTyArg(tyarg)) -> NewTupleOp tyarg) - | 9 -> u_int st |> (fun x (OneTyArg(tyarg)) -> TupleGetOp (tyarg, x)) + | 8 -> u_void st |> (fun () (OneTyArg tyarg) -> NewTupleOp tyarg) + | 9 -> u_int st |> (fun x (OneTyArg tyarg) -> TupleGetOp (tyarg, x)) // Note, these get type args because they may be the result of reading literal field constants - | 11 -> u_bool st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg)) - | 12 -> u_string st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg)) - | 13 -> u_float32 st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg)) - | 14 -> u_double st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 15 -> u_char st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 16 -> u_sbyte st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 17 -> u_byte st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 18 -> u_int16 st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 19 -> u_uint16 st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 20 -> u_int32 st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 21 -> u_uint32 st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 22 -> u_int64 st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) - | 23 -> u_uint64 st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg)) + | 11 -> u_bool st |> (fun x (OneTyArg tyarg) -> mkLiftedValueOpG (x, tyarg)) + | 12 -> u_string st |> (fun x (OneTyArg tyarg) -> mkLiftedValueOpG (x, tyarg)) + | 13 -> u_float32 st |> (fun x (OneTyArg tyarg) -> mkLiftedValueOpG (x, tyarg)) + | 14 -> u_double st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 15 -> u_char st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 16 -> u_sbyte st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 17 -> u_byte st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 18 -> u_int16 st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 19 -> u_uint16 st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 20 -> u_int32 st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 21 -> u_uint32 st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 22 -> u_int64 st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) + | 23 -> u_uint64 st |> (fun a (OneTyArg tyarg) -> mkLiftedValueOpG (a, tyarg)) | 24 -> u_void st |> (fun () NoTyArgs -> mkLiftedValueOpG ((), typeof)) - | 25 -> u_PropInfoData st |> (fun (a, b, c, d) tyargs -> let pinfo = bindProp(a, b, c, d, tyargs) in if pinfoIsStatic pinfo then StaticPropGetOp(pinfo) else InstancePropGetOp(pinfo)) + | 25 -> u_PropInfoData st |> (fun (a, b, c, d) tyargs -> let pinfo = bindProp(a, b, c, d, tyargs) in if pinfoIsStatic pinfo then StaticPropGetOp pinfo else InstancePropGetOp pinfo) | 26 -> u_CtorInfoData st |> (fun (a, b) tyargs -> NewObjectOp (bindCtor(a, b, tyargs))) - | 28 -> u_void st |> (fun () (OneTyArg(ty)) -> CoerceOp ty) + | 28 -> u_void st |> (fun () (OneTyArg ty) -> CoerceOp ty) | 29 -> u_void st |> (fun () NoTyArgs -> SequentialOp) | 30 -> u_void st |> (fun () NoTyArgs -> ForIntegerRangeLoopOp) - | 31 -> u_MethodInfoData st |> (fun p tyargs -> let minfo = bindMeth(p, tyargs) in if minfo.IsStatic then StaticMethodCallOp(minfo) else InstanceMethodCallOp(minfo)) - | 32 -> u_void st |> (fun () (OneTyArg(ty)) -> NewArrayOp ty) - | 33 -> u_void st |> (fun () (OneTyArg(ty)) -> NewDelegateOp ty) + | 31 -> u_MethodInfoData st |> (fun p tyargs -> let minfo = bindMeth(p, tyargs) in if minfo.IsStatic then StaticMethodCallOp minfo else InstanceMethodCallOp minfo) + | 32 -> u_void st |> (fun () (OneTyArg ty) -> NewArrayOp ty) + | 33 -> u_void st |> (fun () (OneTyArg ty) -> NewDelegateOp ty) | 34 -> u_void st |> (fun () NoTyArgs -> WhileLoopOp) | 35 -> u_void st |> (fun () NoTyArgs -> LetOp) | 36 -> u_RecdField st |> (fun prop tyargs -> InstancePropSetOp(prop tyargs)) - | 37 -> u_tup2 u_NamedType u_string st |> (fun (a, b) tyargs -> let finfo = bindField(a, b, tyargs) in if finfo.IsStatic then StaticFieldGetOp(finfo) else InstanceFieldGetOp(finfo)) + | 37 -> u_tup2 u_NamedType u_string st |> (fun (a, b) tyargs -> let finfo = bindField(a, b, tyargs) in if finfo.IsStatic then StaticFieldGetOp finfo else InstanceFieldGetOp finfo) | 38 -> u_void st |> (fun () NoTyArgs -> LetRecCombOp) | 39 -> u_void st |> (fun () NoTyArgs -> AppOp) - | 40 -> u_void st |> (fun () (OneTyArg(ty)) -> ValueOp(null, ty, None)) - | 41 -> u_void st |> (fun () (OneTyArg(ty)) -> DefaultValueOp(ty)) - | 42 -> u_PropInfoData st |> (fun (a, b, c, d) tyargs -> let pinfo = bindProp(a, b, c, d, tyargs) in if pinfoIsStatic pinfo then StaticPropSetOp(pinfo) else InstancePropSetOp(pinfo)) - | 43 -> u_tup2 u_NamedType u_string st |> (fun (a, b) tyargs -> let finfo = bindField(a, b, tyargs) in if finfo.IsStatic then StaticFieldSetOp(finfo) else InstanceFieldSetOp(finfo)) + | 40 -> u_void st |> (fun () (OneTyArg ty) -> ValueOp(null, ty, None)) + | 41 -> u_void st |> (fun () (OneTyArg ty) -> DefaultValueOp ty) + | 42 -> u_PropInfoData st |> (fun (a, b, c, d) tyargs -> let pinfo = bindProp(a, b, c, d, tyargs) in if pinfoIsStatic pinfo then StaticPropSetOp pinfo else InstancePropSetOp pinfo) + | 43 -> u_tup2 u_NamedType u_string st |> (fun (a, b) tyargs -> let finfo = bindField(a, b, tyargs) in if finfo.IsStatic then StaticFieldSetOp finfo else InstanceFieldSetOp finfo) | 44 -> u_void st |> (fun () NoTyArgs -> AddressOfOp) | 45 -> u_void st |> (fun () NoTyArgs -> AddressSetOp) - | 46 -> u_void st |> (fun () (OneTyArg(ty)) -> TypeTestOp(ty)) + | 46 -> u_void st |> (fun () (OneTyArg ty) -> TypeTestOp ty) | 47 -> u_void st |> (fun () NoTyArgs -> TryFinallyOp) | 48 -> u_void st |> (fun () NoTyArgs -> TryWithOp) | 49 -> u_void st |> (fun () NoTyArgs -> VarSetOp) @@ -1664,11 +1664,11 @@ module Patterns = else raise (Clash(clashes.MinimumElement)) | LambdaTerm (v, b) -> try EA(LambdaTerm(v, substituteInExpr (Set.add v bvs) tmsubst b), e.CustomAttributes) - with Clash(bv) -> + with Clash bv -> if v = bv then let v2 = new Var(v.Name, v.Type) - let v2exp = E(VarTerm(v2)) - EA(LambdaTerm(v2, substituteInExpr bvs (fun v -> if v = bv then Some(v2exp) else tmsubst v) b), e.CustomAttributes) + let v2exp = E(VarTerm v2) + EA(LambdaTerm(v2, substituteInExpr bvs (fun v -> if v = bv then Some v2exp else tmsubst v) b), e.CustomAttributes) else reraise() | HoleTerm _ -> e @@ -1733,9 +1733,9 @@ module Patterns = let candidates : MethodBase[] = downcast ( if mb.IsConstructor then - box (declaringType.GetConstructors(bindingFlags)) + box (declaringType.GetConstructors bindingFlags) else - box (declaringType.GetMethods(bindingFlags)) + box (declaringType.GetMethods bindingFlags) ) candidates |> Array.filter (fun c -> c.Name = mb.Name && @@ -1830,7 +1830,7 @@ module Patterns = defns |> List.iter (fun (minfo, exprBuilder) -> let key = ReflectedDefinitionTableKey.GetKey minfo lock reflectedDefinitionTable (fun () -> - reflectedDefinitionTable.Add(key, Entry(exprBuilder)))) + reflectedDefinitionTable.Add(key, Entry exprBuilder))) decodedTopResources.Add((assem, resourceName), 0) let tryGetReflectedDefinition (methodBase: MethodBase, tyargs: Type []) = @@ -1838,7 +1838,7 @@ module Patterns = let data = let assem = methodBase.DeclaringType.Assembly let key = ReflectedDefinitionTableKey.GetKey methodBase - let ok, res = lock reflectedDefinitionTable (fun () -> reflectedDefinitionTable.TryGetValue(key)) + let ok, res = lock reflectedDefinitionTable (fun () -> reflectedDefinitionTable.TryGetValue key) if ok then Some res else @@ -1866,7 +1866,7 @@ module Patterns = match ca with | :? CompilationMappingAttribute as cma when cma.ResourceName = resourceName -> Some cma | _ -> None) - let resourceBytes = readToEnd (assem.GetManifestResourceStream(resourceName)) + let resourceBytes = readToEnd (assem.GetManifestResourceStream resourceName) let referencedTypes = match cmaAttribForResource with | None -> [| |] @@ -1877,20 +1877,20 @@ module Patterns = let ok, res = lock reflectedDefinitionTable (fun () -> // check another thread didn't get in first - if not (reflectedDefinitionTable.ContainsKey(key)) then + if not (reflectedDefinitionTable.ContainsKey key) then qdataResources |> List.iter (fun (resourceName, defns) -> defns |> List.iter (fun (methodBase, exprBuilder) -> - reflectedDefinitionTable.[ReflectedDefinitionTableKey.GetKey methodBase] <- Entry(exprBuilder)) + reflectedDefinitionTable.[ReflectedDefinitionTableKey.GetKey methodBase] <- Entry exprBuilder) decodedTopResources.Add((assem, resourceName), 0)) // we know it's in the table now, if it's ever going to be there - reflectedDefinitionTable.TryGetValue(key) + reflectedDefinitionTable.TryGetValue key ) if ok then Some res else None match data with - | Some (Entry(exprBuilder)) -> + | Some (Entry exprBuilder) -> let expectedNumTypars = getNumGenericArguments(methodBase.DeclaringType) + (match methodBase with @@ -2076,8 +2076,8 @@ type Expr with mkValueWithDefn (value, expressionType, definition) - static member Var(variable) = - mkVar(variable) + static member Var variable = + mkVar variable static member VarSet (variable, value:Expr) = mkVarSet (variable, value) @@ -2087,7 +2087,7 @@ type Expr with static member TryGetReflectedDefinition(methodBase:MethodBase) = checkNonNull "methodBase" methodBase - tryGetReflectedDefinitionInstantiated(methodBase) + tryGetReflectedDefinitionInstantiated methodBase static member Cast(source:Expr) = cast source @@ -2105,7 +2105,7 @@ type Expr with deserialize (qualifyingType, referencedTypes, spliceTypes, spliceExprs, bytes) static member RegisterReflectedDefinitions(assembly, resource, serializedValue) = - Expr.RegisterReflectedDefinitions(assembly, resource, serializedValue, [| |]) + Expr.RegisterReflectedDefinitions (assembly, resource, serializedValue, [| |]) static member RegisterReflectedDefinitions(assembly, resource, serializedValue, referencedTypes) = checkNonNull "assembly" assembly @@ -2113,38 +2113,38 @@ type Expr with static member GlobalVar<'T>(name) : Expr<'T> = checkNonNull "name" name - Expr.Var(Var.Global(name, typeof<'T>)) |> Expr.Cast + Expr.Var (Var.Global(name, typeof<'T>)) |> Expr.Cast [] module DerivedPatterns = open Patterns [] - let (|Bool|_|) input = match input with ValueObj(:? bool as v) -> Some(v) | _ -> None + let (|Bool|_|) input = match input with ValueObj(:? bool as v) -> Some v | _ -> None [] - let (|String|_|) input = match input with ValueObj(:? string as v) -> Some(v) | _ -> None + let (|String|_|) input = match input with ValueObj(:? string as v) -> Some v | _ -> None [] - let (|Single|_|) input = match input with ValueObj(:? single as v) -> Some(v) | _ -> None + let (|Single|_|) input = match input with ValueObj(:? single as v) -> Some v | _ -> None [] - let (|Double|_|) input = match input with ValueObj(:? double as v) -> Some(v) | _ -> None + let (|Double|_|) input = match input with ValueObj(:? double as v) -> Some v | _ -> None [] - let (|Char|_|) input = match input with ValueObj(:? char as v) -> Some(v) | _ -> None + let (|Char|_|) input = match input with ValueObj(:? char as v) -> Some v | _ -> None [] - let (|SByte|_|) input = match input with ValueObj(:? sbyte as v) -> Some(v) | _ -> None + let (|SByte|_|) input = match input with ValueObj(:? sbyte as v) -> Some v | _ -> None [] - let (|Byte|_|) input = match input with ValueObj(:? byte as v) -> Some(v) | _ -> None + let (|Byte|_|) input = match input with ValueObj(:? byte as v) -> Some v | _ -> None [] - let (|Int16|_|) input = match input with ValueObj(:? int16 as v) -> Some(v) | _ -> None + let (|Int16|_|) input = match input with ValueObj(:? int16 as v) -> Some v | _ -> None [] - let (|UInt16|_|) input = match input with ValueObj(:? uint16 as v) -> Some(v) | _ -> None + let (|UInt16|_|) input = match input with ValueObj(:? uint16 as v) -> Some v | _ -> None [] - let (|Int32|_|) input = match input with ValueObj(:? int32 as v) -> Some(v) | _ -> None + let (|Int32|_|) input = match input with ValueObj(:? int32 as v) -> Some v | _ -> None [] - let (|UInt32|_|) input = match input with ValueObj(:? uint32 as v) -> Some(v) | _ -> None + let (|UInt32|_|) input = match input with ValueObj(:? uint32 as v) -> Some v | _ -> None [] - let (|Int64|_|) input = match input with ValueObj(:? int64 as v) -> Some(v) | _ -> None + let (|Int64|_|) input = match input with ValueObj(:? int64 as v) -> Some v | _ -> None [] - let (|UInt64|_|) input = match input with ValueObj(:? uint64 as v) -> Some(v) | _ -> None + let (|UInt64|_|) input = match input with ValueObj(:? uint64 as v) -> Some v | _ -> None [] let (|Unit|_|) input = match input with Comb0(ValueOp(_, ty, None)) when ty = typeof -> Some() | _ -> None @@ -2154,7 +2154,7 @@ module DerivedPatterns = /// Strip off the 'let' bindings for an TupledLambda let rec stripSuccessiveProjLets (p:Var) n expr = match expr with - | Let(v1, TupleGet(Var(pA), m), rest) + | Let(v1, TupleGet(Var pA, m), rest) when p = pA && m = n-> let restvs, b = stripSuccessiveProjLets p (n+1) rest v1::restvs, b @@ -2171,7 +2171,7 @@ module DerivedPatterns = | Application(f, x) -> match x with | Unit -> Some(f, []) - | NewTuple(x) -> Some(f, x) + | NewTuple x -> Some(f, x) | x -> Some(f, [x]) | _ -> None @@ -2183,13 +2183,13 @@ module DerivedPatterns = [] let (|AndAlso|_|) input = match input with - | IfThenElse(x, y, Bool(false)) -> Some(x, y) + | IfThenElse(x, y, Bool false) -> Some(x, y) | _ -> None [] let (|OrElse|_|) input = match input with - | IfThenElse(x, Bool(true), y) -> Some(x, y) + | IfThenElse(x, Bool true, y) -> Some(x, y) | _ -> None [] @@ -2235,15 +2235,15 @@ module DerivedPatterns = [] let (|MethodWithReflectedDefinition|_|) (methodBase) = - Expr.TryGetReflectedDefinition(methodBase) + Expr.TryGetReflectedDefinition methodBase [] let (|PropertyGetterWithReflectedDefinition|_|) (propertyInfo:System.Reflection.PropertyInfo) = - Expr.TryGetReflectedDefinition(propertyInfo.GetGetMethod(true)) + Expr.TryGetReflectedDefinition (propertyInfo.GetGetMethod true) [] let (|PropertySetterWithReflectedDefinition|_|) (propertyInfo:System.Reflection.PropertyInfo) = - Expr.TryGetReflectedDefinition(propertyInfo.GetSetMethod(true)) + Expr.TryGetReflectedDefinition (propertyInfo.GetSetMethod true) [] module ExprShape = @@ -2255,33 +2255,33 @@ module ExprShape = match op, arguments with | AppOp, [f;x] -> mkApplication(f, x) | IfThenElseOp, [g;t;e] -> mkIfThenElse(g, t, e) - | LetRecOp, [e1] -> mkLetRecRaw(e1) - | LetRecCombOp, _ -> mkLetRecCombRaw(arguments) + | LetRecOp, [e1] -> mkLetRecRaw e1 + | LetRecCombOp, _ -> mkLetRecCombRaw arguments | LetOp, [e1;e2] -> mkLetRawWithCheck(e1, e2) - | NewRecordOp(ty), _ -> mkNewRecord(ty, arguments) - | NewUnionCaseOp(unionCase), _ -> mkNewUnionCase(unionCase, arguments) - | UnionCaseTestOp(unionCase), [arg] -> mkUnionCaseTest(unionCase, arg) - | NewTupleOp(ty), _ -> mkNewTupleWithType(ty, arguments) + | NewRecordOp ty, _ -> mkNewRecord(ty, arguments) + | NewUnionCaseOp unionCase, _ -> mkNewUnionCase(unionCase, arguments) + | UnionCaseTestOp unionCase, [arg] -> mkUnionCaseTest(unionCase, arg) + | NewTupleOp ty, _ -> mkNewTupleWithType(ty, arguments) | TupleGetOp(ty, i), [arg] -> mkTupleGet(ty, i, arg) - | InstancePropGetOp(pinfo), (obj::args) -> mkInstancePropGet(obj, pinfo, args) - | StaticPropGetOp(pinfo), _ -> mkStaticPropGet(pinfo, arguments) - | InstancePropSetOp(pinfo), obj::(FrontAndBack(args, v)) -> mkInstancePropSet(obj, pinfo, args, v) - | StaticPropSetOp(pinfo), (FrontAndBack(args, v)) -> mkStaticPropSet(pinfo, args, v) - | InstanceFieldGetOp(finfo), [obj] -> mkInstanceFieldGet(obj, finfo) - | StaticFieldGetOp(finfo), [] -> mkStaticFieldGet(finfo ) - | InstanceFieldSetOp(finfo), [obj;v] -> mkInstanceFieldSet(obj, finfo, v) - | StaticFieldSetOp(finfo), [v] -> mkStaticFieldSet(finfo, v) + | InstancePropGetOp pinfo, (obj::args) -> mkInstancePropGet(obj, pinfo, args) + | StaticPropGetOp pinfo, _ -> mkStaticPropGet(pinfo, arguments) + | InstancePropSetOp pinfo, obj::(FrontAndBack(args, v)) -> mkInstancePropSet(obj, pinfo, args, v) + | StaticPropSetOp pinfo, (FrontAndBack(args, v)) -> mkStaticPropSet(pinfo, args, v) + | InstanceFieldGetOp finfo, [obj] -> mkInstanceFieldGet(obj, finfo) + | StaticFieldGetOp finfo, [] -> mkStaticFieldGet(finfo ) + | InstanceFieldSetOp finfo, [obj;v] -> mkInstanceFieldSet(obj, finfo, v) + | StaticFieldSetOp finfo, [v] -> mkStaticFieldSet(finfo, v) | NewObjectOp minfo, _ -> mkCtorCall(minfo, arguments) - | DefaultValueOp(ty), _ -> mkDefaultValue(ty) - | StaticMethodCallOp(minfo), _ -> mkStaticMethodCall(minfo, arguments) - | InstanceMethodCallOp(minfo), obj::args -> mkInstanceMethodCall(obj, minfo, args) - | CoerceOp(ty), [arg] -> mkCoerce(ty, arg) - | NewArrayOp(ty), _ -> mkNewArray(ty, arguments) - | NewDelegateOp(ty), [arg] -> mkNewDelegate(ty, arg) + | DefaultValueOp ty, _ -> mkDefaultValue ty + | StaticMethodCallOp minfo, _ -> mkStaticMethodCall(minfo, arguments) + | InstanceMethodCallOp minfo, obj::args -> mkInstanceMethodCall(obj, minfo, args) + | CoerceOp ty, [arg] -> mkCoerce(ty, arg) + | NewArrayOp ty, _ -> mkNewArray(ty, arguments) + | NewDelegateOp ty, [arg] -> mkNewDelegate(ty, arg) | SequentialOp, [e1;e2] -> mkSequential(e1, e2) - | TypeTestOp(ty), [e1] -> mkTypeTest(e1, ty) - | AddressOfOp, [e1] -> mkAddressOf(e1) - | VarSetOp, [E(VarTerm(v)); e] -> mkVarSet(v, e) + | TypeTestOp ty, [e1] -> mkTypeTest(e1, ty) + | AddressOfOp, [e1] -> mkAddressOf e1 + | VarSetOp, [E(VarTerm v); e] -> mkVarSet(v, e) | AddressSetOp, [e1;e2] -> mkAddressSet(e1, e2) | ForIntegerRangeLoopOp, [e1;e2;E(LambdaTerm(v, e3))] -> mkForLoop(v, e1, e2, e3) | WhileLoopOp, [e1;e2] -> mkWhileLoop(e1, e2) @@ -2299,9 +2299,9 @@ module ExprShape = [] let rec (|ShapeVar|ShapeLambda|ShapeCombination|) input = let rec loop expr = - let (E(t)) = expr + let (E t) = expr match t with - | VarTerm v -> ShapeVar(v) + | VarTerm v -> ShapeVar v | LambdaTerm(v, b) -> ShapeLambda(v, b) | CombTerm(op, args) -> ShapeCombination(box (op, expr.CustomAttributes), args) | HoleTerm _ -> invalidArg "expr" (SR.GetString(SR.QunexpectedHole)) diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 14b56e5b4..2024be205 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -42,11 +42,11 @@ module internal Impl = let isNamedType(typ: Type) = not (typ.IsArray || typ.IsByRef || typ.IsPointer) let equivHeadTypes (ty1: Type) (ty2: Type) = - isNamedType(ty1) && + isNamedType ty1 && if ty1.IsGenericType then ty2.IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(ty2.GetGenericTypeDefinition()) else - ty1.Equals(ty2) + ty1.Equals ty2 let func = typedefof<(obj -> obj)> @@ -156,7 +156,7 @@ module internal Impl = let sortFreshArray f arr = Array.sortInPlaceWith f arr; arr let isFieldProperty (prop : PropertyInfo) = - match tryFindCompilationMappingAttributeFromMemberInfo(prop) with + match tryFindCompilationMappingAttributeFromMemberInfo prop with | None -> false | Some (flags, _n, _vn) -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Field @@ -185,7 +185,7 @@ module internal Impl = | null -> typ.GetMethods(staticMethodFlags ||| bindingFlags) |> Array.choose (fun minfo -> - match tryFindCompilationMappingAttributeFromMemberInfo(minfo) with + match tryFindCompilationMappingAttributeFromMemberInfo minfo with | None -> None | Some (flags, n, _vn) -> if (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.UnionCase then @@ -203,8 +203,8 @@ module internal Impl = | _ -> enumTyp.GetFields(staticFieldFlags ||| bindingFlags) |> Array.filter (fun (f: FieldInfo) -> f.IsStatic && f.IsLiteral) - |> sortFreshArray (fun f1 f2 -> compare (f1.GetValue (null) :?> int) (f2.GetValue (null) :?> int)) - |> Array.map (fun tagfield -> (tagfield.GetValue (null) :?> int), tagfield.Name) + |> sortFreshArray (fun f1 f2 -> compare (f1.GetValue null :?> int) (f2.GetValue null :?> int)) + |> Array.map (fun tagfield -> (tagfield.GetValue null :?> int), tagfield.Name) let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) = let tagFields = getUnionTypeTagNameMap(typ, bindingFlags) @@ -244,11 +244,11 @@ module internal Impl = isListType typ || match tryFindSourceConstructFlagsOfType typ with | None -> false - | Some(flags) -> + | Some flags -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.SumType && // We see private representations only if BindingFlags.NonPublic is set - (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum(0) then - (bindingFlags &&& BindingFlags.NonPublic) <> enum(0) + (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum 0 then + (bindingFlags &&& BindingFlags.NonPublic) <> enum 0 else true) @@ -427,26 +427,26 @@ module internal Impl = | _ -> invalidArg "tys" (SR.GetString (SR.invalidTupleTypes)) let tables = if isStruct then valueTupleTypes else refTupleTypes - match lock dictionaryLock (fun () -> tables.TryGetValue(asm)) with + match lock dictionaryLock (fun () -> tables.TryGetValue asm) with | false, _ -> // the Dictionary<>s here could be ConcurrentDictionary<>'s, but then // that would lock while initializing the Type array (maybe not an issue) let a = ref (Array.init 8 (fun i -> makeIt (i + 1))) lock dictionaryLock (fun () -> - match tables.TryGetValue(asm) with + match tables.TryGetValue asm with | true, t -> a := t | false, _ -> tables.Add(asm, !a)) !a | true, t -> t match tys.Length with - | 1 -> table.[0].MakeGenericType(tys) - | 2 -> table.[1].MakeGenericType(tys) - | 3 -> table.[2].MakeGenericType(tys) - | 4 -> table.[3].MakeGenericType(tys) - | 5 -> table.[4].MakeGenericType(tys) - | 6 -> table.[5].MakeGenericType(tys) - | 7 -> table.[6].MakeGenericType(tys) + | 1 -> table.[0].MakeGenericType tys + | 2 -> table.[1].MakeGenericType tys + | 3 -> table.[2].MakeGenericType tys + | 4 -> table.[3].MakeGenericType tys + | 5 -> table.[4].MakeGenericType tys + | 6 -> table.[5].MakeGenericType tys + | 7 -> table.[6].MakeGenericType tys | n when n >= maxTuple -> let tysA = tys.[0..tupleEncField-1] let tysB = tys.[maxTuple-1..] @@ -534,7 +534,7 @@ module internal Impl = let ctor = getTupleConstructorMethod typ (fun (args: obj[]) -> #if FX_RESHAPED_REFLECTION - ctor.Invoke(args)) + ctor.Invoke args) #else ctor.Invoke(BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public, null, args, null)) #endif @@ -545,7 +545,7 @@ module internal Impl = let reader = if typ.IsValueType then let fields = (typ.GetFields (instanceFieldFlags ||| BindingFlags.Public) |> orderTupleFields) - ((fun (obj: obj) -> fields |> Array.map (fun field -> field.GetValue (obj)))) + ((fun (obj: obj) -> fields |> Array.map (fun field -> field.GetValue obj))) else let props = (typ.GetProperties (instancePropertyFlags ||| BindingFlags.Public) |> orderTupleProperties) ((fun (obj: obj) -> props |> Array.map (fun prop -> prop.GetValue (obj, null)))) @@ -553,7 +553,7 @@ module internal Impl = then reader else let tyBenc = etys.[tupleEncField] - let reader2 = getTupleReader(tyBenc) + let reader2 = getTupleReader tyBenc (fun obj -> let directVals = reader obj let encVals = reader2 directVals.[tupleEncField] @@ -566,7 +566,7 @@ module internal Impl = then maker1 else let tyBenc = etys.[tupleEncField] - let maker2 = getTupleConstructor(tyBenc) + let maker2 = getTupleConstructor tyBenc (fun (args: obj[]) -> let encVal = maker2 args.[tupleEncField..] maker1 (Array.append args.[0..tupleEncField-1] [| encVal |])) @@ -610,7 +610,7 @@ module internal Impl = let isModuleType (typ: Type) = match tryFindSourceConstructFlagsOfType typ with | None -> false - | Some(flags) -> + | Some flags -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Module let rec isClosureRepr typ = @@ -620,11 +620,11 @@ module internal Impl = let isRecordType (typ: Type, bindingFlags: BindingFlags) = match tryFindSourceConstructFlagsOfType typ with | None -> false - | Some(flags) -> + | Some flags -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.RecordType && // We see private representations only if BindingFlags.NonPublic is set - (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum(0) then - (bindingFlags &&& BindingFlags.NonPublic) <> enum(0) + (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum 0 then + (bindingFlags &&& BindingFlags.NonPublic) <> enum 0 else true) @@ -653,7 +653,7 @@ module internal Impl = let ctor = getRecordConstructorMethod(typ, bindingFlags) (fun (args: obj[]) -> #if FX_RESHAPED_REFLECTION - ctor.Invoke(args)) + ctor.Invoke args) #else ctor.Invoke(BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| bindingFlags, null, args, null)) #endif @@ -664,11 +664,11 @@ module internal Impl = let isExceptionRepr (typ: Type, bindingFlags) = match tryFindSourceConstructFlagsOfType typ with | None -> false - | Some(flags) -> + | Some flags -> ((flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Exception) && // We see private representations only if BindingFlags.NonPublic is set - (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum(0) then - (bindingFlags &&& BindingFlags.NonPublic) <> enum(0) + (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum 0 then + (bindingFlags &&& BindingFlags.NonPublic) <> enum 0 else true) @@ -730,9 +730,9 @@ type UnionCaseInfo(typ: System.Type, tag: int) = fieldsPropsOfUnionCase (typ, tag, BindingFlags.Public ||| BindingFlags.NonPublic) member __.GetCustomAttributes() = - getMethInfo().GetCustomAttributes(false) + getMethInfo().GetCustomAttributes false - member __.GetCustomAttributes(attributeType) = + member __.GetCustomAttributes attributeType = getMethInfo().GetCustomAttributes(attributeType, false) member __.GetCustomAttributesData() = @@ -890,7 +890,7 @@ type FSharpValue = let domain, range = getFunctionTypeInfo functionType let dynCloMakerTy = typedefof> let saverTy = dynCloMakerTy.MakeGenericType [| domain; range |] - let o = Activator.CreateInstance(saverTy) + let o = Activator.CreateInstance saverTy let (f : (obj -> obj) -> obj) = downcast o f implementation diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index a5b6fd343..bb2e988a6 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -82,7 +82,7 @@ namespace Microsoft.FSharp.Collections } let mapi f (e : IEnumerator<_>) : IEnumerator<_> = - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt f let i = ref (-1) upcast { new MapEnumerator<_>() with @@ -97,7 +97,7 @@ namespace Microsoft.FSharp.Collections } let map2 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) : IEnumerator<_>= - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt f upcast { new MapEnumerator<_>() with member this.DoMoveNext curr = @@ -116,7 +116,7 @@ namespace Microsoft.FSharp.Collections } let mapi2 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) : IEnumerator<_> = - let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) + let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt f let i = ref (-1) upcast { new MapEnumerator<_>() with @@ -135,7 +135,7 @@ namespace Microsoft.FSharp.Collections } let map3 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) (e3 : IEnumerator<_>) : IEnumerator<_> = - let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) + let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt f upcast { new MapEnumerator<_>() with member this.DoMoveNext curr = @@ -308,8 +308,8 @@ namespace Microsoft.FSharp.Collections //System.Console.WriteLine("{0}.appG", box g) let res = g.Apply() match res with - | Goto(next) -> - Goto(next) + | Goto next -> + Goto next | Yield _ -> res | Stop -> @@ -384,7 +384,7 @@ namespace Microsoft.FSharp.Collections let mutable finished = false member e.Generator = g interface IEnumerator<'T> with - member x.Current= match curr with Some(v) -> v | None -> raise <| System.InvalidOperationException (SR.GetString(SR.moveNextNotCalledOrFinished)) + member x.Current= match curr with Some v -> v | None -> raise <| System.InvalidOperationException (SR.GetString(SR.moveNextNotCalledOrFinished)) interface System.Collections.IEnumerator with member x.Current = box (x :> IEnumerator<_>).Current member x.MoveNext() = @@ -394,10 +394,10 @@ namespace Microsoft.FSharp.Collections curr <- None finished <- true false - | Yield(v) -> - curr <- Some(v) + | Yield v -> + curr <- Some v true - | Goto(next) -> + | Goto next -> (g <- next) (x :> IEnumerator).MoveNext()) member x.Reset() = IEnumerator.noReset() @@ -509,7 +509,7 @@ namespace Microsoft.FSharp.Collections let iteri action (source : seq<'T>) = checkNonNull "source" source use e = source.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(action) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt action let mutable i = 0 while e.MoveNext() do f.Invoke(i, e.Current) @@ -548,7 +548,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source2" source2 use e1 = source1.GetEnumerator() use e2 = source2.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(action) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt action while (e1.MoveNext() && e2.MoveNext()) do f.Invoke(e1.Current, e2.Current) @@ -558,7 +558,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source2" source2 use e1 = source1.GetEnumerator() use e2 = source2.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(action) + let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt action let mutable i = 0 while (e1.MoveNext() && e2.MoveNext()) do f.Invoke(i, e1.Current, e2.Current) @@ -659,7 +659,7 @@ namespace Microsoft.FSharp.Collections let mutable res = None 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 [] @@ -717,7 +717,7 @@ namespace Microsoft.FSharp.Collections let fold<'T,'State> folder (state:'State) (source : seq<'T>) = checkNonNull "source" source use e = source.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(folder) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt folder let mutable state = state while e.MoveNext() do state <- f.Invoke(state, e.Current) @@ -731,7 +731,7 @@ namespace Microsoft.FSharp.Collections use e1 = source1.GetEnumerator() use e2 = source2.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(folder) + let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt folder let mutable state = state while e1.MoveNext() && e2.MoveNext() do @@ -744,7 +744,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source" source use e = source.GetEnumerator() if not (e.MoveNext()) then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(reduction) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt reduction let mutable state = e.Current while e.MoveNext() do state <- f.Invoke(state, e.Current) @@ -773,7 +773,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source2" source2 use e1 = source1.GetEnumerator() use e2 = source2.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(comparer) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt comparer let rec go () = let e1ok = e1.MoveNext() let e2ok = e2.MoveNext() @@ -826,7 +826,7 @@ namespace Microsoft.FSharp.Collections [] let foldBack<'T,'State> folder (source : seq<'T>) (state:'State) = checkNonNull "source" source - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(folder) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt folder let arr = toArray source let len = arr.Length foldArraySubRight f arr 0 (len - 1) state @@ -843,7 +843,7 @@ namespace Microsoft.FSharp.Collections match arr.Length with | 0 -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | len -> - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(reduction) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt reduction foldArraySubRight f arr 0 (len - 2) arr.[len - 1] [] @@ -873,7 +873,7 @@ namespace Microsoft.FSharp.Collections [] let scan<'T,'State> folder (state:'State) (source : seq<'T>) = checkNonNull "source" source - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(folder) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt folder seq { let zref = ref state yield !zref use ie = source.GetEnumerator() @@ -1087,7 +1087,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source" source seq { let hashSet = HashSet<'T>(HashIdentity.Structural<'T>) for v in source do - if hashSet.Add(v) then + if hashSet.Add v then yield v } [] @@ -1340,7 +1340,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source2" source2 use e1 = source1.GetEnumerator() use e2 = source2.GetEnumerator() - let p = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(predicate) + let p = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate let mutable ok = true while (ok && e1.MoveNext() && e2.MoveNext()) do ok <- p.Invoke(e1.Current, e2.Current) @@ -1352,7 +1352,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source2" source2 use e1 = source1.GetEnumerator() use e2 = source2.GetEnumerator() - let p = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(predicate) + let p = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate let mutable ok = false while (not ok && e1.MoveNext() && e2.MoveNext()) do ok <- p.Invoke(e1.Current, e2.Current) diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index 9ab21f29f..c23805add 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -20,7 +20,7 @@ type SetTree<'T> when 'T: comparison = | SetEmpty // height = 0 | SetNode of 'T * SetTree<'T> * SetTree<'T> * int // height = int | SetOne of 'T // height = 1 - // OPTIMIZATION: store SetNode (k, SetEmpty, SetEmpty, 1) ---> SetOne (k) + // OPTIMIZATION: store SetNode (k, SetEmpty, SetEmpty, 1) ---> SetOne k [] module internal SetTree = @@ -94,7 +94,7 @@ module internal SetTree = let mk l k r = match l, r with - | SetEmpty, SetEmpty -> SetOne (k) + | SetEmpty, SetEmpty -> SetOne k | _ -> let hl = height l let hr = height r @@ -198,7 +198,7 @@ module internal SetTree = let rec spliceOutSuccessor t = match t with | SetEmpty -> failwith "internal error: Set.spliceOutSuccessor" - | SetOne (k2) -> k2, SetEmpty + | SetOne k2 -> k2, SetEmpty | SetNode (k2, l, r, _) -> match l with | SetEmpty -> k2, r @@ -207,7 +207,7 @@ module internal SetTree = let rec remove (comparer: IComparer<'T>) k t = match t with | SetEmpty -> t - | SetOne (k2) -> + | SetOne k2 -> let c = comparer.Compare(k, k2) if c = 0 then SetEmpty else t @@ -230,22 +230,22 @@ module internal SetTree = if c < 0 then mem comparer k l elif c = 0 then true else mem comparer k r - | SetOne (k2) -> (comparer.Compare(k, k2) = 0) + | SetOne k2 -> (comparer.Compare(k, k2) = 0) | SetEmpty -> false let rec iter f t = match t with | SetNode (k2, l, r, _) -> iter f l; f k2; iter f r - | SetOne (k2) -> f k2 + | SetOne k2 -> f k2 | SetEmpty -> () let rec foldBackOpt (f:OptimizedClosures.FSharpFunc<_, _, _>) m x = match m with | SetNode (k, l, r, _) -> foldBackOpt f l (f.Invoke(k, (foldBackOpt f r x))) - | SetOne (k) -> f.Invoke(k, x) + | SetOne k -> f.Invoke(k, x) | SetEmpty -> x - let foldBack f m x = foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) m x + let foldBack f m x = foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m x let rec foldOpt (f:OptimizedClosures.FSharpFunc<_, _, _>) x m = match m with @@ -253,21 +253,21 @@ module internal SetTree = let x = foldOpt f x l in let x = f.Invoke(x, k) foldOpt f x r - | SetOne (k) -> f.Invoke(x, k) + | SetOne k -> f.Invoke(x, k) | SetEmpty -> x - let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f)) x m + let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) x m let rec forall f m = match m with | SetNode (k2, l, r, _) -> f k2 && forall f l && forall f r - | SetOne (k2) -> f k2 + | SetOne k2 -> f k2 | SetEmpty -> true let rec exists f m = match m with | SetNode (k2, l, r, _) -> f k2 || exists f l || exists f r - | SetOne (k2) -> f k2 + | SetOne k2 -> f k2 | SetEmpty -> false let isEmpty m = match m with | SetEmpty -> true | _ -> false @@ -283,7 +283,7 @@ module internal SetTree = | SetNode (k, l, r, _) -> let acc = if f k then add comparer k acc else acc filterAux comparer f l (filterAux comparer f r acc) - | SetOne (k) -> if f k then add comparer k acc else acc + | SetOne k -> if f k then add comparer k acc else acc | SetEmpty -> acc let filter comparer f s = filterAux comparer f s SetEmpty @@ -294,7 +294,7 @@ module internal SetTree = | _ -> match m with | SetNode (k, l, r, _) -> diffAux comparer l (diffAux comparer r (remove comparer k acc)) - | SetOne (k) -> remove comparer k acc + | SetOne k -> remove comparer k acc | SetEmpty -> acc let diff comparer a b = diffAux comparer b a @@ -324,7 +324,7 @@ module internal SetTree = let acc = intersectionAux comparer b r acc let acc = if mem comparer k b then add comparer k acc else acc intersectionAux comparer b l acc - | SetOne (k) -> + | SetOne k -> if mem comparer k b then add comparer k acc else acc | SetEmpty -> acc @@ -338,7 +338,7 @@ module internal SetTree = let acc = partitionAux comparer f r acc let acc = partition1 comparer f k acc partitionAux comparer f l acc - | SetOne (k) -> partition1 comparer f k acc + | SetOne k -> partition1 comparer f k acc | SetEmpty -> acc let partition comparer f s = partitionAux comparer f s (SetEmpty, SetEmpty) @@ -347,41 +347,41 @@ module internal SetTree = let (|MatchSetNode|MatchSetEmpty|) s = match s with | SetNode (k2, l, r, _) -> MatchSetNode(k2, l, r) - | SetOne (k2) -> MatchSetNode(k2, SetEmpty, SetEmpty) + | SetOne k2 -> MatchSetNode(k2, SetEmpty, SetEmpty) | SetEmpty -> MatchSetEmpty let rec minimumElementAux s n = match s with | SetNode (k, l, _, _) -> minimumElementAux l k - | SetOne (k) -> k + | SetOne k -> k | SetEmpty -> n and minimumElementOpt s = match s with | SetNode (k, l, _, _) -> Some(minimumElementAux l k) - | SetOne (k) -> Some k + | SetOne k -> Some k | SetEmpty -> None and maximumElementAux s n = match s with | SetNode (k, _, r, _) -> maximumElementAux r k - | SetOne (k) -> k + | SetOne k -> k | SetEmpty -> n and maximumElementOpt s = match s with | SetNode (k, _, r, _) -> Some(maximumElementAux r k) - | SetOne (k) -> Some(k) + | SetOne k -> Some k | SetEmpty -> None let minimumElement s = match minimumElementOpt s with - | Some(k) -> k + | Some k -> k | None -> invalidArg "s" (SR.GetString(SR.setContainsNoElements)) let maximumElement s = match maximumElementOpt s with - | Some(k) -> k + | Some k -> k | None -> invalidArg "s" (SR.GetString(SR.setContainsNoElements)) // Imperative left-to-right iterators. @@ -446,24 +446,24 @@ module internal SetTree = | [], _ -> -1 | _, [] -> 1 | (SetEmpty _ :: t1), (SetEmpty :: t2) -> compareStacks comparer t1 t2 - | (SetOne (n1k) :: t1), (SetOne (n2k) :: t2) -> + | (SetOne n1k :: t1), (SetOne n2k :: t2) -> let c = comparer.Compare(n1k, n2k) if c <> 0 then c else compareStacks comparer t1 t2 - | (SetOne (n1k) :: t1), (SetNode (n2k, SetEmpty, n2r, _) :: t2) -> + | (SetOne n1k :: t1), (SetNode (n2k, SetEmpty, n2r, _) :: t2) -> let c = comparer.Compare(n1k, n2k) if c <> 0 then c else compareStacks comparer (SetEmpty :: t1) (n2r :: t2) - | (SetNode (n1k, (SetEmpty as emp), n1r, _) :: t1), (SetOne (n2k) :: t2) -> + | (SetNode (n1k, (SetEmpty as emp), n1r, _) :: t1), (SetOne n2k :: t2) -> let c = comparer.Compare(n1k, n2k) if c <> 0 then c else compareStacks comparer (n1r :: t1) (emp :: t2) | (SetNode (n1k, SetEmpty, n1r, _) :: t1), (SetNode (n2k, SetEmpty, n2r, _) :: t2) -> let c = comparer.Compare(n1k, n2k) if c <> 0 then c else compareStacks comparer (n1r :: t1) (n2r :: t2) - | (SetOne (n1k) :: t1), _ -> - compareStacks comparer (SetEmpty :: SetOne (n1k) :: t1) l2 + | (SetOne n1k :: t1), _ -> + compareStacks comparer (SetEmpty :: SetOne n1k :: t1) l2 | (SetNode (n1k, n1l, n1r, _) :: t1), _ -> compareStacks comparer (n1l :: SetNode (n1k, SetEmpty, n1r, 0) :: t1) l2 - | _, (SetOne (n2k) :: t2) -> - compareStacks comparer l1 (SetEmpty :: SetOne (n2k) :: t2) + | _, (SetOne n2k :: t2) -> + compareStacks comparer l1 (SetEmpty :: SetOne n2k :: t2) | _, (SetNode (n2k, n2l, n2r, _) :: t2) -> compareStacks comparer l1 (n2l :: SetNode (n2k, SetEmpty, n2r, 0) :: t2) @@ -481,7 +481,7 @@ module internal SetTree = let rec loop m acc = match m with | SetNode (k, l, r, _) -> loop l (k :: loop r acc) - | SetOne (k) -> k ::acc + | SetOne k -> k ::acc | SetEmpty -> acc loop s [] @@ -540,7 +540,7 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T #if !FX_NO_BINARY_SERIALIZATION [] member __.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = - ignore(context) + ignore context serializedData <- SetTree.toArray tree // Do not set this to null, since concurrent threads may also be serializing the data @@ -550,7 +550,7 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T [] member __.OnDeserialized(context: System.Runtime.Serialization.StreamingContext) = - ignore(context) + ignore context comparer <- LanguagePrimitives.FastGenericComparer<'T> tree <- SetTree.ofArray comparer serializedData serializedData <- null @@ -564,7 +564,7 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T [] static member Empty: Set<'T> = empty - member s.Add(value): Set<'T> = + member s.Add value: Set<'T> = #if TRACE_SETS_AND_MAPS SetTree.report() SetTree.numAdds <- SetTree.numAdds + 1 @@ -572,7 +572,7 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T #endif Set<'T>(s.Comparer, SetTree.add s.Comparer value s.Tree ) - member s.Remove(value): Set<'T> = + member s.Remove value: Set<'T> = #if TRACE_SETS_AND_MAPS SetTree.report() SetTree.numRemoves <- SetTree.numRemoves + 1 @@ -582,7 +582,7 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member s.Count = SetTree.count s.Tree - member s.Contains(value) = + member s.Contains value = #if TRACE_SETS_AND_MAPS SetTree.report() SetTree.numLookups <- SetTree.numLookups + 1 @@ -590,11 +590,11 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T #endif SetTree.mem s.Comparer value s.Tree - member s.Iterate(x) = + member s.Iterate x = SetTree.iter x s.Tree member s.Fold f z = - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f) + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt f SetTree.fold (fun x z -> f.Invoke(z, x)) z s.Tree [] @@ -697,7 +697,7 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T override this.GetHashCode() = this.ComputeHashCode() - override this.Equals(that) = + override this.Equals that = match that with | :? Set<'T> as that -> use e1 = (this :> seq<_>).GetEnumerator() @@ -713,13 +713,13 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member this.CompareTo(that: obj) = SetTree.compare this.Comparer this.Tree ((that :?> Set<'T>).Tree) interface ICollection<'T> with - member s.Add(x) = ignore(x); raise (new System.NotSupportedException("ReadOnlyCollection")) + member s.Add x = ignore x; raise (new System.NotSupportedException("ReadOnlyCollection")) member s.Clear() = raise (new System.NotSupportedException("ReadOnlyCollection")) - member s.Remove(x) = ignore(x); raise (new System.NotSupportedException("ReadOnlyCollection")) + member s.Remove x = ignore x; raise (new System.NotSupportedException("ReadOnlyCollection")) - member s.Contains(x) = SetTree.mem s.Comparer x s.Tree + member s.Contains x = SetTree.mem s.Comparer x s.Tree member s.CopyTo(arr, i) = SetTree.copyToArray s.Tree arr i @@ -736,7 +736,7 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T interface IEnumerable with override s.GetEnumerator() = (SetTree.mkIEnumerator s.Tree :> IEnumerator) - static member Singleton(x:'T) : Set<'T> = Set<'T>.Empty.Add(x) + static member Singleton(x:'T) : Set<'T> = Set<'T>.Empty.Add x new (elements : seq<'T>) = let comparer = LanguagePrimitives.FastGenericComparer<'T> @@ -784,31 +784,31 @@ module Set = let isEmpty (set: Set<'T>) = set.IsEmpty [] - let contains element (set: Set<'T>) = set.Contains(element) + let contains element (set: Set<'T>) = set.Contains element [] - let add value (set: Set<'T>) = set.Add(value) + let add value (set: Set<'T>) = set.Add value [] - let singleton value = Set<'T>.Singleton(value) + let singleton value = Set<'T>.Singleton value [] - let remove value (set: Set<'T>) = set.Remove(value) + let remove value (set: Set<'T>) = set.Remove value [] let union (set1: Set<'T>) (set2: Set<'T>) = set1 + set2 [] - let unionMany sets = Set.Union(sets) + let unionMany sets = Set.Union sets [] let intersect (set1: Set<'T>) (set2: Set<'T>) = Set<'T>.Intersection(set1, set2) [] - let intersectMany sets = Set.Intersection(sets) + let intersectMany sets = Set.Intersection sets [] - let iter action (set: Set<'T>) = set.Iterate(action) + let iter action (set: Set<'T>) = set.Iterate action [] let empty<'T when 'T : comparison> : Set<'T> = Set<'T>.Empty @@ -841,7 +841,7 @@ module Set = let ofList elements = Set(List.toSeq elements) [] - let ofArray (array: 'T array) = Set<'T>.FromArray(array) + let ofArray (array: 'T array) = Set<'T>.FromArray array [] let toList (set: Set<'T>) = set.ToList() @@ -853,7 +853,7 @@ module Set = let toSeq (set: Set<'T>) = (set:> seq<'T>) [] - let ofSeq (elements: seq<_>) = Set(elements) + let ofSeq (elements: seq<_>) = Set elements [] let difference (set1: Set<'T>) (set2: Set<'T>) = set1 - set2 diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 280a62346..ac64aa6c1 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -48,7 +48,7 @@ let rec accExpr (cenv:cenv) (env:env) expr = | Expr.Val (_v, _vFlags, _m) -> () - | Expr.Quote(ast, _, _, _m, ty) -> + | Expr.Quote (ast, _, _, _m, ty) -> accExpr cenv env ast accTy cenv env ty @@ -68,27 +68,27 @@ let rec accExpr (cenv:cenv) (env:env) expr = | Expr.Op (c, tyargs, args, m) -> accOp cenv env (c, tyargs, args, m) - | Expr.App(f, fty, tyargs, argsl, _m) -> + | Expr.App (f, fty, tyargs, argsl, _m) -> accTy cenv env fty accTypeInst cenv env tyargs accExpr cenv env f accExprs cenv env argsl - | Expr.Lambda(_, _ctorThisValOpt, _baseValOpt, argvs, _body, m, rty) -> + | Expr.Lambda (_, _ctorThisValOpt, _baseValOpt, argvs, _body, m, rty) -> let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty accLambdas cenv env topValInfo expr ty - | Expr.TyLambda(_, tps, _body, _m, rty) -> + | Expr.TyLambda (_, tps, _body, _m, rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) accTy cenv env rty let ty = mkForallTyIfNeeded tps rty accLambdas cenv env topValInfo expr ty - | Expr.TyChoose(_tps, e1, _m) -> + | Expr.TyChoose (_tps, e1, _m) -> accExpr cenv env e1 - | Expr.Match(_, _exprm, dtree, targets, m, ty) -> + | Expr.Match (_, _exprm, dtree, targets, m, ty) -> accTy cenv env ty accDTree cenv env dtree accTargets cenv env m ty targets @@ -133,7 +133,7 @@ and accOp cenv env (op, tyargs, args, _m) = accTypeInst cenv env enclTypeArgs accTypeInst cenv env methTypeArgs accTypeInst cenv env tys - | TOp.TraitCall(TTrait(tys, _nm, _, argtys, rty, _sln)) -> + | TOp.TraitCall (TTrait(tys, _nm, _, argtys, rty, _sln)) -> argtys |> accTypeInst cenv env rty |> Option.iter (accTy cenv env) tys |> List.iter (accTy cenv env) @@ -144,7 +144,7 @@ and accOp cenv env (op, tyargs, args, _m) = and accLambdas cenv env topValInfo e ety = match e with - | Expr.TyChoose(_tps, e1, _m) -> accLambdas cenv env topValInfo e1 ety + | Expr.TyChoose (_tps, e1, _m) -> accLambdas cenv env topValInfo e1 ety | Expr.Lambda _ | Expr.TyLambda _ -> let _tps, ctorThisValOpt, baseValOpt, vsl, body, bodyty = destTopLambda cenv.g cenv.amap topValInfo (e, ety) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 82fb07558..3df9afdea 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -79,7 +79,7 @@ let ChooseParamNames fieldNamesAndTypes = fieldNamesAndTypes |> List.map (fun (ilPropName, ilFieldName, ilPropType) -> let lowerPropName = String.uncapitalize ilPropName - let ilParamName = if takenFieldNames.Contains(lowerPropName) then ilPropName else lowerPropName + let ilParamName = if takenFieldNames.Contains lowerPropName then ilPropName else lowerPropName ilParamName, ilFieldName, ilPropType) /// Approximation for purposes of optimization and giving a warning when compiling definition-only files as EXEs @@ -112,11 +112,11 @@ let IsILTypeByref = function ILType.Byref _ -> true | _ -> false let mainMethName = CompilerGeneratedName "main" /// Used to query custom attributes when emitting COM interop code. -type AttributeDecoder (namedArgs) = +type AttributeDecoder(namedArgs) = let nameMap = namedArgs |> List.map (fun (AttribNamedArg(s, _, _, c)) -> s, c) |> NameMap.ofList - let findConst x = match NameMap.tryFind x nameMap with | Some(AttribExpr(_, Expr.Const(c, _, _))) -> Some c | _ -> None - let findAppTr x = match NameMap.tryFind x nameMap with | Some(AttribExpr(_, Expr.App(_, _, [TType_app(tr, _)], _, _))) -> Some tr | _ -> None + let findConst x = match NameMap.tryFind x nameMap with | Some(AttribExpr(_, Expr.Const (c, _, _))) -> Some c | _ -> None + let findAppTr x = match NameMap.tryFind x nameMap with | Some(AttribExpr(_, Expr.App (_, _, [TType_app(tr, _)], _, _))) -> Some tr | _ -> None member __.FindInt16 x dflt = match findConst x with | Some(Const.Int16 x) -> x | _ -> dflt @@ -126,7 +126,7 @@ type AttributeDecoder (namedArgs) = member __.FindString x dflt = match findConst x with | Some(Const.String x) -> x | _ -> dflt - member __.FindTypeName x dflt = match findAppTr x with | Some(tr) -> tr.DisplayName | _ -> dflt + member __.FindTypeName x dflt = match findAppTr x with | Some tr -> tr.DisplayName | _ -> dflt //-------------------------------------------------------------------------- // Statistics @@ -582,7 +582,7 @@ and ComputeUnionHasHelpers g (tcref: TyconRef) = elif tyconRefEq g tcref g.option_tcr_canon then SpecialFSharpOptionHelpers else match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with - | Some(Attrib(_, _, [ AttribBoolArg (b) ], _, _, _, _)) -> + | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> if b then AllHelpers else NoHelpers | Some (Attrib(_, _, _, _, _, _, m)) -> errorR(Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded(), m)) @@ -793,7 +793,7 @@ and BranchCallItem = /// Represents a place we can branch to and Mark = | Mark of ILCodeLabel - member x.CodeLabel = (let (Mark(lab)) = x in lab) + member x.CodeLabel = (let (Mark lab) = x in lab) /// The overall environment at a particular point in an expression tree. and IlxGenEnv = @@ -1141,7 +1141,7 @@ and AddBindingsForModuleDef allocVal cloc eenv x = eenv | TMAbstract(ModuleOrNamespaceExprWithSig(mtyp, _, _)) -> AddBindingsForLocalModuleType allocVal cloc eenv mtyp - | TMDefs(mdefs) -> + | TMDefs mdefs -> AddBindingsForModuleDefs allocVal cloc eenv mdefs /// Record how constructs are represented, for a module or namespace. @@ -1229,7 +1229,7 @@ type PropKey = PropKey of string * ILTypes * ILThisConvention let AddPropertyDefToHash (m: range) (ht: Dictionary) (pdef: ILPropertyDef) = let nm = PropKey(pdef.Name, pdef.Args, pdef.CallingConv) - match ht.TryGetValue(nm) with + match ht.TryGetValue nm with | true, (idx, pd) -> ht.[nm] <- (idx, MergePropertyPair m pd pdef) | _ -> @@ -1261,11 +1261,11 @@ type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = events = mkILEvents (tdef.Events.AsList @ ResizeArray.toList gevents), nestedTypes = mkILTypeDefs (tdef.NestedTypes.AsList @ gnested.Close())) - member b.AddEventDef(edef) = gevents.Add edef + member b.AddEventDef edef = gevents.Add edef - member b.AddFieldDef(ilFieldDef) = gfields.Add ilFieldDef + member b.AddFieldDef ilFieldDef = gfields.Add ilFieldDef - member b.AddMethodDef(ilMethodDef) = + member b.AddMethodDef ilMethodDef = let discard = match tdefDiscards with | Some (mdefDiscard, _) -> mdefDiscard ilMethodDef @@ -1313,11 +1313,11 @@ and TypeDefsBuilder() = || not (Array.isEmpty tdef.Methods.AsArray) then yield tdef ] - member b.FindTypeDefBuilder(nm) = + member b.FindTypeDefBuilder nm = try tdefs.[nm] |> snd |> fst with :? KeyNotFoundException -> failwith ("FindTypeDefBuilder: " + nm + " not found") - member b.FindNestedTypeDefsBuilder(path) = + member b.FindNestedTypeDefsBuilder path = List.fold (fun (acc: TypeDefsBuilder) x -> acc.FindTypeDefBuilder(x).NestedTypeDefs) b path member b.FindNestedTypeDefBuilder(tref: ILTypeRef) = @@ -1421,7 +1421,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu NewTycon(Some cpath, ilTypeRef.Name, m, taccessPublic, taccessPublic, TyparKind.Type, LazyWithContext.NotLazy tps, XmlDoc.Empty, false, false, false, lmtyp) if isStruct then - tycon.SetIsStructRecordOrUnion(true) + tycon.SetIsStructRecordOrUnion true tycon.entity_tycon_repr <- TRecdRepr (MakeRecdFieldsTable @@ -1542,7 +1542,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu member mgbuf.AddMethodDef(tref: ILTypeRef, ilMethodDef) = gtdefs.FindNestedTypeDefBuilder(tref).AddMethodDef(ilMethodDef) if ilMethodDef.IsEntryPoint then - explicitEntryPointInfo <- Some(tref) + explicitEntryPointInfo <- Some tref member mgbuf.AddExplicitInitToSpecificMethodDef(cond, tref, fspec, sourceOpt, feefee, seqpt) = // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field @@ -1615,7 +1615,7 @@ type CodeGenBuffer(m: range, let rec lab2pc n lbl = if n = System.Int32.MaxValue then error(InternalError("recursive label graph", m)) - match codeLabelToCodeLabel.TryGetValue(lbl) with + match codeLabelToCodeLabel.TryGetValue lbl with | true, l -> lab2pc (n + 1) l | _ -> codeLabelToPC.[lbl] @@ -1625,7 +1625,7 @@ type CodeGenBuffer(m: range, do if mgbuf.cenv.opts.generateDebugSymbols then let doc = g.memoize_file m.FileIndex let i = FeeFeeInstr mgbuf.cenv doc - codebuf.Add(i) // for the FeeFee or a better sequence point + codebuf.Add i // for the FeeFee or a better sequence point member cgbuf.DoPushes (pushes: Pushes) = for ty in pushes do @@ -1677,7 +1677,7 @@ type CodeGenBuffer(m: range, codebuf.Add(AI_nop) - member cgbuf.EmitSeqPoint(src) = + member cgbuf.EmitSeqPoint src = if mgbuf.cenv.opts.generateDebugSymbols then let attr = GenILSourceMarker g src let i = I_seqpoint attr @@ -1690,7 +1690,7 @@ type CodeGenBuffer(m: range, else cgbuf.EnsureNopBetweenDebugPoints() - codebuf.Add(i) + codebuf.Add i // Save the last sequence point away so we can make a decision graph look consistent (i.e. reassert the sequence point at each target) lastSeqPoint <- Some src @@ -1708,9 +1708,9 @@ type CodeGenBuffer(m: range, | I_seqpoint sm when sm.Line = FeeFee mgbuf.cenv -> () | _ -> cgbuf.EnsureNopBetweenDebugPoints() - codebuf.Add(i) + codebuf.Add i - member cgbuf.EmitExceptionClause(clause) = + member cgbuf.EmitExceptionClause clause = exnSpecs.Add clause member cgbuf.GenerateDelayMark(_nm) = @@ -1719,7 +1719,7 @@ type CodeGenBuffer(m: range, member cgbuf.SetCodeLabelToCodeLabel(lab1, lab2) = #if DEBUG - if codeLabelToCodeLabel.ContainsKey(lab1) then + if codeLabelToCodeLabel.ContainsKey lab1 then let msg = sprintf "two values given for label %s, methodName = %s, m = %s" (formatCodeLabel lab1) methodName (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) warning(InternalError(msg, m)) @@ -1728,7 +1728,7 @@ type CodeGenBuffer(m: range, member cgbuf.SetCodeLabelToPC(lab, pc) = #if DEBUG - if codeLabelToPC.ContainsKey(lab) then + if codeLabelToPC.ContainsKey lab then let msg = sprintf "two values given for label %s, methodName = %s, m = %s" (formatCodeLabel lab) methodName (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) warning(InternalError(msg, m)) @@ -1741,13 +1741,13 @@ type CodeGenBuffer(m: range, member cgbuf.SetMarkToHere (Mark lab) = cgbuf.SetCodeLabelToPC(lab, codebuf.Count) - member cgbuf.SetStack(s) = + member cgbuf.SetStack s = stack <- s nstack <- s.Length - member cgbuf.Mark(s) = - let res = cgbuf.GenerateDelayMark(s) - cgbuf.SetMarkToHere(res) + member cgbuf.Mark s = + let res = cgbuf.GenerateDelayMark s + cgbuf.SetMarkToHere res res member cgbuf.mgbuf = mgbuf @@ -1793,12 +1793,12 @@ type CodeGenBuffer(m: range, module CG = let EmitInstr (cgbuf: CodeGenBuffer) pops pushes i = cgbuf.EmitInstr(pops, pushes, i) let EmitInstrs (cgbuf: CodeGenBuffer) pops pushes is = cgbuf.EmitInstrs(pops, pushes, is) - let EmitSeqPoint (cgbuf: CodeGenBuffer) src = cgbuf.EmitSeqPoint(src) - let GenerateDelayMark (cgbuf: CodeGenBuffer) nm = cgbuf.GenerateDelayMark(nm) + let EmitSeqPoint (cgbuf: CodeGenBuffer) src = cgbuf.EmitSeqPoint src + let GenerateDelayMark (cgbuf: CodeGenBuffer) nm = cgbuf.GenerateDelayMark nm let SetMark (cgbuf: CodeGenBuffer) m1 m2 = cgbuf.SetMark(m1, m2) - let SetMarkToHere (cgbuf: CodeGenBuffer) m1 = cgbuf.SetMarkToHere(m1) - let SetStack (cgbuf: CodeGenBuffer) s = cgbuf.SetStack(s) - let GenerateMark (cgbuf: CodeGenBuffer) s = cgbuf.Mark(s) + let SetMarkToHere (cgbuf: CodeGenBuffer) m1 = cgbuf.SetMarkToHere m1 + let SetStack (cgbuf: CodeGenBuffer) s = cgbuf.SetStack s + let GenerateMark (cgbuf: CodeGenBuffer) s = cgbuf.Mark s open CG @@ -1817,7 +1817,7 @@ let GenConstArray cenv (cgbuf: CodeGenBuffer) eenv ilElementType (data:'a[]) (wr let bytes = buf.Close() let ilArrayType = mkILArr1DTy ilElementType if data.Length = 0 then - CG.EmitInstrs cgbuf (pop 0) (Push [ilArrayType]) [ mkLdcInt32 (0); I_newarr (ILArrayShape.SingleDimensional, ilElementType); ] + CG.EmitInstrs cgbuf (pop 0) (Push [ilArrayType]) [ mkLdcInt32 0; I_newarr (ILArrayShape.SingleDimensional, ilElementType); ] else let vtspec = cgbuf.mgbuf.GenerateRawDataValueType(eenv.cloc, bytes.Length) let ilFieldName = CompilerGeneratedName ("field" + string(newUnique())) @@ -2017,7 +2017,7 @@ let rec FirstEmittedCodeWillBeSequencePoint g sp expr = BindingEmitsSequencePoint g bind || FirstEmittedCodeWillBeSequencePoint g sp bind.Expr || (BindingEmitsNoCode g bind && FirstEmittedCodeWillBeSequencePoint g sp body) - | Expr.LetRec(binds, body, _, _) -> + | Expr.LetRec (binds, body, _, _) -> binds |> List.exists (BindingEmitsSequencePoint g) || (binds |> List.forall (BindingEmitsNoCode g) && FirstEmittedCodeWillBeSequencePoint g sp body) | Expr.Sequential (_, _, NormalSeq, spSeq, _) -> @@ -2026,7 +2026,7 @@ let rec FirstEmittedCodeWillBeSequencePoint g sp expr = | SuppressSequencePointOnExprOfSequential -> true | SuppressSequencePointOnStmtOfSequential -> false | Expr.Match (SequencePointAtBinding _, _, _, _, _, _) -> true - | Expr.Op((TOp.TryCatch (SequencePointAtTry _, _) + | Expr.Op ((TOp.TryCatch (SequencePointAtTry _, _) | TOp.TryFinally (SequencePointAtTry _, _) | TOp.For (SequencePointAtForLoop _, _) | TOp.While (SequencePointAtWhileLoop _, _)), _, _, _) -> true @@ -2057,22 +2057,22 @@ let EmitSequencePointForWholeExpr g sp expr = // _before_ the evaluation of 'x'. This will only happen for sticky 'let' introduced by inlining and other code generation // steps. We do _not_ do this for 'invisible' let which can be skipped. | Expr.Let (bind, _, _, _) when BindingIsInvisible bind -> false - | Expr.LetRec(binds, _, _, _) when binds |> List.forall BindingIsInvisible -> false + | Expr.LetRec (binds, _, _, _) when binds |> List.forall BindingIsInvisible -> false // If the binding is a lambda then we don't emit a sequence point. | Expr.Let (bind, _, _, _) when BindingEmitsHiddenCode bind -> false - | Expr.LetRec(binds, _, _, _) when binds |> List.forall BindingEmitsHiddenCode -> false + | Expr.LetRec (binds, _, _, _) when binds |> List.forall BindingEmitsHiddenCode -> false // If the binding is represented by a top-level generated constant value then we don't emit a sequence point. | Expr.Let (bind, _, _, _) when BindingEmitsNoCode g bind -> false - | Expr.LetRec(binds, _, _, _) when binds |> List.forall (BindingEmitsNoCode g) -> false + | Expr.LetRec (binds, _, _, _) when binds |> List.forall (BindingEmitsNoCode g) -> false // Suppress sequence points for the whole 'a;b' and do it at 'a' instead. | Expr.Sequential _ -> false // Suppress sequence points at labels and gotos, it makes no sense to emit sequence points at these. We emit FeeFee instead - | Expr.Op(TOp.Label _, _, _, _) -> false - | Expr.Op(TOp.Goto _, _, _, _) -> false + | Expr.Op (TOp.Label _, _, _, _) -> false + | Expr.Op (TOp.Goto _, _, _, _) -> false // We always suppress at the whole 'match'/'try'/... expression because we do it at the individual parts. // @@ -2082,10 +2082,10 @@ let EmitSequencePointForWholeExpr g sp expr = // So since the 'let tmp = expr' has a sequence point, then no sequence point is needed for the 'match'. But the processing // of the 'let' requests SPAlways for the body. | Expr.Match _ -> false - | Expr.Op(TOp.TryCatch _, _, _, _) -> false - | Expr.Op(TOp.TryFinally _, _, _, _) -> false - | Expr.Op(TOp.For _, _, _, _) -> false - | Expr.Op(TOp.While _, _, _, _) -> false + | Expr.Op (TOp.TryCatch _, _, _, _) -> false + | Expr.Op (TOp.TryFinally _, _, _, _) -> false + | Expr.Op (TOp.For _, _, _, _) -> false + | Expr.Op (TOp.While _, _, _, _) -> false | _ -> true | SPSuppress -> false @@ -2102,7 +2102,7 @@ let EmitHiddenCodeMarkerForWholeExpr g sp expr = | SPAlways -> match stripExpr expr with | Expr.Let (bind, _, _, _) when BindingEmitsHiddenCode bind -> true - | Expr.LetRec(binds, _, _, _) when binds |> List.exists BindingEmitsHiddenCode -> true + | Expr.LetRec (binds, _, _, _) when binds |> List.exists BindingEmitsHiddenCode -> true | _ -> false | SPSuppress -> false @@ -2117,7 +2117,7 @@ let rec RangeOfSequencePointForWholeExpr g expr = | _, None, SPSuppress -> RangeOfSequencePointForWholeExpr g body | _, Some m, _ -> m | _, None, SPAlways -> RangeOfSequencePointForWholeExpr g bind.Expr - | Expr.LetRec(_, body, _, _) -> RangeOfSequencePointForWholeExpr g body + | Expr.LetRec (_, body, _, _) -> RangeOfSequencePointForWholeExpr g body | Expr.Sequential (expr1, _, NormalSeq, _, _) -> RangeOfSequencePointForWholeExpr g expr1 | _ -> expr.Range @@ -2146,11 +2146,11 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | None -> match expr with - | Expr.Const(c, m, ty) -> + | Expr.Const (c, m, ty) -> GenConstant cenv cgbuf eenv (c, m, ty) sequel | Expr.Match (spBind, exprm, tree, targets, m, ty) -> GenMatch cenv cgbuf eenv (spBind, exprm, tree, targets, m, ty) sequel - | Expr.Sequential(e1, e2, dir, spSeq, m) -> + | Expr.Sequential (e1, e2, dir, spSeq, m) -> GenSequential cenv cgbuf eenv sp (e1, e2, dir, spSeq, m) sequel | Expr.LetRec (binds, body, m, _) -> GenLetRec cenv cgbuf eenv (binds, body, m) sequel @@ -2178,7 +2178,7 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | Expr.Lambda _ | Expr.TyLambda _ -> GenLambda cenv cgbuf eenv false None expr sequel - | Expr.App(Expr.Val(vref, _, m) as v, _, tyargs, [], _) when + | Expr.App (Expr.Val (vref, _, m) as v, _, tyargs, [], _) when List.forall (isMeasureTy g) tyargs && ( // inline only values that are stored in local variables @@ -2188,9 +2188,9 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = ) -> // application of local type functions with type parameters = measure types and body = local value - inine the body GenExpr cenv cgbuf eenv sp v sequel - | Expr.App(f,fty, tyargs, args, m) -> + | Expr.App (f,fty, tyargs, args, m) -> GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel - | Expr.Val(v, _, m) -> + | Expr.Val (v, _, m) -> GenGetVal cenv cgbuf eenv (v, m) sequel // Most generation of linear expressions is implemented routinely using tailcalls and the correct sequels. @@ -2199,33 +2199,33 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | LinearOpExpr _ -> GenLinearExpr cenv cgbuf eenv expr sequel id |> ignore - | Expr.Op(op, tyargs, args, m) -> + | Expr.Op (op, tyargs, args, m) -> match op, args, tyargs with - | TOp.ExnConstr(c), _, _ -> + | TOp.ExnConstr c, _, _ -> GenAllocExn cenv cgbuf eenv (c, args, m) sequel - | TOp.UnionCase(c), _, _ -> + | TOp.UnionCase c, _, _ -> GenAllocUnionCase cenv cgbuf eenv (c, tyargs, args, m) sequel - | TOp.Recd(isCtor, tycon), _, _ -> + | TOp.Recd (isCtor, tycon), _, _ -> GenAllocRecd cenv cgbuf eenv isCtor (tycon, tyargs, args, m) sequel - | TOp.AnonRecd(anonInfo), _, _ -> + | TOp.AnonRecd anonInfo, _, _ -> GenAllocAnonRecd cenv cgbuf eenv (anonInfo, tyargs, args, m) sequel | TOp.AnonRecdGet (anonInfo, n), [e], _ -> GenGetAnonRecdField cenv cgbuf eenv (anonInfo, e, tyargs, n, m) sequel | TOp.TupleFieldGet (tupInfo, n), [e], _ -> GenGetTupleField cenv cgbuf eenv (tupInfo, e, tyargs, n, m) sequel - | TOp.ExnFieldGet(ecref, n), [e], _ -> + | TOp.ExnFieldGet (ecref, n), [e], _ -> GenGetExnField cenv cgbuf eenv (e, ecref, n, m) sequel - | TOp.UnionCaseFieldGet(ucref, n), [e], _ -> + | TOp.UnionCaseFieldGet (ucref, n), [e], _ -> GenGetUnionCaseField cenv cgbuf eenv (e, ucref, tyargs, n, m) sequel - | TOp.UnionCaseFieldGetAddr(ucref, n, _readonly), [e], _ -> + | TOp.UnionCaseFieldGetAddr (ucref, n, _readonly), [e], _ -> GenGetUnionCaseFieldAddr cenv cgbuf eenv (e, ucref, tyargs, n, m) sequel | TOp.UnionCaseTagGet ucref, [e], _ -> GenGetUnionCaseTag cenv cgbuf eenv (e, ucref, tyargs, m) sequel | TOp.UnionCaseProof ucref, [e], _ -> GenUnionCaseProof cenv cgbuf eenv (e, ucref, tyargs, m) sequel - | TOp.ExnFieldSet(ecref, n), [e;e2], _ -> + | TOp.ExnFieldSet (ecref, n), [e;e2], _ -> GenSetExnField cenv cgbuf eenv (e, ecref, n, e2, m) sequel - | TOp.UnionCaseFieldSet(ucref, n), [e;e2], _ -> + | TOp.UnionCaseFieldSet (ucref, n), [e;e2], _ -> GenSetUnionCaseField cenv cgbuf eenv (e, ucref, tyargs, n, e2, m) sequel | TOp.ValFieldGet f, [e], _ -> GenGetRecdField cenv cgbuf eenv (e, f, tyargs, m) sequel @@ -2241,26 +2241,26 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = GenSetStaticField cenv cgbuf eenv (f, tyargs, e2, m) sequel | TOp.Tuple tupInfo, _, _ -> GenAllocTuple cenv cgbuf eenv (tupInfo, args, tyargs, m) sequel - | TOp.ILAsm(code, returnTys), _, _ -> + | TOp.ILAsm (code, returnTys), _, _ -> GenAsmCode cenv cgbuf eenv (code, tyargs, args, returnTys, m) sequel - | TOp.While (sp, _), [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _)], [] -> + | TOp.While (sp, _), [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _)], [] -> GenWhileLoop cenv cgbuf eenv (sp, e1, e2, m) sequel - | TOp.For(spStart, dir), [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _);Expr.Lambda(_, _, _, [v], e3, _, _)], [] -> + | TOp.For (spStart, dir), [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _);Expr.Lambda (_, _, _, [v], e3, _, _)], [] -> GenForLoop cenv cgbuf eenv (spStart, v, e1, dir, e2, e3, m) sequel - | TOp.TryFinally(spTry, spFinally), [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)], [resty] -> + | TOp.TryFinally (spTry, spFinally), [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)], [resty] -> GenTryFinally cenv cgbuf eenv (e1, e2, m, resty, spTry, spFinally) sequel - | TOp.TryCatch(spTry, spWith), [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [vf], ef, _, _);Expr.Lambda(_, _, _, [vh], eh, _, _)], [resty] -> + | TOp.TryCatch (spTry, spWith), [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [vf], ef, _, _);Expr.Lambda (_, _, _, [vh], eh, _, _)], [resty] -> GenTryCatch cenv cgbuf eenv (e1, vf, ef, vh, eh, m, resty, spTry, spWith) sequel - | TOp.ILCall(virt, _, valu, newobj, valUseFlags, _, isDllImport, ilMethRef, enclArgTys, methArgTys, returnTys), args, [] -> + | TOp.ILCall (virt, _, valu, newobj, valUseFlags, _, isDllImport, ilMethRef, enclArgTys, methArgTys, returnTys), args, [] -> GenILCall cenv cgbuf eenv (virt, valu, newobj, valUseFlags, isDllImport, ilMethRef, enclArgTys, methArgTys, args, returnTys, m) sequel | TOp.RefAddrGet _readonly, [e], [ty] -> GenGetAddrOfRefCellField cenv cgbuf eenv (e, ty, m) sequel | TOp.Coerce, [e], [tgty;srcty] -> GenCoerce cenv cgbuf eenv (e, tgty, m, srcty) sequel | TOp.Reraise, [], [rtnty] -> GenReraise cenv cgbuf eenv (rtnty, m) sequel - | TOp.TraitCall(ss), args, [] -> GenTraitCall cenv cgbuf eenv (ss, args, m) expr sequel - | TOp.LValueOp(LSet, v), [e], [] -> GenSetVal cenv cgbuf eenv (v, e, m) sequel - | TOp.LValueOp(LByrefGet, v), [], [] -> GenGetByref cenv cgbuf eenv (v, m) sequel - | TOp.LValueOp(LByrefSet, v), [e], [] -> GenSetByref cenv cgbuf eenv (v, e, m) sequel - | TOp.LValueOp(LAddrOf _, v), [], [] -> GenGetValAddr cenv cgbuf eenv (v, m) sequel + | TOp.TraitCall ss, args, [] -> GenTraitCall cenv cgbuf eenv (ss, args, m) expr sequel + | TOp.LValueOp (LSet, v), [e], [] -> GenSetVal cenv cgbuf eenv (v, e, m) sequel + | TOp.LValueOp (LByrefGet, v), [], [] -> GenGetByref cenv cgbuf eenv (v, m) sequel + | TOp.LValueOp (LByrefSet, v), [e], [] -> GenSetByref cenv cgbuf eenv (v, e, m) sequel + | TOp.LValueOp (LAddrOf _, v), [], [] -> GenGetValAddr cenv cgbuf eenv (v, m) sequel | TOp.Array, elems, [elemTy] -> GenNewArray cenv cgbuf eenv (elems, elemTy, m) sequel | TOp.Bytes bytes, [], [] -> if cenv.opts.emitConstantArraysUsingStaticDataBlobs then @@ -2274,7 +2274,7 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = GenSequel cenv eenv.cloc cgbuf sequel else GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkUInt16 g m) arr), g.uint16_ty, m) sequel - | TOp.Goto(label), _, _ -> + | TOp.Goto label, _, _ -> if cgbuf.mgbuf.cenv.opts.generateDebugSymbols then cgbuf.EmitStartOfHiddenCode() CG.EmitInstr cgbuf (pop 0) Push0 AI_nop @@ -2286,18 +2286,18 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | TOp.Return, [], _ -> GenSequel cenv eenv.cloc cgbuf ReturnVoid // NOTE: discard sequel - | TOp.Label(label), _, _ -> + | TOp.Label label, _, _ -> cgbuf.SetMarkToHere (Mark label) GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel | _ -> error(InternalError("Unexpected operator node expression", expr.Range)) - | Expr.StaticOptimization(constraints, e2, e3, m) -> + | Expr.StaticOptimization (constraints, e2, e3, m) -> GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, m) sequel - | Expr.Obj(_, ty, _, _, [meth], [], m) when isDelegateTy g ty -> + | Expr.Obj (_, ty, _, _, [meth], [], m) when isDelegateTy g ty -> GenDelegateExpr cenv cgbuf eenv expr (meth, m) sequel - | Expr.Obj(_, ty, basev, basecall, overrides, interfaceImpls, m) -> + | Expr.Obj (_, ty, basev, basecall, overrides, interfaceImpls, m) -> GenObjectExpr cenv cgbuf eenv expr (ty, basev, basecall, overrides, interfaceImpls, m) sequel - | Expr.Quote(ast, conv, _, m, ty) -> GenQuotation cenv cgbuf eenv (ast, conv, m, ty) sequel + | Expr.Quote (ast, conv, _, m, ty) -> GenQuotation cenv cgbuf eenv (ast, conv, m, ty) sequel | Expr.Link _ -> failwith "Unexpected reclink" | Expr.TyChoose (_, _, m) -> error(InternalError("Unexpected Expr.TyChoose", m)) @@ -2320,7 +2320,7 @@ and CodeGenMethodForExpr cenv mgbuf (spReq, entryPointInfo, methodName, eenv, al (* does the sequel discard its result, and if so what does it do next? *) and sequelAfterDiscard sequel = match sequel with - | DiscardThen sequel -> Some(sequel) + | DiscardThen sequel -> Some sequel | EndLocalScope(sq, mark) -> sequelAfterDiscard sq |> Option.map (fun sq -> EndLocalScope(sq, mark)) | _ -> None @@ -2422,8 +2422,8 @@ and GenConstant cenv cgbuf eenv (c, m, ty) sequel = | Const.UIntPtr i -> CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [iLdcInt64 (int64 i); AI_conv DT_U ] | Const.Double f -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldc (DT_R8, ILConst.R8 f)) | Const.Single f -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldc (DT_R4, ILConst.R4 f)) - | Const.Char(c) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) ( mkLdcInt32 (int c)) - | Const.String(s) -> GenString cenv cgbuf s + | Const.Char c -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) ( mkLdcInt32 (int c)) + | Const.String s -> GenString cenv cgbuf s | Const.Unit -> GenUnit cenv eenv m cgbuf | Const.Zero -> GenDefaultValue cenv cgbuf eenv (ty, m) | Const.Decimal _ -> failwith "unreachable" @@ -2445,7 +2445,7 @@ and GenUnit cenv eenv m cgbuf = and GenUnitThenSequel cenv eenv m cloc cgbuf sequel = match sequelAfterDiscard sequel with - | Some(sq) -> GenSequel cenv cloc cgbuf sq + | Some sq -> GenSequel cenv cloc cgbuf sq | None -> GenUnit cenv eenv m cgbuf; GenSequel cenv cloc cgbuf sequel @@ -2478,7 +2478,7 @@ and GenGetTupleField cenv cgbuf eenv (tupInfo, e, tys, n, m) sequel = let ty = GenNamedTyApp cenv.amap m eenv.tyenv tcr' tys mkGetTupleItemN g m n ty tupInfo e tys.[n] else - let tysA, tysB = List.splitAfter (goodTupleFields) tys + let tysA, tysB = List.splitAfter goodTupleFields tys let tyB = mkCompiledTupleTy g tupInfo tysB let tys' = tysA@[tyB] let tcr' = mkCompiledTupleTyconRef g tupInfo (List.length tys') @@ -2515,7 +2515,7 @@ and GenLinearExpr cenv cgbuf eenv expr sequel (contf: FakeUnit -> FakeUnit) = match expr with | LinearOpExpr (TOp.UnionCase c, tyargs, argsFront, argLast, m) -> GenExprs cenv cgbuf eenv argsFront - GenLinearExpr cenv cgbuf eenv argLast Continue (contf << (fun (Fake) -> + GenLinearExpr cenv cgbuf eenv argLast Continue (contf << (fun Fake -> GenAllocUnionCaseCore cenv cgbuf eenv (c, tyargs, argsFront.Length + 1, m) GenSequel cenv eenv.cloc cgbuf sequel Fake)) @@ -2551,7 +2551,7 @@ and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel = GenSequel cenv eenv.cloc cgbuf sequel and GenAllocAnonRecd cenv cgbuf eenv (anonInfo: AnonRecdTypeInfo, tyargs, args, m) sequel = - let anonCtor, _anonMethods, anonType = cgbuf.mgbuf.LookupAnonType(anonInfo) + let anonCtor, _anonMethods, anonType = cgbuf.mgbuf.LookupAnonType anonInfo let boxity = anonType.Boxity GenExprs cenv cgbuf eenv args let ilTypeArgs = GenTypeArgs cenv.amap m eenv.tyenv tyargs @@ -2560,7 +2560,7 @@ and GenAllocAnonRecd cenv cgbuf eenv (anonInfo: AnonRecdTypeInfo, tyargs, args, GenSequel cenv eenv.cloc cgbuf sequel and GenGetAnonRecdField cenv cgbuf eenv (anonInfo: AnonRecdTypeInfo, e, tyargs, n, m) sequel = - let _anonCtor, anonMethods, anonType = cgbuf.mgbuf.LookupAnonType(anonInfo) + let _anonCtor, anonMethods, anonType = cgbuf.mgbuf.LookupAnonType anonInfo let boxity = anonType.Boxity let ilTypeArgs = GenTypeArgs cenv.amap m eenv.tyenv tyargs let anonMethod = anonMethods.[n] @@ -2594,41 +2594,41 @@ and GenNewArray cenv cgbuf eenv (elems: Expr list, elemTy, m) sequel = let elems' = Array.ofList elems let test, write = match elems'.[0] with - | Expr.Const(Const.Bool _, _, _) -> + | Expr.Const (Const.Bool _, _, _) -> (function Const.Bool _ -> true | _ -> false), (fun (buf: ByteBuffer) -> function Const.Bool b -> buf.EmitBoolAsByte b | _ -> failwith "unreachable") - | Expr.Const(Const.Char _, _, _) -> + | Expr.Const (Const.Char _, _, _) -> (function Const.Char _ -> true | _ -> false), (fun buf -> function Const.Char b -> buf.EmitInt32AsUInt16 (int b) | _ -> failwith "unreachable") - | Expr.Const(Const.Byte _, _, _) -> + | Expr.Const (Const.Byte _, _, _) -> (function Const.Byte _ -> true | _ -> false), (fun buf -> function Const.Byte b -> buf.EmitByte b | _ -> failwith "unreachable") - | Expr.Const(Const.UInt16 _, _, _) -> + | Expr.Const (Const.UInt16 _, _, _) -> (function Const.UInt16 _ -> true | _ -> false), (fun buf -> function Const.UInt16 b -> buf.EmitUInt16 b | _ -> failwith "unreachable") - | Expr.Const(Const.UInt32 _, _, _) -> + | Expr.Const (Const.UInt32 _, _, _) -> (function Const.UInt32 _ -> true | _ -> false), (fun buf -> function Const.UInt32 b -> buf.EmitInt32 (int32 b) | _ -> failwith "unreachable") - | Expr.Const(Const.UInt64 _, _, _) -> + | Expr.Const (Const.UInt64 _, _, _) -> (function Const.UInt64 _ -> true | _ -> false), (fun buf -> function Const.UInt64 b -> buf.EmitInt64 (int64 b) | _ -> failwith "unreachable") - | Expr.Const(Const.SByte _, _, _) -> + | Expr.Const (Const.SByte _, _, _) -> (function Const.SByte _ -> true | _ -> false), (fun buf -> function Const.SByte b -> buf.EmitByte (byte b) | _ -> failwith "unreachable") - | Expr.Const(Const.Int16 _, _, _) -> + | Expr.Const (Const.Int16 _, _, _) -> (function Const.Int16 _ -> true | _ -> false), (fun buf -> function Const.Int16 b -> buf.EmitUInt16 (uint16 b) | _ -> failwith "unreachable") - | Expr.Const(Const.Int32 _, _, _) -> + | Expr.Const (Const.Int32 _, _, _) -> (function Const.Int32 _ -> true | _ -> false), (fun buf -> function Const.Int32 b -> buf.EmitInt32 b | _ -> failwith "unreachable") - | Expr.Const(Const.Int64 _, _, _) -> + | Expr.Const (Const.Int64 _, _, _) -> (function Const.Int64 _ -> true | _ -> false), (fun buf -> function Const.Int64 b -> buf.EmitInt64 b | _ -> failwith "unreachable") | _ -> (function _ -> false), (fun _ _ -> failwith "unreachable") - if elems' |> Array.forall (function Expr.Const(c, _, _) -> test c | _ -> false) then + if elems' |> Array.forall (function Expr.Const (c, _, _) -> test c | _ -> false) then let ilElemTy = GenType cenv.amap m eenv.tyenv elemTy - GenConstArray cenv cgbuf eenv ilElemTy elems' (fun buf -> function Expr.Const(c, _, _) -> write buf c | _ -> failwith "unreachable") + GenConstArray cenv cgbuf eenv ilElemTy elems' (fun buf -> function Expr.Const (c, _, _) -> write buf c | _ -> failwith "unreachable") GenSequel cenv eenv.cloc cgbuf sequel else @@ -2699,10 +2699,10 @@ and GenSetExnField cenv cgbuf eenv (e, ecref, fieldNum, e2, m) sequel = and UnionCodeGen (cgbuf: CodeGenBuffer) = { new EraseUnions.ICodeGen with - member __.CodeLabel(m) = m.CodeLabel + member __.CodeLabel m = m.CodeLabel member __.GenerateDelayMark() = CG.GenerateDelayMark cgbuf "unionCodeGenMark" - member __.GenLocal(ilty) = cgbuf.AllocLocal([], ilty, false) |> uint16 - member __.SetMarkToHere(m) = CG.SetMarkToHere cgbuf m + member __.GenLocal ilty = cgbuf.AllocLocal([], ilty, false) |> uint16 + member __.SetMarkToHere m = CG.SetMarkToHere cgbuf m member __.MkInvalidCastExnNewobj () = mkInvalidCastExnNewobj cgbuf.mgbuf.cenv.g member __.EmitInstr x = CG.EmitInstr cgbuf (pop 0) (Push []) x member __.EmitInstrs xs = CG.EmitInstrs cgbuf (pop 0) (Push []) xs } @@ -2873,7 +2873,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = let g = cenv.g match (f, tyargs, args) with (* Look for tailcall to turn into branch *) - | (Expr.Val(v, _, _), _, _) when + | (Expr.Val (v, _, _), _, _) when match ListAssoc.tryFind g.valRefEq v eenv.innerVals with | Some (kind, _) -> (not v.IsConstructor && @@ -2922,7 +2922,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = // PhysicalEquality becomes cheap reference equality once // a nominal type is known. We can't replace it for variable types since // a "ceq" instruction can't be applied to variable type values. - | (Expr.Val(v, _, _), [ty], [arg1;arg2]) when + | (Expr.Val (v, _, _), [ty], [arg1;arg2]) when (valRefEq g v g.reference_equality_inner_vref) && isAppTy g ty -> @@ -2934,13 +2934,13 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = // Emit "methodhandleof" calls as ldtoken instructions // // The token for the "GenericMethodDefinition" is loaded - | Expr.Val(v, _, m), _, [arg] when valRefEq g v g.methodhandleof_vref -> - let (|OptionalCoerce|) = function Expr.Op(TOp.Coerce _, _, [arg], _) -> arg | x -> x - let (|OptionalTyapp|) = function Expr.App(f, _, [_], [], _) -> f | x -> x + | Expr.Val (v, _, m), _, [arg] when valRefEq g v g.methodhandleof_vref -> + let (|OptionalCoerce|) = function Expr.Op (TOp.Coerce _, _, [arg], _) -> arg | x -> x + let (|OptionalTyapp|) = function Expr.App (f, _, [_], [], _) -> f | x -> x match arg with // Generate ldtoken instruction for "methodhandleof(fun (a, b, c) -> f(a, b, c))" // where f is an F# function value or F# method - | Expr.Lambda(_, _, _, _, Expr.App(OptionalCoerce(OptionalTyapp(Expr.Val(vref, _, _))), _, _, _, _), _, _) -> + | Expr.Lambda (_, _, _, _, Expr.App (OptionalCoerce(OptionalTyapp(Expr.Val (vref, _, _))), _, _, _, _), _, _) -> let storage = StorageForValRef m vref eenv match storage with @@ -2951,7 +2951,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = // Generate ldtoken instruction for "methodhandleof(fun (a, b, c) -> obj.M(a, b, c))" // where M is an IL method. - | Expr.Lambda(_, _, _, _, Expr.Op(TOp.ILCall(_, _, valu, _, _, _, _, ilMethRef, actualTypeInst, actualMethInst, _), _, _, _), _, _) -> + | Expr.Lambda (_, _, _, _, Expr.Op (TOp.ILCall (_, _, valu, _, _, _, _, ilMethRef, actualTypeInst, actualMethInst, _), _, _, _), _, _) -> let boxity = (if valu then AsValue else AsObject) let mkFormalParams gparams = gparams |> DropErasedTyargs |> List.mapi (fun n _gf -> mkILTyvarTy (uint16 n)) @@ -2967,7 +2967,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = GenSequel cenv eenv.cloc cgbuf sequel // Optimize calls to top methods when given "enough" arguments. - | Expr.Val(vref, valUseFlags, _), _, _ + | Expr.Val (vref, valUseFlags, _), _, _ when (let storage = StorageForValRef m vref eenv match storage with @@ -3090,7 +3090,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = // However, we know the type instantiation for the value. // In this case we can often generate a type-specific local expression for the value. // This reduces the number of dynamic type applications. - | (Expr.Val(vref, _, _), _, _) -> + | (Expr.Val (vref, _, _), _, _) -> GenGetValRefAndSequel cenv cgbuf eenv m vref (Some (tyargs, args, m, sequel)) | _ -> @@ -3342,7 +3342,7 @@ and GenTryFinally cenv cgbuf eenv (bodyExpr, handlerExpr, m, resty, spTry, spFin let endOfHandler = CG.GenerateMark cgbuf "endOfHandler" let handlerMarks = (startOfHandler.CodeLabel, endOfHandler.CodeLabel) cgbuf.EmitExceptionClause - { Clause = ILExceptionClause.Finally(handlerMarks) + { Clause = ILExceptionClause.Finally handlerMarks Range = tryMarks } CG.SetMarkToHere cgbuf afterHandler @@ -3387,7 +3387,7 @@ and GenForLoop cenv cgbuf eenv (spFor, v, e1, dir, e2, loopBody, m) sequel = let _, eenvinner = AllocLocalVal cenv cgbuf v eenvinner None (start, finish) (* note: eenvStack noted stack spill vars are live *) match spFor with - | SequencePointAtForLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart + | SequencePointAtForLoop spStart -> CG.EmitSeqPoint cgbuf spStart | NoSequencePointAtForLoop -> () GenExpr cenv cgbuf eenv SPSuppress e1 Continue @@ -3420,7 +3420,7 @@ and GenForLoop cenv cgbuf eenv (spFor, v, e1, dir, e2, loopBody, m) sequel = // FSharpForLoopDown: if v <> e2 - 1 then goto .inner // CSharpStyle: if v < e2 then goto .inner match spFor with - | SequencePointAtForLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart + | SequencePointAtForLoop spStart -> CG.EmitSeqPoint cgbuf spStart | NoSequencePointAtForLoop -> () //CG.EmitSeqPoint cgbuf e2.Range GenGetLocalVal cenv cgbuf eenvinner e2.Range v None @@ -3452,7 +3452,7 @@ and GenWhileLoop cenv cgbuf eenv (spWhile, e1, e2, m) sequel = let startTest = CG.GenerateMark cgbuf "startTest" match spWhile with - | SequencePointAtWhileLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart + | SequencePointAtWhileLoop spStart -> CG.EmitSeqPoint cgbuf spStart | NoSequencePointAtWhileLoop -> () // SEQUENCE POINTS: Emit a sequence point to cover all of 'while e do' @@ -3512,28 +3512,28 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = let tspec = ty.TypeSpec mkILTy ty.Boxity (mkILTySpec(tspec.TypeRef, ilTyArgs)) } match i, ilTyArgs with - | I_unbox_any (ILType.TypeVar _), [tyarg] -> I_unbox_any (tyarg) - | I_box (ILType.TypeVar _), [tyarg] -> I_box (tyarg) - | I_isinst (ILType.TypeVar _), [tyarg] -> I_isinst (tyarg) - | I_castclass (ILType.TypeVar _), [tyarg] -> I_castclass (tyarg) + | I_unbox_any (ILType.TypeVar _), [tyarg] -> I_unbox_any tyarg + | I_box (ILType.TypeVar _), [tyarg] -> I_box tyarg + | I_isinst (ILType.TypeVar _), [tyarg] -> I_isinst tyarg + | I_castclass (ILType.TypeVar _), [tyarg] -> I_castclass tyarg | I_newarr (shape, ILType.TypeVar _), [tyarg] -> I_newarr (shape, tyarg) | I_ldelem_any (shape, ILType.TypeVar _), [tyarg] -> I_ldelem_any (shape, tyarg) | I_ldelema (ro, _, shape, ILType.TypeVar _), [tyarg] -> I_ldelema (ro, false, shape, tyarg) | I_stelem_any (shape, ILType.TypeVar _), [tyarg] -> I_stelem_any (shape, tyarg) | I_ldobj (a, b, ILType.TypeVar _), [tyarg] -> I_ldobj (a, b, tyarg) | I_stobj (a, b, ILType.TypeVar _), [tyarg] -> I_stobj (a, b, tyarg) - | I_ldtoken (ILToken.ILType (ILType.TypeVar _)), [tyarg] -> I_ldtoken (ILToken.ILType (tyarg)) - | I_sizeof (ILType.TypeVar _), [tyarg] -> I_sizeof (tyarg) + | I_ldtoken (ILToken.ILType (ILType.TypeVar _)), [tyarg] -> I_ldtoken (ILToken.ILType tyarg) + | I_sizeof (ILType.TypeVar _), [tyarg] -> I_sizeof tyarg // currently unused, added for forward compat, see https://visualfsharp.codeplex.com/SourceControl/network/forks/jackpappas/fsharpcontrib/contribution/7134 - | I_cpobj (ILType.TypeVar _), [tyarg] -> I_cpobj (tyarg) - | I_initobj (ILType.TypeVar _), [tyarg] -> I_initobj (tyarg) + | I_cpobj (ILType.TypeVar _), [tyarg] -> I_cpobj tyarg + | I_initobj (ILType.TypeVar _), [tyarg] -> I_initobj tyarg | I_ldfld (al, vol, fspec), _ -> I_ldfld (al, vol, modFieldSpec fspec) - | I_ldflda (fspec), _ -> I_ldflda (modFieldSpec fspec) + | I_ldflda fspec, _ -> I_ldflda (modFieldSpec fspec) | I_stfld (al, vol, fspec), _ -> I_stfld (al, vol, modFieldSpec fspec) | I_stsfld (vol, fspec), _ -> I_stsfld (vol, modFieldSpec fspec) | I_ldsfld (vol, fspec), _ -> I_ldsfld (vol, modFieldSpec fspec) - | I_ldsflda (fspec), _ -> I_ldsflda (modFieldSpec fspec) - | EI_ilzero(ILType.TypeVar _), [tyarg] -> EI_ilzero(tyarg) + | I_ldsflda fspec, _ -> I_ldsflda (modFieldSpec fspec) + | EI_ilzero(ILType.TypeVar _), [tyarg] -> EI_ilzero tyarg | AI_nop, _ -> i // These are embedded in the IL for a an initonly ldfld, i.e. // here's the relevant comment from tc.fs @@ -3555,7 +3555,7 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = // This is the instruction sequence for "not" // For these we can just generate the argument and change the test (from a brfalse to a brtrue and vice versa) | ([ AI_ceq ], - [arg1; Expr.Const((Const.Bool false | Const.SByte 0y| Const.Int16 0s | Const.Int32 0 | Const.Int64 0L | Const.Byte 0uy| Const.UInt16 0us | Const.UInt32 0u | Const.UInt64 0UL), _, _) ], + [arg1; Expr.Const ((Const.Bool false | Const.SByte 0y| Const.Int16 0s | Const.Int32 0 | Const.Int64 0L | Const.Byte 0uy| Const.UInt16 0us | Const.UInt32 0u | Const.UInt64 0UL), _, _) ], CmpThenBrOrContinue(1, [I_brcmp (((BI_brfalse | BI_brtrue) as bi), label1) ]), _) -> @@ -3659,7 +3659,7 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = let referencedTypeDefs, spliceTypes, spliceArgExprs = qscope.Close() referencedTypeDefs, List.map fst spliceTypes, List.map fst spliceArgExprs, astSpec with - QuotationTranslator.InvalidQuotedTerm e -> error(e) + QuotationTranslator.InvalidQuotedTerm e -> error e let astSerializedBytes = QuotationPickler.pickle astSpec @@ -3667,7 +3667,7 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = let rawTy = mkRawQuotedExprTy g let spliceTypeExprs = List.map (GenType cenv.amap m eenv.tyenv >> (mkTypeOfExpr cenv m)) spliceTypes - let bytesExpr = Expr.Op(TOp.Bytes(astSerializedBytes), [], [], m) + let bytesExpr = Expr.Op (TOp.Bytes astSerializedBytes, [], [], m) let deserializeExpr = match QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat g with @@ -3746,7 +3746,7 @@ and MakeNotSupportedExnExpr cenv eenv (argExpr, m) = let ety = mkAppTy (g.FindSysTyconRef ["System"] "NotSupportedException") [] let ilty = GenType cenv.amap m eenv.tyenv ety let mref = mkILCtorMethSpecForTy(ilty, [g.ilg.typ_String]).MethodRef - Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [ety]), [], [argExpr], m) + Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [ety]), [], [argExpr], m) and GenTraitCall cenv cgbuf eenv (traitInfo, argExprs, m) expr sequel = let g = cenv.g @@ -3855,7 +3855,7 @@ and GenGenericParam cenv eenv (tp: Typar) = let g = cenv.g let subTypeConstraints = tp.Constraints - |> List.choose (function | TyparConstraint.CoercesTo(ty, _) -> Some(ty) | _ -> None) + |> List.choose (function | TyparConstraint.CoercesTo(ty, _) -> Some ty | _ -> None) |> List.map (GenTypeAux cenv.amap tp.Range eenv.tyenv VoidNotOK PtrTypesNotOK) let refTypeConstraint = @@ -4228,7 +4228,7 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc selfv expr let g = cenv.g match expr with | Expr.Lambda (_, _, _, _, _, m, _) - | Expr.TyLambda(_, _, _, m, _) -> + | Expr.TyLambda (_, _, _, m, _) -> let cloinfo, body, eenvinner = GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenv expr @@ -4334,7 +4334,7 @@ and GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr = match expr with | Expr.Obj (uniq, _, _, _, _, _, _) | Expr.Lambda (uniq, _, _, _, _, _, _) - | Expr.TyLambda(uniq, _, _, _, _) -> uniq + | Expr.TyLambda (uniq, _, _, _, _) -> uniq | _ -> newUnique() // Choose a name for the closure @@ -4418,8 +4418,8 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = let g = cenv.g let returnTy = match expr with - | Expr.Lambda (_, _, _, _, _, _, returnTy) | Expr.TyLambda(_, _, _, _, returnTy) -> returnTy - | Expr.Obj(_, ty, _, _, _, _, _) -> ty + | Expr.Lambda (_, _, _, _, _, _, returnTy) | Expr.TyLambda (_, _, _, _, returnTy) -> returnTy + | Expr.Obj (_, ty, _, _, _, _, _) -> ty | _ -> failwith "GetIlxClosureInfo: not a lambda expression" // Determine the structure of the closure. We do this before analyzing free variables to @@ -4427,7 +4427,7 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = let tvsl, vs, body, returnTy = let rec getCallStructure tvacc vacc (e, ety) = match e with - | Expr.TyLambda(_, tvs, body, _m, bty) -> + | Expr.TyLambda (_, tvs, body, _m, bty) -> getCallStructure ((DropErasedTypars tvs) :: tvacc) vacc (body, bty) | Expr.Lambda (_, _, _, vs, body, _, bty) when not isLocalTypeFunc -> // Transform a lambda taking untupled arguments into one @@ -4563,7 +4563,7 @@ and GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo = let ilContractGenericParams = GenGenericParams cenv eenv cloinfo.localTypeFuncContractFreeTypars let tvs, contractRetTy = match cloinfo.cloExpr with - | Expr.TyLambda(_, tvs, _, _, bty) -> tvs, bty + | Expr.TyLambda (_, tvs, _, _, bty) -> tvs, bty | e -> [], tyOfExpr cenv.g e let eenvForContract = AddTyparsToEnv tvs eenvForContract let ilContractMethTyargs = GenGenericParams cenv eenvForContract tvs @@ -5002,7 +5002,7 @@ and GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetI targetInfos // Used for the peephole optimization below -and (|BoolExpr|_|) = function Expr.Const(Const.Bool b1, _, _) -> Some(b1) | _ -> None +and (|BoolExpr|_|) = function Expr.Const (Const.Bool b1, _, _) -> Some b1 | _ -> None and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree failureTree targets repeatSP targetInfos sequel = let g = cenv.g @@ -5014,12 +5014,12 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree TDSuccess(es2, n2) when isNil es1 && isNil es2 && (match GetTarget targets n1, GetTarget targets n2 with - | TTarget(_, BoolExpr(b1), _), TTarget(_, BoolExpr(b2), _) -> b1 = not b2 + | TTarget(_, BoolExpr b1, _), TTarget(_, BoolExpr b2, _) -> b1 = not b2 | _ -> false) -> match GetTarget targets n1, GetTarget targets n2 with - | TTarget(_, BoolExpr(b1), _), _ -> + | TTarget(_, BoolExpr b1, _), _ -> GenExpr cenv cgbuf eenv SPSuppress e Continue match tester with | Some (pops, pushes, i) -> @@ -5028,7 +5028,7 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree | Choice2Of2 i -> CG.EmitInstr cgbuf pops pushes i | _ -> () if not b1 then - CG.EmitInstrs cgbuf (pop 0) (Push [g.ilg.typ_Bool]) [mkLdcInt32 (0) ] + CG.EmitInstrs cgbuf (pop 0) (Push [g.ilg.typ_Bool]) [mkLdcInt32 0 ] CG.EmitInstrs cgbuf (pop 1) Push0 [AI_ceq] GenSequel cenv cloc cgbuf sequel targetInfos @@ -5308,7 +5308,7 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) s let storage = StorageForVal m vspec eenv match storage, rhsExpr with // locals are zero-init, no need to initialize them - | Local (_, realloc, _), Expr.Const(Const.Zero, _, _) when not realloc -> + | Local (_, realloc, _), Expr.Const (Const.Zero, _, _) when not realloc -> CommitStartScope cgbuf startScopeMarkOpt | _ -> GenBindingRhs cenv cgbuf eenv SPSuppress vspec rhsExpr @@ -5410,7 +5410,7 @@ and GenMarshal cenv attribs = // the argument is a System.Type obj, but it's written to MD as a UTF8 string match decoder.FindTypeName "SafeArrayUserDefinedSubType" "" with | "" -> None - | res -> if (safeArraySubType = ILNativeVariant.IDispatch) || (safeArraySubType = ILNativeVariant.IUnknown) then Some(res) else None + | res -> if (safeArraySubType = ILNativeVariant.IDispatch) || (safeArraySubType = ILNativeVariant.IUnknown) then Some res else None ILNativeType.SafeArray(safeArraySubType, safeArrayUserDefinedSubType) | 0x1E -> ILNativeType.FixedArray (decoder.FindInt32 "SizeConst" 0x0) | 0x1F -> ILNativeType.Int @@ -5478,7 +5478,7 @@ and GenParams cenv eenv (mspec: ILMethodSpec) (attribs: ArgReprInfo list) method let argInfosAndTypes = match implValsOpt with - | Some(implVals) when (implVals.Length = ilArgTys.Length) -> + | Some implVals when (implVals.Length = ilArgTys.Length) -> List.map2 (fun x y -> x, Some y) argInfosAndTypes implVals | _ -> List.map (fun x -> x, None) argInfosAndTypes @@ -5497,7 +5497,7 @@ and GenParams cenv eenv (mspec: ILMethodSpec) (attribs: ArgReprInfo list) method match idOpt with | Some id -> let nm = if takenNames.Contains(id.idText) then globalNng.FreshCompilerGeneratedName (id.idText, id.idRange) else id.idText - Some nm, takenNames.Add(nm) + Some nm, takenNames.Add nm | None -> None, takenNames @@ -5673,7 +5673,7 @@ and GenMethodForBinding // Now generate the code. let hasPreserveSigNamedArg, ilMethodBody, hasDllImport = match TryFindFSharpAttributeOpt g g.attrib_DllImportAttribute v.Attribs with - | Some (Attrib(_, _, [ AttribStringArg(dll) ], namedArgs, _, _, m)) -> + | Some (Attrib(_, _, [ AttribStringArg dll ], namedArgs, _, _, m)) -> if not (isNil tps) then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(), m)) let hasPreserveSigNamedArg, mbody = GenPInvokeMethod (v.CompiledName, dll, namedArgs) hasPreserveSigNamedArg, mbody, true @@ -5708,7 +5708,7 @@ and GenMethodForBinding let sourceNameAttribs, compiledName = match v.Attribs |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_CompiledNameAttribute) with - | Some (Attrib(_, _, [ AttribStringArg(b) ], _, _, _, _)) -> [ mkCompilationSourceNameAttr g v.LogicalName ], Some b + | Some (Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> [ mkCompilationSourceNameAttr g v.LogicalName ], Some b | _ -> [], None // check if the hasPreserveSigNamedArg and hasSynchronizedImplFlag implementation flags have been specified @@ -5728,7 +5728,7 @@ and GenMethodForBinding yield! GenCompilationArgumentCountsAttr cenv v ] let ilTypars = GenGenericParams cenv eenvUnderMethLambdaTypars tps - let ilParams = GenParams cenv eenv mspec paramInfos methodArgTys (Some(nonUnitNonSelfMethodVars)) + let ilParams = GenParams cenv eenv mspec paramInfos methodArgTys (Some nonUnitNonSelfMethodVars) let ilReturn = GenReturnInfo cenv eenv mspec.FormalReturnType retInfo let methName = mspec.Name let tref = mspec.MethodRef.DeclaringTypeRef @@ -5763,10 +5763,10 @@ and GenMethodForBinding match v.MemberInfo with // don't generate unimplemented abstracts - | Some(memberInfo) when memberInfo.MemberFlags.IsDispatchSlot && not memberInfo.IsImplemented -> + | Some memberInfo when memberInfo.MemberFlags.IsDispatchSlot && not memberInfo.IsImplemented -> // skipping unimplemented abstract method () - | Some(memberInfo) when not v.IsExtensionMember -> + | Some memberInfo when not v.IsExtensionMember -> let ilMethTypars = ilTypars |> List.drop mspec.DeclaringType.GenericArgs.Length if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then @@ -5917,13 +5917,13 @@ and GenBindingRhs cenv cgbuf eenv sp (vspec: Val) e = let isLocalTypeFunc = IsNamedLocalTypeFuncVal g vspec e match e with - | Expr.TyLambda(_, tyargs, body, _, ttype) when + | Expr.TyLambda (_, tyargs, body, _, ttype) when ( tyargs |> List.forall (fun tp -> tp.IsErased) && (match StorageForVal vspec.Range vspec eenv with Local _ -> true | _ -> false) && (isLocalTypeFunc || (match ttype with - TType_var(typar) -> match typar.Solution with Some(TType_app(t, _))-> t.IsStructOrEnumTycon | _ -> false + TType_var typar -> match typar.Solution with Some(TType_app(t, _))-> t.IsStructOrEnumTycon | _ -> false | _ -> false)) ) -> // type lambda with erased type arguments that is stored as local variable (not method or property)- inline body @@ -5937,7 +5937,7 @@ and GenBindingRhs cenv cgbuf eenv sp (vspec: Val) e = and CommitStartScope cgbuf startScopeMarkOpt = match startScopeMarkOpt with | None -> () - | Some ss -> cgbuf.SetMarkToHere(ss) + | Some ss -> cgbuf.SetMarkToHere ss and EmitInitLocal cgbuf ty idx = CG.EmitInstrs cgbuf (pop 0) Push0 [I_ldloca (uint16 idx); (I_initobj ty) ] @@ -6175,11 +6175,11 @@ and GenAttribArg amap g eenv x (ilArgTy: ILType) = match x, ilArgTy with // Detect 'null' used for an array argument - | Expr.Const(Const.Zero, _, _), ILType.Array _ -> + | Expr.Const (Const.Zero, _, _), ILType.Array _ -> ILAttribElem.Null // Detect standard constants - | Expr.Const(c, m, _), _ -> + | Expr.Const (c, m, _), _ -> let tynm = ilArgTy.TypeSpec.Name let isobj = (tynm = "System.Object") @@ -6210,7 +6210,7 @@ and GenAttribArg amap g eenv x (ilArgTy: ILType) = | _ -> error (InternalError ( "The type '" + tynm + "' may not be used as a custom attribute value", m)) // Detect '[| ... |]' nodes - | Expr.Op(TOp.Array, [elemTy], args, m), _ -> + | Expr.Op (TOp.Array, [elemTy], args, m), _ -> let ilElemTy = GenType amap m eenv.tyenv elemTy ILAttribElem.Array (ilElemTy, List.map (fun arg -> GenAttribArg amap g eenv arg ilElemTy) args) @@ -6223,7 +6223,7 @@ and GenAttribArg amap g eenv x (ilArgTy: ILType) = ILAttribElem.TypeRef (Some (GenType amap x.Range eenv.tyenv ty).TypeRef) // Ignore upcasts - | Expr.Op(TOp.Coerce, _, [arg2], _), _ -> + | Expr.Op (TOp.Coerce, _, [arg2], _), _ -> GenAttribArg amap g eenv arg2 ilArgTy // Detect explicit enum values @@ -6261,8 +6261,8 @@ and GenAttr amap g eenv (Attrib(_, k, args, props, _, _, _)) = (s, ilTy, fld, cval)) let mspec = match k with - | ILAttrib(mref) -> mkILMethSpec(mref, AsObject, [], []) - | FSAttrib(vref) -> + | ILAttrib mref -> mkILMethSpec(mref, AsObject, [], []) + | FSAttrib vref -> assert(vref.IsMember) let mspec, _, _, _, _, _ = GetMethodSpecForMemberVal amap g (Option.get vref.MemberInfo) vref mspec @@ -6275,7 +6275,7 @@ and GenAttrs cenv eenv attrs = and GenCompilationArgumentCountsAttr cenv (v: Val) = let g = cenv.g [ match v.ValReprInfo with - | Some(tvi) when v.IsMemberOrModuleBinding -> + | Some tvi when v.IsMemberOrModuleBinding -> let arities = if ValSpecIsCompiledAsInstance g v then List.tail tvi.AritiesOfArgs else tvi.AritiesOfArgs if arities.Length > 1 then yield mkCompilationArgumentCountsAttr g arities @@ -6357,10 +6357,10 @@ and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x = | TMDefDo(e, _) -> GenExpr cenv cgbuf eenv SPAlways e discard - | TMAbstract(mexpr) -> + | TMAbstract mexpr -> GenModuleExpr cenv cgbuf qname lazyInitInfo eenv mexpr - | TMDefs(mdefs) -> + | TMDefs mdefs -> GenModuleDefs cenv cgbuf qname lazyInitInfo eenv mdefs @@ -6546,7 +6546,7 @@ and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile(qname, // of references to the cctor for nested modules etc. lazyInitInfo |> Seq.iter (fun f -> f fspec feefee seqpt) - if isScript && not(isFinalFile) then + if isScript && not isFinalFile then mgbuf.AddScriptInitFieldSpec(fspec, m) // Compute the ilxgenEnv after the generation of the module, i.e. the residue need to generate anything that @@ -6581,7 +6581,7 @@ and GenEqualsOverrideCallingIComparable cenv (tcref: TyconRef, ilThisTy, _ilThat yield I_callconstraint ( Normalcall, ilThisTy, mspec, None) else yield I_callvirt ( Normalcall, mspec, None) - yield mkLdcInt32 (0) + yield mkLdcInt32 0 yield AI_ceq ], None)) |> AddNonUserCompilerGeneratedAttribs g @@ -6617,7 +6617,11 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) = if mdef.IsVirtual then mdef.WithFinal(memberInfo.MemberFlags.IsFinal).WithAbstract(memberInfo.MemberFlags.IsDispatchSlot) else mdef - let mdef = mdef.WithPreserveSig(hasPreserveSigImplFlag).WithSynchronized(hasSynchronizedImplFlag).WithNoInlining(hasNoInliningFlag).WithAggressiveInlining(hasAggressiveInliningImplFlag) + let mdef = + mdef.WithPreserveSig(hasPreserveSigImplFlag) + .WithSynchronized(hasSynchronizedImplFlag) + .WithNoInlining(hasNoInliningFlag) + .WithAggressiveInlining(hasAggressiveInliningImplFlag) match memberInfo.MemberFlags.MemberKind with | MemberKind.ClassConstructor @@ -6785,7 +6789,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = | Some memberInfo -> match name, memberInfo.MemberFlags.MemberKind with | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal g vref.Deref)) -> - Some( mkILCustomAttribute g.ilg (g.FindSysILTypeRef "System.Reflection.DefaultMemberAttribute", [g.ilg.typ_String], [ILAttribElem.String(Some(name))], []) ) + Some( mkILCustomAttribute g.ilg (g.FindSysILTypeRef "System.Reflection.DefaultMemberAttribute", [g.ilg.typ_String], [ILAttribElem.String(Some name)], []) ) | _ -> None) |> Option.toList @@ -6867,7 +6871,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilFieldOffset = match TryFindFSharpAttribute g g.attrib_FieldOffsetAttribute fspec.FieldAttribs with - | Some (Attrib(_, _, [ AttribInt32Arg(fieldOffset) ], _, _, _, _)) -> + | Some (Attrib(_, _, [ AttribInt32Arg fieldOffset ], _, _, _, _)) -> Some fieldOffset | Some (Attrib(_, _, _, _, _, _, m)) -> errorR(Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded(), m)) @@ -7079,11 +7083,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilFields = mkILFields ilFieldDefs let tdef, tdefDiscards = - let isSerializable = (TryFindFSharpBoolAttribute g g.attrib_AutoSerializableAttribute tycon.Attribs <> Some(false)) + let isSerializable = (TryFindFSharpBoolAttribute g g.attrib_AutoSerializableAttribute tycon.Attribs <> Some false) match tycon.TypeReprInfo with | TILObjectRepr _ -> - let tdef = tycon.ILTyconRawMetadata.WithAccess(access) + let tdef = tycon.ILTyconRawMetadata.WithAccess access let tdef = tdef.With(customAttrs = mkILCustomAttrs ilCustomAttrs, genericParams = ilGenParams) tdef, None @@ -7130,7 +7134,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let tdLayout, tdEncoding = match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with - | Some (Attrib(_, _, [ AttribInt32Arg(layoutKind) ], namedArgs, _, _, _)) -> + | Some (Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> let decoder = AttributeDecoder namedArgs let ilPack = decoder.FindInt32 "Pack" 0x0 let ilSize = decoder.FindInt32 "Size" 0x0 @@ -7368,7 +7372,7 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = | None -> ilMethodDef | Some securityPermissionAttributeType -> { ilMethodDef with - SecurityDecls=mkILSecurityDecls [ IL.mkPermissionSet g.ilg (ILSecurityAction.Demand, [(securityPermissionAttributeType, [("SerializationFormatter", g.ilg.typ_Bool, ILAttribElem.Bool(true))])])] + SecurityDecls=mkILSecurityDecls [ IL.mkPermissionSet g.ilg (ILSecurityAction.Demand, [(securityPermissionAttributeType, [("SerializationFormatter", g.ilg.typ_Bool, ILAttribElem.Bool true)])])] HasSecurity=true } [ilCtorDefForSerialziation; getObjectDataMethodForSerialization] *) @@ -7486,7 +7490,7 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file Some(mbaseR, astExpr) with - | QuotationTranslator.InvalidQuotedTerm e -> warning(e); None) + | QuotationTranslator.InvalidQuotedTerm e -> warning e; None) let referencedTypeDefs, freeTypes, spliceArgExprs = qscope.Close() diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index 53fa7baa3..9097d2a96 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -29,7 +29,7 @@ module Zmap = try Zmap.find k mp with e -> dprintf "Zmap.force: %s %s\n" str (soK k) - PreserveStackTrace(e) + PreserveStackTrace e raise e //------------------------------------------------------------------------- @@ -1126,19 +1126,19 @@ module Pass4_RewriteAssembly = List.mapFold (fun z (tType, objExprs) -> let objExprs', z' = List.mapFold (TransMethod penv) z objExprs (tType, objExprs'), z') z iimpls - let expr = Expr.Obj(newUnique(), ty, basev, basecall, overrides, iimpls, m) + let expr = Expr.Obj (newUnique(), ty, basev, basecall, overrides, iimpls, m) let pds, z = ExtractPreDecs z MakePreDecs m pds expr, z (* if TopLevel, lift preDecs over the ilobj expr *) // lambda, tlambda - explicit lambda terms - | Expr.Lambda(_, ctorThisValOpt, baseValOpt, argvs, body, m, rty) -> + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, argvs, body, m, rty) -> let z = EnterInner z let body, z = TransExpr penv z body let z = ExitInner z let pds, z = ExtractPreDecs z MakePreDecs m pds (rebuildLambda m ctorThisValOpt baseValOpt argvs (body, rty)), z - | Expr.TyLambda(_, argtyvs, body, m, rty) -> + | Expr.TyLambda (_, argtyvs, body, m, rty) -> let z = EnterInner z let body, z = TransExpr penv z body let z = ExitInner z @@ -1147,7 +1147,7 @@ module Pass4_RewriteAssembly = /// Lifting TLR out over constructs (disabled) /// Lift minimally to ensure the defn is not lifted up and over defns on which it depends (disabled) - | Expr.Match(spBind, exprm, dtree, targets, m, ty) -> + | Expr.Match (spBind, exprm, dtree, targets, m, ty) -> let targets = Array.toList targets let dtree, z = TransDecisionTree penv z dtree let targets, z = List.mapFold (TransDecisionTreeTarget penv) z targets @@ -1161,19 +1161,19 @@ module Pass4_RewriteAssembly = | Expr.Quote (a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty) -> let argExprs,z = List.mapFold (TransExpr penv) z argExprs - Expr.Quote(a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty),z + Expr.Quote (a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty),z | Expr.Quote (a,{contents=None},isFromQueryExpression,m,ty) -> - Expr.Quote(a,{contents=None},isFromQueryExpression,m,ty),z + Expr.Quote (a,{contents=None},isFromQueryExpression,m,ty),z | Expr.Op (c,tyargs,args,m) -> let args,z = List.mapFold (TransExpr penv) z args - Expr.Op(c,tyargs,args,m),z + Expr.Op (c,tyargs,args,m),z | Expr.StaticOptimization (constraints,e2,e3,m) -> let e2,z = TransExpr penv z e2 let e3,z = TransExpr penv z e3 - Expr.StaticOptimization(constraints,e2,e3,m),z + Expr.StaticOptimization (constraints,e2,e3,m),z | Expr.TyChoose (_,_,m) -> error(Error(FSComp.SR.tlrUnexpectedTExpr(),m)) @@ -1185,7 +1185,7 @@ module Pass4_RewriteAssembly = | Expr.Sequential (e1, e2, dir, spSeq, m) -> let e1, z = TransExpr penv z e1 TransLinearExpr penv z e2 (contf << (fun (e2, z) -> - Expr.Sequential(e1, e2, dir, spSeq, m), z)) + Expr.Sequential (e1, e2, dir, spSeq, m), z)) // letrec - pass_recbinds does the work | Expr.LetRec (binds, e, m, _) -> @@ -1295,12 +1295,12 @@ module Pass4_RewriteAssembly = | TMDefDo(e, m) -> let _bind, z = TransExpr penv z e TMDefDo(e, m), z - | TMDefs(defs) -> + | TMDefs defs -> let defs, z = TransModuleDefs penv z defs - TMDefs(defs), z - | TMAbstract(mexpr) -> + TMDefs defs, z + | TMAbstract mexpr -> let mexpr, z = TransModuleExpr penv z mexpr - TMAbstract(mexpr), z + TMAbstract mexpr, z and TransModuleBindings penv z binds = List.mapFold (TransModuleBinding penv) z binds and TransModuleBinding penv z x = match x with diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 9e8206ca7..c7a5489dc 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -196,7 +196,7 @@ let rec isIfBlockContinuator token = | END | RPAREN -> true // The following arise during reprocessing of the inserted tokens, e.g. when we hit a DONE | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true - | ODUMMY(token) -> isIfBlockContinuator(token) + | ODUMMY token -> isIfBlockContinuator token | _ -> false /// Determine the token that may align with the 'try' of a 'try/catch' or 'try/finally' without closing @@ -209,14 +209,14 @@ let rec isTryBlockContinuator token = | FINALLY | WITH -> true // The following arise during reprocessing of the inserted tokens when we hit a DONE | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true - | ODUMMY(token) -> isTryBlockContinuator(token) + | ODUMMY token -> isTryBlockContinuator token | _ -> false let rec isThenBlockContinuator token = match token with // The following arise during reprocessing of the inserted tokens when we hit a DONE | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true - | ODUMMY(token) -> isThenBlockContinuator(token) + | ODUMMY token -> isThenBlockContinuator token | _ -> false let rec isDoContinuator token = @@ -228,7 +228,7 @@ let rec isDoContinuator token = // done *) | DONE -> true | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true // The following arise during reprocessing of the inserted tokens when we hit a DONE - | ODUMMY(token) -> isDoContinuator(token) + | ODUMMY token -> isDoContinuator token | _ -> false let rec isInterfaceContinuator token = @@ -239,7 +239,7 @@ let rec isInterfaceContinuator token = // end | END -> true | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true // The following arise during reprocessing of the inserted tokens when we hit a DONE - | ODUMMY(token) -> isInterfaceContinuator(token) + | ODUMMY token -> isInterfaceContinuator token | _ -> false let rec isNamespaceContinuator token = @@ -250,7 +250,7 @@ let rec isNamespaceContinuator token = // namespace <-- here // .... | Parser.EOF _ | NAMESPACE -> false - | ODUMMY(token) -> isNamespaceContinuator token + | ODUMMY token -> isNamespaceContinuator token | _ -> true // anything else is a namespace continuator let rec isTypeContinuator token = @@ -276,7 +276,7 @@ let rec isTypeContinuator token = // The following arise during reprocessing of the inserted tokens when we hit a DONE | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true - | ODUMMY(token) -> isTypeContinuator(token) + | ODUMMY token -> isTypeContinuator token | _ -> false let rec isForLoopContinuator token = @@ -287,7 +287,7 @@ let rec isForLoopContinuator token = // done | DONE -> true | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true// The following arise during reprocessing of the inserted tokens when we hit a DONE - | ODUMMY(token) -> isForLoopContinuator(token) + | ODUMMY token -> isForLoopContinuator token | _ -> false let rec isWhileBlockContinuator token = @@ -298,7 +298,7 @@ let rec isWhileBlockContinuator token = // done | DONE -> true | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true // The following arise during reprocessing of the inserted tokens when we hit a DONE - | ODUMMY(token) -> isWhileBlockContinuator(token) + | ODUMMY token -> isWhileBlockContinuator token | _ -> false let rec isLetContinuator token = @@ -308,7 +308,7 @@ let rec isLetContinuator token = // and ... | AND -> true | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true // The following arise during reprocessing of the inserted tokens when we hit a DONE - | ODUMMY(token) -> isLetContinuator(token) + | ODUMMY token -> isLetContinuator token | _ -> false let rec isTypeSeqBlockElementContinuator token = @@ -321,7 +321,7 @@ let rec isTypeSeqBlockElementContinuator token = // member x.M2 | BAR -> true | OBLOCKBEGIN | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true // The following arise during reprocessing of the inserted tokens when we hit a DONE - | ODUMMY(token) -> isTypeSeqBlockElementContinuator token + | ODUMMY token -> isTypeSeqBlockElementContinuator token | _ -> false // Work out when a token doesn't terminate a single item in a sequence definition @@ -345,7 +345,7 @@ let rec isSeqBlockElementContinuator token = // The following arise during reprocessing of the inserted tokens when we hit a DONE | ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true - | ODUMMY(token) -> isSeqBlockElementContinuator token + | ODUMMY token -> isSeqBlockElementContinuator token | _ -> false let rec isWithAugmentBlockContinuator token = @@ -356,7 +356,7 @@ let rec isWithAugmentBlockContinuator token = // member ... // end | END -> true - | ODUMMY(token) -> isWithAugmentBlockContinuator(token) + | ODUMMY token -> isWithAugmentBlockContinuator token | _ -> false let isLongIdentifier token = (match token with IDENT _ | DOT -> true | _ -> false) @@ -421,7 +421,7 @@ type TokenTup = member x.EndPos = x.LexbufState.EndPos /// Returns a token 'tok' with the same position as this token - member x.UseLocation(tok) = + member x.UseLocation tok = let tokState = x.LexbufState TokenTup(tok, LexbufState(tokState.StartPos, tokState.EndPos, false), x.LastTokenPos) @@ -430,8 +430,8 @@ type TokenTup = /// Note: positive value means shift to the right in both cases member x.UseShiftedLocation(tok, shiftLeft, shiftRight) = let tokState = x.LexbufState - TokenTup(tok, LexbufState(tokState.StartPos.ShiftColumnBy(shiftLeft), - tokState.EndPos.ShiftColumnBy(shiftRight), false), x.LastTokenPos) + TokenTup(tok, LexbufState(tokState.StartPos.ShiftColumnBy shiftLeft, + tokState.EndPos.ShiftColumnBy shiftRight, false), x.LastTokenPos) @@ -472,20 +472,20 @@ let (|TyparsCloseOp|_|) (txt: string) = | ('!' :: '=' :: _) | ('<' :: _) | ('>' :: _) - | ('$' :: _) -> Some (INFIX_COMPARE_OP(s)) - | ('&' :: _) -> Some (INFIX_AMP_OP(s)) - | ('|' :: _) -> Some (INFIX_BAR_OP(s)) + | ('$' :: _) -> Some (INFIX_COMPARE_OP s) + | ('&' :: _) -> Some (INFIX_AMP_OP s) + | ('|' :: _) -> Some (INFIX_BAR_OP s) | ('!' :: _) | ('?' :: _) - | ('~' :: _) -> Some (PREFIX_OP(s)) + | ('~' :: _) -> Some (PREFIX_OP s) | ('@' :: _) - | ('^' :: _) -> Some (INFIX_AT_HAT_OP(s)) + | ('^' :: _) -> Some (INFIX_AT_HAT_OP s) | ('+' :: _) - | ('-' :: _) -> Some (PLUS_MINUS_OP(s)) - | ('*' :: '*' :: _) -> Some (INFIX_STAR_STAR_OP(s)) + | ('-' :: _) -> Some (PLUS_MINUS_OP s) + | ('*' :: '*' :: _) -> Some (INFIX_STAR_STAR_OP s) | ('*' :: _) | ('/' :: _) - | ('%' :: _) -> Some (INFIX_STAR_DIV_MOD_OP(s)) + | ('%' :: _) -> Some (INFIX_STAR_DIV_MOD_OP s) | _ -> None Some([| for _c in angles do yield GREATER |], afterOp) @@ -888,7 +888,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // On successful parse of a set of type parameters, look for an adjacent (, e.g. // M(args) // and insert a HIGH_PRECEDENCE_PAREN_APP - if not hasAfterOp && (match nextTokenIsAdjacentLParenOrLBrack lookaheadTokenTup with Some(LPAREN) -> true | _ -> false) then + if not hasAfterOp && (match nextTokenIsAdjacentLParenOrLBrack lookaheadTokenTup with Some LPAREN -> true | _ -> false) then let dotTokenTup = peekNextTokenTup() stack := (dotTokenTup.UseLocation(HIGH_PRECEDENCE_PAREN_APP), false) :: !stack true @@ -988,8 +988,8 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, //-------------------------------------------------------------------------- let returnToken (tokenLexbufState: LexbufState) tok = - setLexbufState(tokenLexbufState) - prevWasAtomicEnd <- isAtomicExprEndToken(tok) + setLexbufState tokenLexbufState + prevWasAtomicEnd <- isAtomicExprEndToken tok tok let rec suffixExists p l = match l with [] -> false | _::t -> p t || suffixExists p t @@ -1040,8 +1040,8 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let rec hwTokenFetch (useBlockRule) = let tokenTup = popNextTokenTup() - let tokenReplaced = rulesForBothSoftWhiteAndHardWhite(tokenTup) - if tokenReplaced then hwTokenFetch(useBlockRule) else + let tokenReplaced = rulesForBothSoftWhiteAndHardWhite tokenTup + if tokenReplaced then hwTokenFetch useBlockRule else let tokenStartPos = (startPosOfTokenTup tokenTup) let token = tokenTup.Token @@ -1089,11 +1089,11 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let reprocess() = delayToken tokenTup - hwTokenFetch(useBlockRule) + hwTokenFetch useBlockRule let reprocessWithoutBlockRule() = delayToken tokenTup - hwTokenFetch(false) + hwTokenFetch false let insertTokenFromPrevPosToCurrentPos tok = delayToken tokenTup @@ -1198,7 +1198,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, if not compilingFsLib then // ... <<< code with unmatched ( or [ or { or [| >>> ... "type" ... // We want a TYPE or MODULE keyword to close any currently-open "expression" contexts, as though there were close delimiters in the file, so: - let rec nextOuterMostInterestingContextIsNamespaceOrModule(offsideStack) = + let rec nextOuterMostInterestingContextIsNamespaceOrModule offsideStack = match offsideStack with // next outermost is namespace or module | _ :: (CtxtNamespaceBody _ | CtxtModuleBody _) :: _ -> true @@ -1209,7 +1209,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | _ :: [] -> true // anything else is a non-namespace/module | _ -> false - while not offsideStack.IsEmpty && (not(nextOuterMostInterestingContextIsNamespaceOrModule(offsideStack))) && + while not offsideStack.IsEmpty && (not(nextOuterMostInterestingContextIsNamespaceOrModule offsideStack)) && (match offsideStack.Head with // open-parens of sorts | CtxtParen((LPAREN|LBRACK|LBRACE|LBRACE_BAR|LBRACK_BAR), _) -> true @@ -1227,7 +1227,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, popCtxt() effectsToDo <- (fun() -> if debug then dprintf "--> because %s is coming, inserting OBLOCKEND\n" keywordName - delayTokenNoProcessing (tokenTup.UseLocation(OBLOCKEND))) :: effectsToDo + delayTokenNoProcessing (tokenTup.UseLocation OBLOCKEND)) :: effectsToDo | CtxtSeqBlock(_, _, NoAddBlockEnd) -> if debug then dprintf "--> because %s is coming, popping CtxtSeqBlock\n" keywordName popCtxt() @@ -1240,14 +1240,14 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, if debug then dprintf "--> because %s is coming, popping CtxtVanilla\n" keywordName popCtxt() | _ -> failwith "impossible, the while loop guard just above prevents this" - // See bugs 91609/92107/245850; we turn ...TYPE... into ...TYPE_COMING_SOON(x6), TYPE_IS_HERE... to help the parser recover when it sees "type" in a parenthesized expression. + // See bugs 91609/92107/245850; we turn ...TYPE... into ...TYPE_COMING_SOON x6, TYPE_IS_HERE... to help the parser recover when it sees "type" in a parenthesized expression. // And we do the same thing for MODULE. // Why _six_ TYPE_COMING_SOON? It's rather arbitrary, this means we can recover from up to six unmatched parens before failing. The unit tests (with 91609 in the name) demonstrate this. // Don't "delayToken tokenTup", we are replacing it, so consume it. if debug then dprintf "inserting 6 copies of %+A before %+A\n" comingSoon isHere - delayTokenNoProcessing (tokenTup.UseLocation(isHere)) + delayTokenNoProcessing (tokenTup.UseLocation isHere) for i in 1..6 do - delayTokenNoProcessing (tokenTup.UseLocation(comingSoon)) + delayTokenNoProcessing (tokenTup.UseLocation comingSoon) for e in List.rev effectsToDo do e() // push any END tokens after pushing the TYPE_IS_HERE and TYPE_COMING_SOON stuff, so that they come before those in the token stream @@ -1271,7 +1271,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // reset on ';;' rule. A ';;' terminates ALL entries | SEMICOLON_SEMICOLON, [] -> if debug then dprintf ";; scheduling a reset\n" - delayToken(tokenTup.UseLocation(ORESET)) + delayToken(tokenTup.UseLocation ORESET) returnToken tokenLexbufState SEMICOLON_SEMICOLON | ORESET, [] -> @@ -1279,7 +1279,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // NOTE: The parser thread of F# Interactive will often be blocked on this call, e.g. after an entry has been // processed and we're waiting for the first token of the next entry. peekInitial() |> ignore - hwTokenFetch(true) + hwTokenFetch true | IN, stack when detectJoinInCtxt stack -> @@ -1292,7 +1292,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, if tokenStartCol < offsidePos.Column then warn tokenTup (FSComp.SR.lexfltIncorrentIndentationOfIn()) popCtxt() // Make sure we queue a dummy token at this position to check if any other pop rules apply - delayToken(tokenTup.UseLocation(ODUMMY(token))) + delayToken(tokenTup.UseLocation(ODUMMY token)) returnToken tokenLexbufState (if blockLet then ODECLEND else token) // Balancing rule. Encountering a 'done' balances with a 'do'. i.e. even a non-offside 'done' closes a 'do' @@ -1301,8 +1301,8 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, if debug then dprintf "DONE at %a terminates CtxtDo(offsidePos=%a)\n" outputPos tokenStartPos outputPos offsidePos popCtxt() // reprocess as the DONE may close a DO context - delayToken(tokenTup.UseLocation(ODECLEND)) - hwTokenFetch(useBlockRule) + delayToken(tokenTup.UseLocation ODECLEND) + hwTokenFetch useBlockRule // Balancing rule. Encountering a ')' or '}' balances with a '(' or '{', even if not offside | ((END | RPAREN | RBRACE | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ | GREATER true) as t2), (CtxtParen (t1, _) :: _) @@ -1310,15 +1310,15 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, if debug then dprintf "RPAREN/RBRACE/BAR_RBRACE/RBRACK/BAR_RBRACK/RQUOTE/END at %a terminates CtxtParen()\n" outputPos tokenStartPos popCtxt() // Queue a dummy token at this position to check if any closing rules apply - delayToken(tokenTup.UseLocation(ODUMMY(token))) + delayToken(tokenTup.UseLocation(ODUMMY token)) returnToken tokenLexbufState token // Balancing rule. Encountering a 'end' can balance with a 'with' but only when not offside - | END, (CtxtWithAsAugment(offsidePos) :: _) + | END, (CtxtWithAsAugment offsidePos :: _) when not (tokenStartCol + 1 <= offsidePos.Column) -> if debug then dprintf "END at %a terminates CtxtWithAsAugment()\n" outputPos tokenStartPos popCtxt() - delayToken(tokenTup.UseLocation(ODUMMY(token))) // make sure we queue a dummy token at this position to check if any closing rules apply + delayToken(tokenTup.UseLocation(ODUMMY token)) // make sure we queue a dummy token at this position to check if any closing rules apply returnToken tokenLexbufState OEND // Transition rule. CtxtNamespaceHead ~~~> CtxtSeqBlock @@ -1342,7 +1342,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, delayToken tokenTup pushCtxt tokenTup (CtxtNamespaceBody namespaceTokenPos) pushCtxtSeqBlockAt (tokenTup, true, AddBlockEnd) - hwTokenFetch(false) + hwTokenFetch false // Transition rule. CtxtModuleHead ~~~> push CtxtModuleBody; push CtxtSeqBlock // Applied when a ':' or '=' token is seen @@ -1377,7 +1377,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, delayToken tokenTup pushCtxt tokenTup (CtxtModuleBody (moduleTokenPos, true)) pushCtxtSeqBlockAt (tokenTup, true, AddBlockEnd) - hwTokenFetch(false) + hwTokenFetch false // Offside rule for SeqBlock. // f x @@ -1572,13 +1572,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, reprocess() // Pop CtxtMemberBody when offside. Insert an ODECLEND to indicate the end of the member - | _, ((CtxtMemberBody(offsidePos)) :: _) when isSemiSemi || tokenStartCol <= offsidePos.Column -> + | _, ((CtxtMemberBody offsidePos) :: _) when isSemiSemi || tokenStartCol <= offsidePos.Column -> if debug then dprintf "token at column %d is offside from MEMBER/OVERRIDE head with offsidePos %a!\n" tokenStartCol outputPos offsidePos popCtxt() insertToken ODECLEND // Pop CtxtMemberHead when offside - | _, ((CtxtMemberHead(offsidePos)) :: _) when isSemiSemi || tokenStartCol <= offsidePos.Column -> + | _, ((CtxtMemberHead offsidePos) :: _) when isSemiSemi || tokenStartCol <= offsidePos.Column -> if debug then dprintf "token at column %d is offside from MEMBER/OVERRIDE head with offsidePos %a!\n" tokenStartCol outputPos offsidePos popCtxt() reprocess() @@ -1595,7 +1595,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, popCtxt() insertToken OEND - | _, (CtxtWithAsAugment(offsidePos) :: _) + | _, (CtxtWithAsAugment offsidePos :: _) when isSemiSemi || (if isWithAugmentBlockContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> if debug then dprintf "offside from CtxtWithAsAugment, isWithAugmentBlockContinuator = %b\n" (isWithAugmentBlockContinuator token) popCtxt() @@ -1690,7 +1690,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, insertComingSoonTokens("MODULE", MODULE_COMING_SOON, MODULE_IS_HERE) if debug then dprintf "MODULE: entering CtxtModuleHead, awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtModuleHead (tokenStartPos, token)) - hwTokenFetch(useBlockRule) + hwTokenFetch useBlockRule // exception ... ~~~> CtxtException | EXCEPTION, (_ :: _) -> @@ -1701,24 +1701,24 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // let ... ~~~> CtxtLetDecl // -- this rule only applies to // - 'static let' - | LET(isUse), (ctxt :: _) when (match ctxt with CtxtMemberHead _ -> true | _ -> false) -> + | LET isUse, (ctxt :: _) when (match ctxt with CtxtMemberHead _ -> true | _ -> false) -> if debug then dprintf "LET: entering CtxtLetDecl(), awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos let startPos = match ctxt with CtxtMemberHead startPos -> startPos | _ -> tokenStartPos popCtxt() // get rid of the CtxtMemberHead pushCtxt tokenTup (CtxtLetDecl(true, startPos)) - returnToken tokenLexbufState (OLET(isUse)) + returnToken tokenLexbufState (OLET isUse) // let ... ~~~> CtxtLetDecl // -- this rule only applies to // - 'let' 'right-on' a SeqBlock line // - 'let' in a CtxtMatchClauses, which is a parse error, but we need to treat as OLET to get various O...END tokens to enable parser to recover - | LET(isUse), (ctxt :: _) -> + | LET isUse, (ctxt :: _) -> let blockLet = match ctxt with | CtxtSeqBlock _ -> true | CtxtMatchClauses _ -> true | _ -> false if debug then dprintf "LET: entering CtxtLetDecl(blockLet=%b), awaiting EQUALS to go to CtxtSeqBlock (%a)\n" blockLet outputPos tokenStartPos pushCtxt tokenTup (CtxtLetDecl(blockLet, tokenStartPos)) - returnToken tokenLexbufState (if blockLet then OLET(isUse) else token) + returnToken tokenLexbufState (if blockLet then OLET isUse else token) // let! ... ~~~> CtxtLetDecl | BINDER b, (ctxt :: _) -> @@ -1738,12 +1738,12 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | Some tok -> popCtxt() if debug then dprintf "--> inserting %+A\n" tok - delayTokenNoProcessing (tokenTup.UseLocation(tok)) + delayTokenNoProcessing (tokenTup.UseLocation tok) // for the rest, we silently pop them | _ -> popCtxt() popCtxt() // pop CtxtMemberBody if debug then dprintf "...STATIC/MEMBER/OVERRIDE/DEFAULT: finished popping all that context\n" - hwTokenFetch(useBlockRule) + hwTokenFetch useBlockRule // static member ... ~~~> CtxtMemberHead // static ... ~~~> CtxtMemberHead @@ -1753,19 +1753,19 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // val ... ~~~> CtxtMemberHead | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), (ctxt :: _) when (match ctxt with CtxtMemberHead _ -> false | _ -> true) -> if debug then dprintf "STATIC/MEMBER/OVERRIDE/DEFAULT: entering CtxtMemberHead, awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtMemberHead(tokenStartPos)) + pushCtxt tokenTup (CtxtMemberHead tokenStartPos) returnToken tokenLexbufState token // public new... ~~~> CtxtMemberHead | (PUBLIC | PRIVATE | INTERNAL), (_ctxt :: _) when (match peekNextToken() with NEW -> true | _ -> false) -> if debug then dprintf "PUBLIC/PRIVATE/INTERNAL NEW: entering CtxtMemberHead, awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtMemberHead(tokenStartPos)) + pushCtxt tokenTup (CtxtMemberHead tokenStartPos) returnToken tokenLexbufState token // new( ~~~> CtxtMemberHead, if not already there because of 'public' | NEW, ctxt :: _ when (match peekNextToken() with LPAREN -> true | _ -> false) && (match ctxt with CtxtMemberHead _ -> false | _ -> true) -> if debug then dprintf "NEW: entering CtxtMemberHead, awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtMemberHead(tokenStartPos)) + pushCtxt tokenTup (CtxtMemberHead tokenStartPos) returnToken tokenLexbufState token // 'let ... = ' ~~~> CtxtSeqBlock @@ -1817,7 +1817,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // 'static member ... =' ~~~> CtxtMemberBody, CtxtSeqBlock // 'default ... =' ~~~> CtxtMemberBody, CtxtSeqBlock // 'override ... =' ~~~> CtxtMemberBody, CtxtSeqBlock - | EQUALS, ((CtxtMemberHead(offsidePos)) :: _) -> + | EQUALS, ((CtxtMemberHead offsidePos) :: _) -> if debug then dprintf "CtxtMemberHead: EQUALS, pushing CtxtSeqBlock\n" replaceCtxt tokenTup (CtxtMemberBody (offsidePos)) pushCtxtSeqBlock(true, AddBlockEnd) @@ -1915,7 +1915,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // as well as: // member x.PublicGetSetProperty // with inline get() = "Ralf" - // and [] set(v) = () + // and [] set v = () // | PUBLIC | PRIVATE | INTERNAL | INLINE -> @@ -1941,7 +1941,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // So we're careful to set the offside column to be the minimum required *) limCtxt.StartPos if debug then dprintf "WITH, pushing CtxtWithAsLet, tokenStartPos = %a, lookaheadTokenStartPos = %a\n" outputPos tokenStartPos outputPos lookaheadTokenStartPos - pushCtxt tokenTup (CtxtWithAsLet(offsidePos)) + pushCtxt tokenTup (CtxtWithAsLet offsidePos) // Detect 'with' bindings of the form // @@ -1970,7 +1970,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // with [] get() = "Ralf" if (match lookaheadTokenTup.Token with LBRACK_LESS -> true | _ -> false) && (lookaheadTokenStartPos.OriginalLine = tokenTup.StartPos.OriginalLine) then let offsidePos = tokenStartPos - pushCtxt tokenTup (CtxtWithAsLet(offsidePos)) + pushCtxt tokenTup (CtxtWithAsLet offsidePos) returnToken tokenLexbufState OWITH else // In these situations @@ -1991,14 +1991,14 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // The limit is "interface"/"exception"/"type" let offsidePos = limCtxt.StartPos - pushCtxt tokenTup (CtxtWithAsAugment(offsidePos)) + pushCtxt tokenTup (CtxtWithAsAugment offsidePos) pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | WITH, stack -> if debug then dprintf "WITH\n" if debug then dprintf "WITH --> NO MATCH, pushing CtxtWithAsAugment (type augmentation), stack = %A" stack - pushCtxt tokenTup (CtxtWithAsAugment(tokenStartPos)) + pushCtxt tokenTup (CtxtWithAsAugment tokenStartPos) pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token @@ -2006,13 +2006,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let lookaheadTokenTup = peekNextTokenTup() let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup let leadingBar = match (peekNextToken()) with BAR -> true | _ -> false - pushCtxt tokenTup (CtxtFunction(tokenStartPos)) + pushCtxt tokenTup (CtxtFunction tokenStartPos) pushCtxt lookaheadTokenTup (CtxtMatchClauses(leadingBar, lookaheadTokenStartPos)) returnToken tokenLexbufState OFUNCTION | THEN, _ -> if debug then dprintf "THEN, replacing THEN with OTHEN, pushing CtxtSeqBlock;CtxtThen(%a)\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtThen(tokenStartPos)) + pushCtxt tokenTup (CtxtThen tokenStartPos) pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState OTHEN @@ -2028,12 +2028,12 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // else if e5 then e6 let _ = popNextTokenTup() if debug then dprintf "ELSE IF: replacing ELSE IF with ELIF, pushing CtxtIf, CtxtVanilla(%a)\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtIf(tokenStartPos)) + pushCtxt tokenTup (CtxtIf tokenStartPos) returnToken tokenLexbufState ELIF | _ -> if debug then dprintf "ELSE: replacing ELSE with OELSE, pushing CtxtSeqBlock, CtxtElse(%a)\n" outputPos lookaheadTokenStartPos - pushCtxt tokenTup (CtxtElse(tokenStartPos)) + pushCtxt tokenTup (CtxtElse tokenStartPos) pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState OELSE @@ -2081,7 +2081,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // type C = interface .... with | _ -> if debug then dprintf "INTERFACE, pushing CtxtInterfaceHead, tokenStartPos = %a, lookaheadTokenStartPos = %a\n" outputPos tokenStartPos outputPos lookaheadTokenStartPos - pushCtxt tokenTup (CtxtInterfaceHead(tokenStartPos)) + pushCtxt tokenTup (CtxtInterfaceHead tokenStartPos) returnToken tokenLexbufState OINTERFACE_MEMBER | CLASS, _ -> @@ -2093,8 +2093,8 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | TYPE, _ -> insertComingSoonTokens("TYPE", TYPE_COMING_SOON, TYPE_IS_HERE) if debug then dprintf "TYPE, pushing CtxtTypeDefns(%a)\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtTypeDefns(tokenStartPos)) - hwTokenFetch(useBlockRule) + pushCtxt tokenTup (CtxtTypeDefns tokenStartPos) + hwTokenFetch useBlockRule | TRY, _ -> if debug then dprintf "Try, pushing CtxtTry(%a)\n" outputPos tokenStartPos @@ -2131,11 +2131,11 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, if debug then dprintf "inserting HIGH_PRECEDENCE_PAREN_APP at dotTokenPos = %a\n" outputPos (startPosOfTokenTup dotTokenTup) let hpa = match nextTokenIsAdjacentLParenOrLBrack tokenTup with - | Some(LPAREN) -> HIGH_PRECEDENCE_PAREN_APP - | Some(LBRACK) -> HIGH_PRECEDENCE_BRACK_APP + | Some LPAREN -> HIGH_PRECEDENCE_PAREN_APP + | Some LBRACK -> HIGH_PRECEDENCE_BRACK_APP | _ -> failwith "unreachable" - delayToken(dotTokenTup.UseLocation(hpa)) - delayToken(tokenTup) + delayToken(dotTokenTup.UseLocation hpa) + delayToken tokenTup true // Insert HIGH_PRECEDENCE_TYAPP if needed @@ -2193,7 +2193,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | _ -> failwith "unreachable" let token = ADJACENT_PREFIX_OP tokenName delayToken nextTokenTup - delayToken (tokenTup.UseLocation(token)) + delayToken (tokenTup.UseLocation token) if plusOrMinus then match nextTokenTup.Token with @@ -2202,10 +2202,10 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | INT32(v, bad) -> delayMergedToken(INT32((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not | INT32_DOT_DOT(v, bad) -> delayMergedToken(INT32_DOT_DOT((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not | INT64(v, bad) -> delayMergedToken(INT64((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not - | NATIVEINT(v) -> delayMergedToken(NATIVEINT(if plus then v else -v)) - | IEEE32(v) -> delayMergedToken(IEEE32(if plus then v else -v)) - | IEEE64(v) -> delayMergedToken(IEEE64(if plus then v else -v)) - | DECIMAL(v) -> delayMergedToken(DECIMAL(if plus then v else System.Decimal.op_UnaryNegation v)) + | NATIVEINT v -> delayMergedToken(NATIVEINT(if plus then v else -v)) + | IEEE32 v -> delayMergedToken(IEEE32(if plus then v else -v)) + | IEEE64 v -> delayMergedToken(IEEE64(if plus then v else -v)) + | DECIMAL v -> delayMergedToken(DECIMAL(if plus then v else System.Decimal.op_UnaryNegation v)) | BIGNUM(v, s) -> delayMergedToken(BIGNUM((if plus then v else "-" + v), s)) | _ -> noMerge() else @@ -2219,12 +2219,12 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, and pushCtxtSeqBlockAt(p: TokenTup, addBlockBegin, addBlockEnd) = if addBlockBegin then if debug then dprintf "--> insert OBLOCKBEGIN \n" - delayToken(p.UseLocation(OBLOCKBEGIN)) + delayToken(p.UseLocation OBLOCKBEGIN) pushCtxt p (CtxtSeqBlock(FirstInSeqBlock, startPosOfTokenTup p, addBlockEnd)) let rec swTokenFetch() = let tokenTup = popNextTokenTup() - let tokenReplaced = rulesForBothSoftWhiteAndHardWhite(tokenTup) + let tokenReplaced = rulesForBothSoftWhiteAndHardWhite tokenTup if tokenReplaced then swTokenFetch() else returnToken tokenTup.LexbufState tokenTup.Token @@ -2239,7 +2239,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, () if lightSyntaxStatus.Status - then hwTokenFetch(true) + then hwTokenFetch true else swTokenFetch() @@ -2263,9 +2263,9 @@ type LexFilter (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, lex let insertComingSoonTokens comingSoon isHere = if debug then dprintf "inserting 6 copies of %+A before %+A\n" comingSoon isHere - delayToken(isHere) + delayToken isHere for i in 1..6 do - delayToken(comingSoon) + delayToken comingSoon member __.LexBuffer = inner.LexBuffer member __.Lexer _ = diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index 087d49f39..a0b484d88 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -24,13 +24,13 @@ open FSharp.Compiler.MethodCalls let InterceptExpr g cont expr = match expr with - | Expr.Val(vref, flags, m) -> + | Expr.Val (vref, flags, m) -> match vref.ValReprInfo with | Some arity -> Some (fst (AdjustValForExpectedArity g m vref flags arity)) | None -> None // App (Val v, tys, args) - | Expr.App((Expr.Val (vref, flags, _) as f0), f0ty, tyargsl, argsl, m) -> + | Expr.App ((Expr.Val (vref, flags, _) as f0), f0ty, tyargsl, argsl, m) -> // Only transform if necessary, i.e. there are not enough arguments match vref.ValReprInfo with | Some(topValInfo) -> @@ -43,7 +43,7 @@ let InterceptExpr g cont expr = Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m)) | None -> None - | Expr.App(f0, f0ty, tyargsl, argsl, m) -> + | Expr.App (f0, f0ty, tyargsl, argsl, m) -> Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m) ) | _ -> None @@ -113,7 +113,7 @@ let LowerSeqExpr g amap overallExpr = /// Detect a 'yield x' within a 'seq { ... }' let (|SeqYield|_|) expr = match expr with - | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg], m) when valRefEq g vref g.seq_singleton_vref -> + | Expr.App (Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg], m) when valRefEq g vref g.seq_singleton_vref -> Some (arg, m) | _ -> None @@ -121,7 +121,7 @@ let LowerSeqExpr g amap overallExpr = /// Detect a 'expr; expr' within a 'seq { ... }' let (|SeqAppend|_|) expr = match expr with - | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg1;arg2], m) when valRefEq g vref g.seq_append_vref -> + | Expr.App (Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg1;arg2], m) when valRefEq g vref g.seq_append_vref -> Some (arg1, arg2, m) | _ -> None @@ -129,7 +129,7 @@ let LowerSeqExpr g amap overallExpr = /// Detect a 'while gd do expr' within a 'seq { ... }' let (|SeqWhile|_|) expr = match expr with - | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [Expr.Lambda(_, _, _, [dummyv], gd, _, _);arg2], m) + | Expr.App (Expr.Val (vref, _, _), _f0ty, _tyargsl, [Expr.Lambda (_, _, _, [dummyv], gd, _, _);arg2], m) when valRefEq g vref g.seq_generated_vref && not (isVarFreeInExpr dummyv gd) -> Some (gd, arg2, m) @@ -138,7 +138,7 @@ let LowerSeqExpr g amap overallExpr = let (|SeqTryFinally|_|) expr = match expr with - | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg1;Expr.Lambda(_, _, _, [dummyv], compensation, _, _)], m) + | Expr.App (Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg1;Expr.Lambda (_, _, _, [dummyv], compensation, _, _)], m) when valRefEq g vref g.seq_finally_vref && not (isVarFreeInExpr dummyv compensation) -> Some (arg1, compensation, m) @@ -147,7 +147,7 @@ let LowerSeqExpr g amap overallExpr = let (|SeqUsing|_|) expr = match expr with - | Expr.App(Expr.Val (vref, _, _), _f0ty, [_;_;elemTy], [resource;Expr.Lambda(_, _, _, [v], body, _, _)], m) + | Expr.App (Expr.Val (vref, _, _), _f0ty, [_;_;elemTy], [resource;Expr.Lambda (_, _, _, [v], body, _, _)], m) when valRefEq g vref g.seq_using_vref -> Some (resource, v, body, elemTy, m) | _ -> @@ -156,27 +156,27 @@ let LowerSeqExpr g amap overallExpr = let (|SeqFor|_|) expr = match expr with // Nested for loops are represented by calls to Seq.collect - | Expr.App(Expr.Val (vref, _, _), _f0ty, [_inpElemTy;_enumty2;genElemTy], [Expr.Lambda(_, _, _, [v], body, _, _); inp], m) when valRefEq g vref g.seq_collect_vref -> + | Expr.App (Expr.Val (vref, _, _), _f0ty, [_inpElemTy;_enumty2;genElemTy], [Expr.Lambda (_, _, _, [v], body, _, _); inp], m) when valRefEq g vref g.seq_collect_vref -> Some (inp, v, body, genElemTy, m) // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. - | Expr.App(Expr.Val (vref, _, _), _f0ty, [_inpElemTy;genElemTy], [Expr.Lambda(_, _, _, [v], body, _, _); inp], m) when valRefEq g vref g.seq_map_vref -> + | Expr.App (Expr.Val (vref, _, _), _f0ty, [_inpElemTy;genElemTy], [Expr.Lambda (_, _, _, [v], body, _, _); inp], m) when valRefEq g vref g.seq_map_vref -> Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, m) | _ -> None let (|SeqDelay|_|) expr = match expr with - | Expr.App(Expr.Val (vref, _, _), _f0ty, [elemTy], [Expr.Lambda(_, _, _, [v], e, _, _)], _m) when valRefEq g vref g.seq_delay_vref && not (isVarFreeInExpr v e) -> Some (e, elemTy) + | Expr.App (Expr.Val (vref, _, _), _f0ty, [elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) when valRefEq g vref g.seq_delay_vref && not (isVarFreeInExpr v e) -> Some (e, elemTy) | _ -> None let (|SeqEmpty|_|) expr = match expr with - | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [], m) when valRefEq g vref g.seq_empty_vref -> Some (m) + | Expr.App (Expr.Val (vref, _, _), _f0ty, _tyargsl, [], m) when valRefEq g vref g.seq_empty_vref -> Some (m) | _ -> None let (|Seq|_|) expr = match expr with // use 'seq { ... }' as an indicator - | Expr.App(Expr.Val (vref, _, _), _f0ty, [elemTy], [e], _m) when valRefEq g vref g.seq_vref -> Some (e, elemTy) + | Expr.App (Expr.Val (vref, _, _), _f0ty, [elemTy], [e], _m) when valRefEq g vref g.seq_vref -> Some (e, elemTy) | _ -> None let RepresentBindingAsLocal (bind: Binding) res2 m = @@ -245,16 +245,16 @@ let LowerSeqExpr g amap overallExpr = (mkSequential SequencePointsAtSeq m (mkValSet m currv e) (mkCompGenSequential m - (Expr.Op(TOp.Return, [], [mkOne g m], m)) - (Expr.Op(TOp.Label label, [], [], m)))) + (Expr.Op (TOp.Return, [], [mkOne g m], m)) + (Expr.Op (TOp.Label label, [], [], m)))) let dispose = mkCompGenSequential m - (Expr.Op(TOp.Label label, [], [], m)) - (Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m)) + (Expr.Op (TOp.Label label, [], [], m)) + (Expr.Op (TOp.Goto currentDisposeContinuationLabel, [], [], m)) let checkDispose = mkCompGenSequential m - (Expr.Op(TOp.Label label, [], [], m)) - (Expr.Op(TOp.Return, [], [mkBool g m (not (noDisposeContinuationLabel = currentDisposeContinuationLabel))], m)) + (Expr.Op (TOp.Label label, [], [], m)) + (Expr.Op (TOp.Return, [], [mkBool g m (not (noDisposeContinuationLabel = currentDisposeContinuationLabel))], m)) generate, dispose, checkDispose) labels=[label] stateVars=[] @@ -366,7 +366,7 @@ let LowerSeqExpr g amap overallExpr = generate1 ) // set the PC past the try/finally before trying to run it, to make sure we only run it once (mkCompGenSequential m - (Expr.Op(TOp.Label innerDisposeContinuationLabel, [], [], m)) + (Expr.Op (TOp.Label innerDisposeContinuationLabel, [], [], m)) (mkCompGenSequential m (mkValSet m pcv (mkInt32 g m pcMap.[currentDisposeContinuationLabel])) compensation)) @@ -376,18 +376,18 @@ let LowerSeqExpr g amap overallExpr = dispose1 // set the PC past the try/finally before trying to run it, to make sure we only run it once (mkCompGenSequential m - (Expr.Op(TOp.Label innerDisposeContinuationLabel, [], [], m)) + (Expr.Op (TOp.Label innerDisposeContinuationLabel, [], [], m)) (mkCompGenSequential m (mkValSet m pcv (mkInt32 g m pcMap.[currentDisposeContinuationLabel])) (mkCompGenSequential m compensation - (Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m))))) + (Expr.Op (TOp.Goto currentDisposeContinuationLabel, [], [], m))))) let checkDispose = mkCompGenSequential m checkDispose1 (mkCompGenSequential m - (Expr.Op(TOp.Label innerDisposeContinuationLabel, [], [], m)) - (Expr.Op(TOp.Return, [], [mkTrue g m (* yes, we must dispose!!! *) ], m))) + (Expr.Op (TOp.Label innerDisposeContinuationLabel, [], [], m)) + (Expr.Op (TOp.Return, [], [mkTrue g m (* yes, we must dispose!!! *) ], m))) generate, dispose, checkDispose) labels = innerDisposeContinuationLabel :: res1.labels @@ -401,28 +401,28 @@ let LowerSeqExpr g amap overallExpr = // printfn "found Seq.empty" Some { phase2 = (fun _ -> let generate = mkUnit g m - let dispose = Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m) - let checkDispose = Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m) + let dispose = Expr.Op (TOp.Goto currentDisposeContinuationLabel, [], [], m) + let checkDispose = Expr.Op (TOp.Goto currentDisposeContinuationLabel, [], [], m) generate, dispose, checkDispose) labels = [] stateVars = [] significantClose = false capturedVars = emptyFreeVars } - | Expr.Sequential(x1, x2, NormalSeq, ty, m) -> + | Expr.Sequential (x1, x2, NormalSeq, ty, m) -> match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel x2 with | Some res2-> // printfn "found sequential execution" Some { res2 with phase2 = (fun ctxt -> let generate2, dispose2, checkDispose2 = res2.phase2 ctxt - let generate = Expr.Sequential(x1, generate2, NormalSeq, ty, m) + let generate = Expr.Sequential (x1, generate2, NormalSeq, ty, m) let dispose = dispose2 let checkDispose = checkDispose2 generate, dispose, checkDispose) } | None -> None - | Expr.Let(bind, bodyExpr, m, _) + | Expr.Let (bind, bodyExpr, m, _) // Restriction: compilation of sequence expressions containing non-toplevel constrained generic functions is not supported when bind.Var.IsCompiledAsTopLevel || not (IsGenericValWithGenericContraints g bind.Var) -> @@ -441,7 +441,7 @@ let LowerSeqExpr g amap overallExpr = None (* - | Expr.LetRec(binds, e2, m, _) + | Expr.LetRec (binds, e2, m, _) when // Restriction: only limited forms of "let rec" in sequence expressions can be handled by assignment to state local values (let recvars = valsOfBinds binds |> List.map (fun v -> (v, 0)) |> ValMap.OfList @@ -456,7 +456,7 @@ let LowerSeqExpr g amap overallExpr = | Expr.Lambda _ | Expr.TyLambda _ -> false // "let v = otherv" bindings get produced for environment packing by InnerLambdasToTopLevelFuncs.fs, we can accept and compiler these ok - | Expr.Val(v, _, _) when not (recvars.ContainsVal v.Deref) -> false + | Expr.Val (v, _, _) when not (recvars.ContainsVal v.Deref) -> false | _ -> true) <= 1) -> match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e2 with @@ -547,16 +547,16 @@ let LowerSeqExpr g amap overallExpr = (mkSequential SequencePointsAtSeq m (mkAddrSet m nextv arbitrarySeqExpr) (mkCompGenSequential m - (Expr.Op(TOp.Return, [], [mkTwo g m], m)) - (Expr.Op(TOp.Label label, [], [], m)))) + (Expr.Op (TOp.Return, [], [mkTwo g m], m)) + (Expr.Op (TOp.Label label, [], [], m)))) let dispose = mkCompGenSequential m - (Expr.Op(TOp.Label label, [], [], m)) - (Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m)) + (Expr.Op (TOp.Label label, [], [], m)) + (Expr.Op (TOp.Goto currentDisposeContinuationLabel, [], [], m)) let checkDispose = mkCompGenSequential m - (Expr.Op(TOp.Label label, [], [], m)) - (Expr.Op(TOp.Return, [], [mkFalse g m], m)) + (Expr.Op (TOp.Label label, [], [], m)) + (Expr.Op (TOp.Return, [], [mkFalse g m], m)) generate, dispose, checkDispose) labels=[label] stateVars=[] @@ -598,21 +598,21 @@ let LowerSeqExpr g amap overallExpr = // set the pc to "finished" (mkValSet m pcvref (mkInt32 g m pcDone)) (mkCompGenSequential m - (Expr.Op(TOp.Label noDisposeContinuationLabel, [], [], m)) + (Expr.Op (TOp.Label noDisposeContinuationLabel, [], [], m)) (mkCompGenSequential m // zero out the current value to free up its memory (mkValSet m currvref (mkDefault (m, currvref.Type))) - (Expr.Op(TOp.Return, [], [mkZero g m], m))))) + (Expr.Op (TOp.Return, [], [mkZero g m], m))))) let checkDisposeExpr = mkCompGenSequential m checkDisposeExpr (mkCompGenSequential m - (Expr.Op(TOp.Label noDisposeContinuationLabel, [], [], m)) - (Expr.Op(TOp.Return, [], [mkFalse g m], m))) + (Expr.Op (TOp.Label noDisposeContinuationLabel, [], [], m)) + (Expr.Op (TOp.Return, [], [mkFalse g m], m))) let addJumpTable isDisposal expr = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) - let mkGotoLabelTarget lab = mbuilder.AddResultTarget(Expr.Op(TOp.Goto lab, [], [], m), SuppressSequencePointAtTarget) + let mkGotoLabelTarget lab = mbuilder.AddResultTarget(Expr.Op (TOp.Goto lab, [], [], m), SuppressSequencePointAtTarget) let dtree = TDSwitch(pce, [ @@ -626,7 +626,7 @@ let LowerSeqExpr g amap overallExpr = m) let table = mbuilder.Close(dtree, m, g.int_ty) - mkCompGenSequential m table (mkCompGenSequential m (Expr.Op(TOp.Label initLabel, [], [], m)) expr) + mkCompGenSequential m table (mkCompGenSequential m (Expr.Op (TOp.Label initLabel, [], [], m)) expr) let handleExeceptionsInDispose disposalExpr = // let mutable exn : exn = null @@ -642,11 +642,11 @@ let LowerSeqExpr g amap overallExpr = // try ``disposalExpr'' with e -> exn <- e let eV, eE = mkLocal m "e" g.exn_ty let efV, _ = mkLocal m "ef" g.exn_ty - let assignToExn = Expr.Op(TOp.LValueOp(LValueOperation.LSet, exnVref), [], [eE], m) + let assignToExn = Expr.Op (TOp.LValueOp (LValueOperation.LSet, exnVref), [], [eE], m) let exceptionCatcher = mkTryWith g (disposalExpr, - efV, Expr.Const((Const.Bool true), m, g.bool_ty), + efV, Expr.Const ((Const.Bool true), m, g.bool_ty), eV, assignToExn, m, g.unit_ty, NoSequencePointAtTry, NoSequencePointAtWith) @@ -658,28 +658,28 @@ let LowerSeqExpr g amap overallExpr = let addResultTarget e = mbuilder.AddResultTarget(e, SuppressSequencePointAtTarget) let dtree = TDSwitch(pce, - [ mkCase((DecisionTreeTest.Const(Const.Int32 pcDone)), addResultTarget (Expr.Op(TOp.Goto doneLabel, [], [], m)) ) ], + [ mkCase((DecisionTreeTest.Const(Const.Int32 pcDone)), addResultTarget (Expr.Op (TOp.Goto doneLabel, [], [], m)) ) ], Some (addResultTarget (mkUnit g m)), m) let pcIsEndStateComparison = mbuilder.Close(dtree, m, g.unit_ty) mkCompGenSequential m - (Expr.Op((TOp.Label startLabel), [], [], m)) + (Expr.Op ((TOp.Label startLabel), [], [], m)) (mkCompGenSequential m pcIsEndStateComparison (mkCompGenSequential m exceptionCatcher (mkCompGenSequential m - (Expr.Op((TOp.Goto startLabel), [], [], m)) - (Expr.Op((TOp.Label doneLabel), [], [], m)) + (Expr.Op ((TOp.Goto startLabel), [], [], m)) + (Expr.Op ((TOp.Label doneLabel), [], [], m)) ) ) ) // if exn != null then raise exn let doRaise = - mkNonNullCond g m g.unit_ty exnE (mkThrow m g.unit_ty exnE) (Expr.Const(Const.Unit, m, g.unit_ty)) + mkNonNullCond g m g.unit_ty exnE (mkThrow m g.unit_ty exnE) (Expr.Const (Const.Unit, m, g.unit_ty)) mkLet - NoSequencePointAtLetBinding m exnV (Expr.Const(Const.Zero, m, g.exn_ty)) + NoSequencePointAtLetBinding m exnV (Expr.Const (Const.Zero, m, g.exn_ty)) (mkCompGenSequential m whileLoop doRaise) let stateMachineExprWithJumpTable = addJumpTable false stateMachineExpr @@ -689,7 +689,7 @@ let LowerSeqExpr g amap overallExpr = mkCompGenSequential m disposalExpr (mkCompGenSequential m - (Expr.Op(TOp.Label noDisposeContinuationLabel, [], [], m)) + (Expr.Op (TOp.Label noDisposeContinuationLabel, [], [], m)) (mkCompGenSequential m // set the pc to "finished" (mkValSet m pcvref (mkInt32 g m pcDone)) diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index bafcc706d..60ffa6e27 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -507,7 +507,7 @@ type ArgumentAnalysis = let InferLambdaArgsForLambdaPropagation origRhsExpr = let rec loop e = match e with - | SynExpr.Lambda(_, _, _, rest, _) -> 1 + loop rest + | SynExpr.Lambda (_, _, _, rest, _) -> 1 + loop rest | SynExpr.MatchLambda _ -> 1 | _ -> 0 loop origRhsExpr @@ -515,7 +515,7 @@ let InferLambdaArgsForLambdaPropagation origRhsExpr = let ExamineArgumentForLambdaPropagation (infoReader: InfoReader) (arg: AssignedCalledArg) = let g = infoReader.g // Find the explicit lambda arguments of the caller. Ignore parentheses. - let argExpr = match arg.CallerArg.Expr with SynExpr.Paren(x, _, _, _) -> x | x -> x + let argExpr = match arg.CallerArg.Expr with SynExpr.Paren (x, _, _, _) -> x | x -> x let countOfCallerLambdaArg = InferLambdaArgsForLambdaPropagation argExpr // Adjust for Expression<_>, Func<_, _>, ... let adjustedCalledArgTy = AdjustCalledArgType infoReader false arg.CalledArg arg.CallerArg @@ -547,7 +547,7 @@ let ExamineMethodForLambdaPropagation (x: CalledMeth) = /// Is this a 'base' call (in the sense of C#) let IsBaseCall objArgs = match objArgs with - | [Expr.Val(v, _, _)] when v.BaseOrThisInfo = BaseVal -> true + | [Expr.Val (v, _, _)] when v.BaseOrThisInfo = BaseVal -> true | _ -> false /// Compute whether we insert a 'coerce' on the 'this' pointer for an object model call @@ -635,13 +635,13 @@ let BuildILMethInfoCall g amap m isProp (minfo: ILMethInfo) valUseFlags minst di let exprTy = if ctor then minfo.ApparentEnclosingType else minfo.GetFSharpReturnTy(amap, m, minst) let retTy = if not ctor && ilMethRef.ReturnType = ILType.Void then [] else [exprTy] let isDllImport = minfo.IsDllImport g - Expr.Op(TOp.ILCall(useCallvirt, isProtected, valu, newobj, valUseFlags, isProp, isDllImport, ilMethRef, minfo.DeclaringTypeInst, minst, retTy), [], args, m), + Expr.Op (TOp.ILCall (useCallvirt, isProtected, valu, newobj, valUseFlags, isProp, isDllImport, ilMethRef, minfo.DeclaringTypeInst, minst, retTy), [], args, m), exprTy /// Build a call to the System.Object constructor taking no arguments, let BuildObjCtorCall (g: TcGlobals) m = let ilMethRef = (mkILCtorMethSpecForTy(g.ilg.typ_Object, [])).MethodRef - Expr.Op(TOp.ILCall(false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty]), [], [], m) + Expr.Op (TOp.ILCall (false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty]), [], [], m) /// Build a call to an F# method. @@ -710,7 +710,7 @@ let MakeMethInfoCall amap m minfo minst args = let actualMethInst = [] // GENERIC TYPE PROVIDERS: for generics, we would have something here let ilReturnTys = Option.toList (minfo.GetCompiledReturnTy(amap, m, [])) // GENERIC TYPE PROVIDERS: for generics, we would have more here // REVIEW: Should we allow protected calls? - Expr.Op(TOp.ILCall(false, false, valu, isConstructor, valUseFlags, isProp, false, ilMethodRef, actualTypeInst, actualMethInst, ilReturnTys), [], args, m) + Expr.Op (TOp.ILCall (false, false, valu, isConstructor, valUseFlags, isProp, false, ilMethodRef, actualTypeInst, actualMethInst, ilReturnTys), [], args, m) #endif @@ -801,7 +801,7 @@ let BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst objA let actualMethInst = minst let retTy = if not isCtor && (ilMethRef.ReturnType = ILType.Void) then [] else [exprTy] let noTailCall = false - let expr = Expr.Op(TOp.ILCall(useCallvirt, isProtected, valu, isNewObj, valUseFlags, isProp, noTailCall, ilMethRef, actualTypeInst, actualMethInst, retTy), [], allArgs, m) + let expr = Expr.Op (TOp.ILCall (useCallvirt, isProtected, valu, isNewObj, valUseFlags, isProp, noTailCall, ilMethRef, actualTypeInst, actualMethInst, retTy), [], allArgs, m) expr, exprTy #endif @@ -911,7 +911,7 @@ module ProvidedMethodCalls = | _ when typeEquiv g normTy g.decimal_ty -> Const.Decimal(v :?> decimal) | _ when typeEquiv g normTy g.unit_ty -> Const.Unit | _ -> fail() - Expr.Const(c, m, ty) + Expr.Const (c, m, ty) with _ -> fail() ), range=m) @@ -993,7 +993,7 @@ module ProvidedMethodCalls = let (expr, targetTy) = info.PApply2(id, m) let srcExpr = exprToExpr expr let targetTy = Import.ImportProvidedType amap m (targetTy.PApply(id, m)) - let sourceTy = Import.ImportProvidedType amap m (expr.PApply((fun e -> e.Type), m)) + let sourceTy = Import.ImportProvidedType amap m (expr.PApply ((fun e -> e.Type), m)) let te = mkCoerceIfNeeded g targetTy sourceTy srcExpr None, (te, tyOfExpr g te) | None -> @@ -1037,7 +1037,7 @@ module ProvidedMethodCalls = let tyT = Import.ImportProvidedType amap m ty let elems = elems.PApplyArray(id, "GetInvokerExpresson", m) let elemsT = elems |> Array.map exprToExpr |> Array.toList - let exprT = Expr.Op(TOp.Array, [tyT], elemsT, m) + let exprT = Expr.Op (TOp.Array, [tyT], elemsT, m) None, (exprT, tyOfExpr g exprT) | None -> match ea.PApplyOption((function ProvidedTupleGetExpr x -> Some x | _ -> None), m) with diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 872109989..17ca29ad2 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -424,7 +424,7 @@ let NextExtensionMethodPriority() = uint64 (newStamp()) let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap: Import.ImportMap) m (tcrefOfStaticClass: TyconRef) = let g = amap.g // Type must be non-generic and have 'Extension' attribute - if isNil(tcrefOfStaticClass.Typars(m)) && TyconRefHasAttribute g m g.attrib_ExtensionAttribute tcrefOfStaticClass then + if isNil(tcrefOfStaticClass.Typars m) && TyconRefHasAttribute g m g.attrib_ExtensionAttribute tcrefOfStaticClass then let pri = NextExtensionMethodPriority() let ty = generalizedTyconRef tcrefOfStaticClass @@ -796,7 +796,7 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai mty.TypeAndExceptionDefinitions |> List.choose (fun tycon -> let tcref = modref.NestedTyconRef tycon - if IsEntityAccessible amap m ad tcref then Some(tcref) else None) + if IsEntityAccessible amap m ad tcref then Some tcref else None) let nenv = (nenv, tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap m false let vrefs = @@ -1098,7 +1098,7 @@ let AddEntityForProvidedType (amap: Import.ImportMap, modref: ModuleOrNamespaceR let importProvidedType t = Import.ImportProvidedType amap m t let isSuppressRelocate = amap.g.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate), m) let tycon = Construct.NewProvidedTycon(resolutionEnvironment, st, importProvidedType, isSuppressRelocate, m) - modref.ModuleOrNamespaceType.AddProvidedTypeEntity(tycon) + modref.ModuleOrNamespaceType.AddProvidedTypeEntity tycon let tcref = modref.NestedTyconRef tycon System.Diagnostics.Debug.Assert(modref.TryDeref.IsSome) tcref @@ -1126,7 +1126,7 @@ let ResolveProvidedTypeNameInEntity (amap, m, typeName, modref: ModuleOrNamespac dprintfn "resolving name '%s' in TProvidedTypeExtensionPoint '%s'" typeName (sty.PUntaint((fun sty -> sty.FullName), m)) #endif - match sty.PApply((fun sty -> sty.GetNestedType(typeName)), m) with + match sty.PApply((fun sty -> sty.GetNestedType typeName), m) with | Tainted.Null -> //if staticResInfo.NumStaticArgs > 0 then // error(Error(FSComp.SR.etNestedProvidedTypesDoNotTakeStaticArgumentsOrGenericParameters(), m)) @@ -1271,42 +1271,42 @@ let (|ValRefOfEvent|_|) (evt: EventInfo) = evt.ArbitraryValRef let rec (|RecordFieldUse|_|) (item: Item) = match item with | Item.RecdField(RecdFieldInfo(_, RFRef(tcref, name))) -> Some (name, tcref) - | Item.SetterArg(_, RecordFieldUse(f)) -> Some(f) + | Item.SetterArg(_, RecordFieldUse f) -> Some f | _ -> None let rec (|ILFieldUse|_|) (item: Item) = match item with - | Item.ILField(finfo) -> Some(finfo) - | Item.SetterArg(_, ILFieldUse(f)) -> Some(f) + | Item.ILField finfo -> Some finfo + | Item.SetterArg(_, ILFieldUse f) -> Some f | _ -> None let rec (|PropertyUse|_|) (item: Item) = match item with - | Item.Property(_, pinfo::_) -> Some(pinfo) - | Item.SetterArg(_, PropertyUse(pinfo)) -> Some(pinfo) + | Item.Property(_, pinfo::_) -> Some pinfo + | Item.SetterArg(_, PropertyUse pinfo) -> Some pinfo | _ -> None let rec (|FSharpPropertyUse|_|) (item: Item) = match item with - | Item.Property(_, [ValRefOfProp vref]) -> Some(vref) - | Item.SetterArg(_, FSharpPropertyUse(propDef)) -> Some(propDef) + | Item.Property(_, [ValRefOfProp vref]) -> Some vref + | Item.SetterArg(_, FSharpPropertyUse propDef) -> Some propDef | _ -> None let (|MethodUse|_|) (item: Item) = match item with - | Item.MethodGroup(_, [minfo], _) -> Some(minfo) + | Item.MethodGroup(_, [minfo], _) -> Some minfo | _ -> None let (|FSharpMethodUse|_|) (item: Item) = match item with - | Item.MethodGroup(_, [ValRefOfMeth vref], _) -> Some(vref) - | Item.Value(vref) when vref.IsMember -> Some(vref) + | Item.MethodGroup(_, [ValRefOfMeth vref], _) -> Some vref + | Item.Value vref when vref.IsMember -> Some vref | _ -> None let (|EntityUse|_|) (item: Item) = match item with | Item.UnqualifiedType (tcref:: _) -> Some tcref - | Item.ExnCase(tcref) -> Some tcref + | Item.ExnCase tcref -> Some tcref | Item.Types(_, [AbbrevOrAppTy tcref]) | Item.DelegateCtor(AbbrevOrAppTy tcref) | Item.FakeInterfaceCtor(AbbrevOrAppTy tcref) -> Some tcref @@ -1318,7 +1318,7 @@ let (|EntityUse|_|) (item: Item) = let (|EventUse|_|) (item: Item) = match item with - | Item.Event(einfo) -> Some einfo + | Item.Event einfo -> Some einfo | _ -> None let (|FSharpEventUse|_|) (item: Item) = @@ -1402,7 +1402,7 @@ let ItemsAreEffectivelyEqual g orig other = | Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2 | _ -> false - | PropertyUse(pinfo1), PropertyUse(pinfo2) -> + | PropertyUse pinfo1, PropertyUse pinfo2 -> PropInfo.PropInfosUseIdenticalDefinitions pinfo1 pinfo2 || // Allow for equality up to signature matching match pinfo1.ArbitraryValRef, pinfo2.ArbitraryValRef with @@ -1475,7 +1475,7 @@ type TcResolutions capturedNameResolutions: ResizeArray, capturedMethodGroupResolutions: ResizeArray) = - static let empty = TcResolutions(ResizeArray(0), ResizeArray(0), ResizeArray(0), ResizeArray(0)) + static let empty = TcResolutions(ResizeArray 0, ResizeArray 0, ResizeArray 0, ResizeArray 0) member this.CapturedEnvs = capturedEnvs member this.CapturedExpressionTypings = capturedExprTypes @@ -1506,7 +1506,7 @@ type TcSymbolUses(g, capturedNameResolutions: ResizeArray () - | Some sink -> sink.NotifyOpenDeclaration(openDeclaration) + | Some sink -> sink.NotifyOpenDeclaration openDeclaration //------------------------------------------------------------------------- // Check inferability of type parameters in resolved items. @@ -1745,7 +1745,7 @@ type ResolutionInfo = else Item.Types(eref.DisplayName, [FreshenTycon ncenv m eref]) CallNameResolutionSink sink (m, nenv, item, item, emptyTyparInst, occ, nenv.eDisplayEnv, ad)) - warnings(typarChecker) + warnings typarChecker static member Empty = ResolutionInfo([], (fun _ -> ())) @@ -2094,7 +2094,7 @@ let CoreDisplayName(pinfo: PropInfo) = let DecodeFSharpEvent (pinfos: PropInfo list) ad g (ncenv: NameResolver) m = match pinfos with | [pinfo] when pinfo.IsFSharpEventProperty -> - let nm = CoreDisplayName(pinfo) + let nm = CoreDisplayName pinfo let minfos1 = GetImmediateIntrinsicMethInfosOfType (Some("add_"+nm), ad) g ncenv.amap m pinfo.ApparentEnclosingType let minfos2 = GetImmediateIntrinsicMethInfosOfType (Some("remove_"+nm), ad) g ncenv.amap m pinfo.ApparentEnclosingType match minfos1, minfos2 with @@ -2105,7 +2105,7 @@ let DecodeFSharpEvent (pinfos: PropInfo list) ad g (ncenv: NameResolver) m = // FOUND PROPERTY-AS-EVENT BUT DIDN'T FIND CORRESPONDING ADD/REMOVE METHODS Some(Item.Property (nm, pinfos)) | pinfo :: _ -> - let nm = CoreDisplayName(pinfo) + let nm = CoreDisplayName pinfo Some(Item.Property (nm, pinfos)) | _ -> None @@ -2173,8 +2173,8 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | Some (EventItem (einfo :: _)) when isLookUpExpr -> success [resInfo, Item.Event einfo, rest] - | Some (RecdFieldItem (rfinfo)) when (match lookupKind with LookupKind.Expr | LookupKind.RecdField | LookupKind.Pattern -> true | _ -> false) -> - success [resInfo, Item.RecdField(rfinfo), rest] + | Some (RecdFieldItem rfinfo) when (match lookupKind with LookupKind.Expr | LookupKind.RecdField | LookupKind.Pattern -> true | _ -> false) -> + success [resInfo, Item.RecdField rfinfo, rest] | _ -> @@ -2739,7 +2739,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa (warnOnUpper = WarnOnUpperCase) && id.idText.Length >= 3 && System.Char.ToLowerInvariant id.idText.[0] <> id.idText.[0] then - warning(UpperCaseIdentifierInPattern(m)) + warning(UpperCaseIdentifierInPattern m) Item.NewDef id // Long identifiers in patterns @@ -2933,7 +2933,7 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full success(ResolutionInfo.Empty, tcref) | [] -> let suggestPossibleTypes() = - nenv.TyconsByDemangledNameAndArity(fullyQualified) + nenv.TyconsByDemangledNameAndArity fullyQualified |> Seq.filter (fun kv -> IsEntityAccessible ncenv.amap m ad kv.Value) |> Seq.collect (fun e -> match occurence with @@ -3287,7 +3287,7 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso match item1, item with | Item.MethodGroup(name, minfos1, _), Item.MethodGroup(_, [], _) when not (isNil minfos1) -> - error(Error(FSComp.SR.methodIsNotStatic(name), wholem)) + error(Error(FSComp.SR.methodIsNotStatic name, wholem)) | _ -> () // Fake idents e.g. 'Microsoft.FSharp.Core.None' have identical ranges for each part @@ -3614,7 +3614,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso |> List.choose (fun pinfo-> let pinfoOpt = DecodeFSharpEvent [pinfo] ad g ncenv m match pinfoOpt, completionTargets with - | Some(Item.Event(einfo)), ResolveCompletionTargets.All _ -> if IsStandardEventInfo ncenv.InfoReader m ad einfo then pinfoOpt else None + | Some(Item.Event einfo), ResolveCompletionTargets.All _ -> if IsStandardEventInfo ncenv.InfoReader m ad einfo then pinfoOpt else None | _ -> pinfoOpt) // REVIEW: add a name filter here in the common cases? @@ -3661,7 +3661,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso if methsWithStaticParams.IsEmpty then minfos else minfos |> List.filter (fun minfo -> let nm = minfo.LogicalName - not (nm.Contains "," && methsWithStaticParams |> List.exists (fun m -> nm.StartsWithOrdinal(m)))) + not (nm.Contains "," && methsWithStaticParams |> List.exists (fun m -> nm.StartsWithOrdinal m))) #endif minfos @@ -4361,7 +4361,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( if methsWithStaticParams.IsEmpty then minfos else minfos |> List.filter (fun minfo -> let nm = minfo.LogicalName - not (nm.Contains "," && methsWithStaticParams |> List.exists (fun m -> nm.StartsWithOrdinal(m)))) + not (nm.Contains "," && methsWithStaticParams |> List.exists (fun m -> nm.StartsWithOrdinal m))) #endif minfos diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index c718bf910..72939fab6 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -616,7 +616,7 @@ module private PrintTypes = /// See also dataExprL - there is overlap between these that should be removed let rec private layoutAttribArg denv arg = match arg with - | Expr.Const(c, _, ty) -> + | Expr.Const (c, _, ty) -> if isEnumTy denv.g ty then WordL.keywordEnum ^^ angleL (layoutType denv ty) ^^ bracketL (layoutConst denv.g ty c) else @@ -1961,7 +1961,7 @@ module private PrintData = | Expr.Val (v, _, _) -> wordL (tagLocal v.DisplayName) | Expr.Link rX -> dataExprWrapL denv isAtomic (!rX) - | Expr.Op (TOp.UnionCase(c), _, args, _) -> + | Expr.Op (TOp.UnionCase (c), _, args, _) -> if denv.g.unionCaseRefEq c denv.g.nil_ucref then wordL (tagPunctuation "[]") elif denv.g.unionCaseRefEq c denv.g.cons_ucref then let rec strip = function (Expr.Op (TOp.UnionCase _, _, [h;t], _)) -> h::strip t | _ -> [] @@ -1971,7 +1971,7 @@ module private PrintData = else (wordL (tagUnionCase c.CaseName) ++ bracketL (commaListL (dataExprsL denv args))) - | Expr.Op (TOp.ExnConstr(c), _, args, _) -> (wordL (tagMethod c.LogicalName) ++ bracketL (commaListL (dataExprsL denv args))) + | Expr.Op (TOp.ExnConstr (c), _, args, _) -> (wordL (tagMethod c.LogicalName) ++ bracketL (commaListL (dataExprsL denv args))) | Expr.Op (TOp.Tuple _, _, xs, _) -> tupleL (dataExprsL denv xs) | Expr.Op (TOp.Recd (_, tc), _, xs, _) -> let fields = tc.TrueInstanceFieldsAsList diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 769c3e5c4..3aa0af89f 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -609,14 +609,14 @@ let GetInfoForNonLocalVal cenv env (vref: ValRef) = // REVIEW: optionally turn x-module on/off on per-module basis or elif cenv.settings.crossModuleOpt () || vref.MustInline then match TryGetInfoForNonLocalEntityRef env vref.nlr.EnclosingEntity.nlr with - | Some(structInfo) -> - match structInfo.ValInfos.TryFind(vref) with + | Some structInfo -> + match structInfo.ValInfos.TryFind vref with | Some ninfo -> snd ninfo | None -> //dprintn ("\n\n*** Optimization info for value "+n+" from module "+(full_name_of_nlpath smv)+" not found, module contains values: "+String.concat ", " (NameMap.domainL structInfo.ValInfos)) //System.Diagnostics.Debug.Assert(false, sprintf "Break for module %s, value %s" (full_name_of_nlpath smv) n) if cenv.g.compilingFslib then - match structInfo.ValInfos.TryFindForFslib(vref) with + match structInfo.ValInfos.TryFindForFslib vref with | true, ninfo -> snd ninfo | _ -> UnknownValInfo else @@ -719,7 +719,7 @@ let MakeValueInfoForConst c ty = ConstValue(c, ty) /// Helper to evaluate a unary integer operation over known values let inline IntegerUnaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a = match a with - | StripConstValue(c) -> + | StripConstValue c -> match c with | Const.Bool a -> Some(mkBoolVal g (f32 (if a then 1 else 0) <> 0)) | Const.Int32 a -> Some(mkInt32Val g (f32 a)) @@ -736,7 +736,7 @@ let inline IntegerUnaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a = /// Helper to evaluate a unary signed integer operation over known values let inline SignedIntegerUnaryOp g f8 f16 f32 f64 a = match a with - | StripConstValue(c) -> + | StripConstValue c -> match c with | Const.Int32 a -> Some(mkInt32Val g (f32 a)) | Const.Int64 a -> Some(mkInt64Val g (f64 a)) @@ -748,7 +748,7 @@ let inline SignedIntegerUnaryOp g f8 f16 f32 f64 a = /// Helper to evaluate a binary integer operation over known values let inline IntegerBinaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a b = match a, b with - | StripConstValue(c1), StripConstValue(c2) -> + | StripConstValue c1, StripConstValue c2 -> match c1, c2 with | (Const.Bool a), (Const.Bool b) -> Some(mkBoolVal g (f32 (if a then 1 else 0) (if b then 1 else 0) <> 0)) | (Const.Int32 a), (Const.Int32 b) -> Some(mkInt32Val g (f32 a b)) @@ -1168,9 +1168,9 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = UnknownValue // Otherwise check all sub-values - | TupleValue vinfos -> TupleValue (Array.map (abstractExprInfo) vinfos) - | RecdValue (tcref, vinfos) -> RecdValue (tcref, Array.map (abstractExprInfo) vinfos) - | UnionCaseValue (cspec, vinfos) -> UnionCaseValue(cspec, Array.map (abstractExprInfo) vinfos) + | TupleValue vinfos -> TupleValue (Array.map abstractExprInfo vinfos) + | RecdValue (tcref, vinfos) -> RecdValue (tcref, Array.map abstractExprInfo vinfos) + | UnionCaseValue (cspec, vinfos) -> UnionCaseValue(cspec, Array.map abstractExprInfo vinfos) | CurriedLambdaValue _ | ConstValue _ | ConstExprValue _ @@ -1260,7 +1260,7 @@ let rec IsSmallConstExpr x = match x with | Expr.Op (TOp.LValueOp (LAddrOf _, _), [], [], _) -> true // &x is always a constant | Expr.Val (v, _, _m) -> not v.IsMutable - | Expr.App(fe, _, _tyargs, args, _) -> isNil args && not (IsTyFuncValRefExpr fe) && IsSmallConstExpr fe + | Expr.App (fe, _, _tyargs, args, _) -> isNil args && not (IsTyFuncValRefExpr fe) && IsSmallConstExpr fe | _ -> false let ValueOfExpr expr = @@ -1329,10 +1329,10 @@ let rec ExprHasEffect g expr = | Expr.TyLambda _ | Expr.Const _ -> false /// type applications do not have effects, with the exception of type functions - | Expr.App(f0, _, _, [], _) -> (IsTyFuncValRefExpr f0) || ExprHasEffect g f0 - | Expr.Op(op, _, args, m) -> ExprsHaveEffect g args || OpHasEffect g m op - | Expr.LetRec(binds, body, _, _) -> BindingsHaveEffect g binds || ExprHasEffect g body - | Expr.Let(bind, body, _, _) -> BindingHasEffect g bind || ExprHasEffect g body + | Expr.App (f0, _, _, [], _) -> (IsTyFuncValRefExpr f0) || ExprHasEffect g f0 + | Expr.Op (op, _, args, m) -> ExprsHaveEffect g args || OpHasEffect g m op + | Expr.LetRec (binds, body, _, _) -> BindingsHaveEffect g binds || ExprHasEffect g body + | Expr.Let (bind, body, _, _) -> BindingHasEffect g bind || ExprHasEffect g body // REVIEW: could add Expr.Obj on an interface type - these are similar to records of lambda expressions | _ -> true @@ -1356,12 +1356,12 @@ and OpHasEffect g m op = | TOp.UnionCaseTagGet _ -> false | TOp.UnionCaseProof _ -> false | TOp.UnionCaseFieldGet (ucref, n) -> isUnionCaseFieldMutable g ucref n - | TOp.ILAsm(instrs, _) -> IlAssemblyCodeHasEffect instrs - | TOp.TupleFieldGet(_) -> false - | TOp.ExnFieldGet(ecref, n) -> isExnFieldMutable ecref n + | TOp.ILAsm (instrs, _) -> IlAssemblyCodeHasEffect instrs + | TOp.TupleFieldGet (_) -> false + | TOp.ExnFieldGet (ecref, n) -> isExnFieldMutable ecref n | TOp.RefAddrGet _ -> false | TOp.AnonRecdGet _ -> true // conservative - | TOp.ValFieldGet rfref -> rfref.RecdField.IsMutable || (TryFindTyconRefBoolAttribute g Range.range0 g.attrib_AllowNullLiteralAttribute rfref.TyconRef = Some(true)) + | TOp.ValFieldGet rfref -> rfref.RecdField.IsMutable || (TryFindTyconRefBoolAttribute g Range.range0 g.attrib_AllowNullLiteralAttribute rfref.TyconRef = Some true) | TOp.ValFieldGetAddr (rfref, _readonly) -> rfref.RecdField.IsMutable | TOp.UnionCaseFieldGetAddr _ -> false // union case fields are immutable | TOp.LValueOp (LAddrOf _, _) -> false // addresses of values are always constants @@ -1395,7 +1395,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = // But note the cases below cover some instances of side-effecting expressions as well.... let IsUniqueUse vspec2 args = valEq vspec1 vspec2 - && (not (vspec2.LogicalName.Contains(suffixForVariablesThatMayNotBeEliminated))) + && (not (vspec2.LogicalName.Contains suffixForVariablesThatMayNotBeEliminated)) // REVIEW: this looks slow. Look only for one variable instead && (let fvs = accFreeInExprs CollectLocals args emptyFreeVars not (Zset.contains vspec1 fvs.FreeLocals)) @@ -1403,7 +1403,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = // Immediate consumption of value as 2nd or subsequent argument to a construction or projection operation let rec GetImmediateUseContext rargsl argsr = match argsr with - | (Expr.Val(VRefLocal vspec2, _, _)) :: argsr2 + | (Expr.Val (VRefLocal vspec2, _, _)) :: argsr2 when valEq vspec1 vspec2 && IsUniqueUse vspec2 (List.rev rargsl@argsr2) -> Some(List.rev rargsl, argsr2) | argsrh :: argsrt when not (ExprHasEffect cenv.g argsrh) -> GetImmediateUseContext (argsrh::rargsl) argsrt | _ -> None @@ -1411,24 +1411,24 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = match stripExpr e2 with // Immediate consumption of value as itself 'let x = e in x' - | Expr.Val(VRefLocal vspec2, _, _) + | Expr.Val (VRefLocal vspec2, _, _) when IsUniqueUse vspec2 [] -> Some e1 // Immediate consumption of value by a pattern match 'let x = e in match x with ...' - | Expr.Match(spMatch, _exprm, TDSwitch(Expr.Val(VRefLocal vspec2, _, _), cases, dflt, _), targets, m, ty2) + | Expr.Match (spMatch, _exprm, TDSwitch(Expr.Val (VRefLocal vspec2, _, _), cases, dflt, _), targets, m, ty2) when (valEq vspec1 vspec2 && let fvs = accFreeInTargets CollectLocals targets (accFreeInSwitchCases CollectLocals cases dflt emptyFreeVars) not (Zset.contains vspec1 fvs.FreeLocals)) -> - let spMatch = spBind.Combine(spMatch) - Some (Expr.Match(spMatch, e1.Range, TDSwitch(e1, cases, dflt, m), targets, m, ty2)) + let spMatch = spBind.Combine spMatch + Some (Expr.Match (spMatch, e1.Range, TDSwitch(e1, cases, dflt, m), targets, m, ty2)) // Immediate consumption of value as a function 'let f = e in f ...' and 'let x = e in f ... x ...' // Note functions are evaluated before args // Note: do not include functions with a single arg of unit type, introduced by abstractBigTargets - | Expr.App(f, f0ty, tyargs, args, m) - when not (vspec1.LogicalName.Contains(suffixForVariablesThatMayNotBeEliminated)) -> + | Expr.App (f, f0ty, tyargs, args, m) + when not (vspec1.LogicalName.Contains suffixForVariablesThatMayNotBeEliminated) -> match GetImmediateUseContext [] (f::args) with | Some([], rargs) -> Some (MakeApplicationAndBetaReduce cenv.g (e1, f0ty, [tyargs], rargs, m)) | Some(f::largs, rargs) -> Some (MakeApplicationAndBetaReduce cenv.g (f, f0ty, [tyargs], largs @ (e1::rargs), m)) @@ -1464,8 +1464,8 @@ let TryEliminateLet cenv env bind e2 m = /// Detect the application of a value to an arbitrary number of arguments let rec (|KnownValApp|_|) expr = match stripExpr expr with - | Expr.Val(vref, _, _) -> Some(vref, [], []) - | Expr.App(KnownValApp(vref, typeArgs1, otherArgs1), _, typeArgs2, otherArgs2, _) -> Some(vref, typeArgs1@typeArgs2, otherArgs1@otherArgs2) + | Expr.Val (vref, _, _) -> Some(vref, [], []) + | Expr.App (KnownValApp(vref, typeArgs1, otherArgs1), _, typeArgs2, otherArgs2, _) -> Some(vref, typeArgs1@typeArgs2, otherArgs1@otherArgs2) | _ -> None /// Matches boolean decision tree: @@ -1524,10 +1524,10 @@ let rec CombineBoolLogic expr = // try to find nested boolean switch match expr with - | Expr.Match(outerSP, outerMatchRange, - TDBoolSwitch(Expr.Match(_innerSP, _innerMatchRange, innerTree, innerTargets, _innerDefaultRange, _innerMatchTy), - outerTestBool, outerCaseTree, outerDefaultTree, _outerSwitchRange ), - outerTargets, outerDefaultRange, outerMatchTy) -> + | Expr.Match (outerSP, outerMatchRange, + TDBoolSwitch(Expr.Match (_innerSP, _innerMatchRange, innerTree, innerTargets, _innerDefaultRange, _innerMatchTy), + outerTestBool, outerCaseTree, outerDefaultTree, _outerSwitchRange ), + outerTargets, outerDefaultRange, outerMatchTy) -> let costOuterCaseTree = match outerCaseTree with TDSuccess _ -> 0 | _ -> 1 let costOuterDefaultTree = match outerDefaultTree with TDSuccess _ -> 0 | _ -> 1 @@ -1535,7 +1535,7 @@ let rec CombineBoolLogic expr = // At most one expression, no overall duplication of TSwitch nodes if tc <= costOuterCaseTree + costOuterDefaultTree && ec <= 10 then let newExpr = - Expr.Match(outerSP, outerMatchRange, + Expr.Match (outerSP, outerMatchRange, RewriteBoolLogicTree (innerTargets, outerCaseTree, outerDefaultTree, outerTestBool) innerTree, outerTargets, outerDefaultRange, outerMatchTy) @@ -1613,9 +1613,9 @@ let ExpandStructuralBinding cenv expr = /// Detect a query { ... } let (|QueryRun|_|) g expr = match expr with - | Expr.App(Expr.Val (vref, _, _), _, _, [_builder; arg], _) when valRefEq g vref g.query_run_value_vref -> + | Expr.App (Expr.Val (vref, _, _), _, _, [_builder; arg], _) when valRefEq g vref g.query_run_value_vref -> Some (arg, None) - | Expr.App(Expr.Val (vref, _, _), _, [ elemTy ], [_builder; arg], _) when valRefEq g vref g.query_run_enumerable_vref -> + | Expr.App (Expr.Val (vref, _, _), _, [ elemTy ], [_builder; arg], _) when valRefEq g vref g.query_run_enumerable_vref -> Some (arg, Some elemTy) | _ -> None @@ -1624,7 +1624,7 @@ let (|MaybeRefTupled|) e = tryDestRefTupleExpr e let (|AnyInstanceMethodApp|_|) e = match e with - | Expr.App(Expr.Val (vref, _, _), _, tyargs, [obj; MaybeRefTupled args], _) -> Some (vref, tyargs, obj, args) + | Expr.App (Expr.Val (vref, _, _), _, tyargs, [obj; MaybeRefTupled args], _) -> Some (vref, tyargs, obj, args) | _ -> None let (|InstanceMethodApp|_|) g (expectedValRef: ValRef) e = @@ -1664,9 +1664,9 @@ let (|AnyRefTupleTrans|) e = /// Look for any QueryBuilder.* operation and transform let (|AnyQueryBuilderOpTrans|_|) g = function - | Expr.App((Expr.Val (vref, _, _) as v), vty, tyargs, [builder; AnyRefTupleTrans( (src::rest), replaceArgs) ], m) when + | Expr.App ((Expr.Val (vref, _, _) as v), vty, tyargs, [builder; AnyRefTupleTrans( (src::rest), replaceArgs) ], m) when (match vref.ApparentEnclosingEntity with Parent tcref -> tyconRefEq g tcref g.query_builder_tcref | ParentNone -> false) -> - Some (src, (fun newSource -> Expr.App(v, vty, tyargs, [builder; replaceArgs(newSource::rest)], m))) + Some (src, (fun newSource -> Expr.App (v, vty, tyargs, [builder; replaceArgs(newSource::rest)], m))) | _ -> None let mkUnitDelayLambda (g: TcGlobals) m e = @@ -1709,7 +1709,7 @@ let rec tryRewriteToSeqCombinators g (e: Expr) = Some (mkCallSeqEmpty g m sourceElemTy) // query.For --> Seq.collect - | QueryFor g (_qTy, sourceElemTy, resultElemTy, QuerySourceEnumerable g (_, source), Expr.Lambda(_, _, _, [resultSelectorVar], resultSelector, mLambda, _)) -> + | QueryFor g (_qTy, sourceElemTy, resultElemTy, QuerySourceEnumerable g (_, source), Expr.Lambda (_, _, _, [resultSelectorVar], resultSelector, mLambda, _)) -> match tryRewriteToSeqCombinators g resultSelector with | Some newResultSelector -> Some (mkCallSeqCollect g m sourceElemTy resultElemTy (mkLambda mLambda resultSelectorVar (newResultSelector, tyOfExpr g newResultSelector)) source) @@ -1717,10 +1717,10 @@ let rec tryRewriteToSeqCombinators g (e: Expr) = // let --> let - | Expr.Let(bind, bodyExpr, m, _) -> + | Expr.Let (bind, bodyExpr, m, _) -> match tryRewriteToSeqCombinators g bodyExpr with | Some newBodyExpr -> - Some (Expr.Let(bind, newBodyExpr, m, newCache())) + Some (Expr.Let (bind, newBodyExpr, m, newCache())) | None -> None // match --> match @@ -1748,7 +1748,7 @@ let TryDetectQueryQuoteAndRun cenv (expr: Expr) = | QueryRun g (bodyOfRun, reqdResultInfo) -> //printfn "found Query.Run" match bodyOfRun with - | Expr.Quote(quotedExpr, _, true, _, _) -> // true = isFromQueryExpression + | Expr.Quote (quotedExpr, _, true, _, _) -> // true = isFromQueryExpression // This traverses uses of query operators like query.Where and query.AverageBy until we're left with something familiar. @@ -1842,9 +1842,9 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = | Expr.Val (v, _vFlags, m) -> OptimizeVal cenv env expr (v, m) - | Expr.Quote(ast, splices, isFromQueryExpression, m, ty) -> + | Expr.Quote (ast, splices, isFromQueryExpression, m, ty) -> let splices = ref (splices.Value |> Option.map (map3Of4 (List.map (OptimizeExpr cenv env >> fst)))) - Expr.Quote(ast, splices, isFromQueryExpression, m, ty), + Expr.Quote (ast, splices, isFromQueryExpression, m, ty), { TotalSize = 10 FunctionSize = 1 HasEffect = false @@ -1857,18 +1857,18 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = | Expr.Op (op, tyargs, args, m) -> OptimizeExprOp cenv env (op, tyargs, args, m) - | Expr.App(f, fty, tyargs, argsl, m) -> + | Expr.App (f, fty, tyargs, argsl, m) -> // eliminate uses of query match TryDetectQueryQuoteAndRun cenv expr with | Some newExpr -> OptimizeExpr cenv env newExpr | None -> OptimizeApplication cenv env (f, fty, tyargs, argsl, m) - | Expr.Lambda(_lambdaId, _, _, argvs, _body, m, rty) -> + | Expr.Lambda (_lambdaId, _, _, argvs, _body, m, rty) -> let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty OptimizeLambdas None cenv env topValInfo expr ty - | Expr.TyLambda(_lambdaId, tps, _body, _m, rty) -> + | Expr.TyLambda (_lambdaId, tps, _body, _m, rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) let ty = mkForallTyIfNeeded tps rty OptimizeLambdas None cenv env topValInfo expr ty @@ -1876,7 +1876,7 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = | Expr.TyChoose _ -> OptimizeExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) - | Expr.Match(spMatch, exprm, dtree, targets, m, ty) -> + | Expr.Match (spMatch, exprm, dtree, targets, m, ty) -> OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty) | Expr.LetRec (binds, bodyExpr, m, _) -> @@ -1885,7 +1885,7 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = | Expr.StaticOptimization (constraints, expr2, expr3, m) -> let expr2R, e2info = OptimizeExpr cenv env expr2 let expr3R, e3info = OptimizeExpr cenv env expr3 - Expr.StaticOptimization(constraints, expr2R, expr3R, m), + Expr.StaticOptimization (constraints, expr2R, expr3R, m), { TotalSize = min e2info.TotalSize e3info.TotalSize FunctionSize = min e2info.FunctionSize e3info.FunctionSize HasEffect = e2info.HasEffect || e3info.HasEffect @@ -1944,14 +1944,14 @@ and OptimizeInterfaceImpl cenv env baseValOpt (ty, overrides) = and MakeOptimizedSystemStringConcatCall cenv env m args = let rec optimizeArg argExpr accArgs = match argExpr, accArgs with - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ], _), _ when IsSystemStringConcatArray methRef -> + | Expr.Op (TOp.ILCall (_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op (TOp.Array, _, args, _) ], _), _ when IsSystemStringConcatArray methRef -> optimizeArgs args accArgs - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, args, _), _ when IsSystemStringConcatOverload methRef -> + | Expr.Op (TOp.ILCall (_, _, _, _, _, _, _, methRef, _, _, _), _, args, _), _ when IsSystemStringConcatOverload methRef -> optimizeArgs args accArgs // Optimize string constants, e.g. "1" + "2" will turn into "12" - | Expr.Const(Const.String str1, _, _), Expr.Const(Const.String str2, _, _) :: accArgs -> + | Expr.Const (Const.String str1, _, _), Expr.Const (Const.String str2, _, _) :: accArgs -> mkString cenv.g m (str1 + str2) :: accArgs | arg, _ -> arg :: accArgs @@ -1977,7 +1977,7 @@ and MakeOptimizedSystemStringConcatCall cenv env m args = mkStaticCall_String_Concat_Array cenv.g m arg match expr with - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _) as op, tyargs, args, m) when IsSystemStringConcatOverload methRef || IsSystemStringConcatArray methRef -> + | Expr.Op (TOp.ILCall (_, _, _, _, _, _, _, methRef, _, _, _) as op, tyargs, args, m) when IsSystemStringConcatOverload methRef || IsSystemStringConcatArray methRef -> OptimizeExprOpReductions cenv env (op, tyargs, args, m) | _ -> OptimizeExpr cenv env expr @@ -2015,19 +2015,19 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) = Info = ValueOfExpr newExpr } // Handle these as special cases since mutables are allowed inside their bodies - | TOp.While (spWhile, marker), _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _)] -> + | TOp.While (spWhile, marker), _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _)] -> OptimizeWhileLoop cenv { env with inLoop=true } (spWhile, marker, e1, e2, m) - | TOp.For(spStart, dir), _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _);Expr.Lambda(_, _, _, [v], e3, _, _)] -> + | TOp.For (spStart, dir), _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _);Expr.Lambda (_, _, _, [v], e3, _, _)] -> OptimizeFastIntegerForLoop cenv { env with inLoop=true } (spStart, v, e1, dir, e2, e3, m) - | TOp.TryFinally(spTry, spFinally), [resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> + | TOp.TryFinally (spTry, spFinally), [resty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)] -> OptimizeTryFinally cenv env (spTry, spFinally, e1, e2, m, resty) - | TOp.TryCatch(spTry, spWith), [resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [vf], ef, _, _); Expr.Lambda(_, _, _, [vh], eh, _, _)] -> + | TOp.TryCatch (spTry, spWith), [resty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [vf], ef, _, _); Expr.Lambda (_, _, _, [vh], eh, _, _)] -> OptimizeTryCatch cenv env (e1, vf, ef, vh, eh, m, resty, spTry, spWith) - | TOp.TraitCall(traitInfo), [], args -> + | TOp.TraitCall traitInfo, [], args -> OptimizeTraitCall cenv env (traitInfo, args, m) // This code hooks arr.Length. The idea is to ensure loops end up in the "same shape"as the forms of loops that the .NET JIT @@ -2039,16 +2039,16 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) = mref.DeclaringTypeRef.Name = cenv.g.ilg.typ_Array.TypeRef.Name && mref.Name = "get_Length" && isArray1DTy cenv.g (tyOfExpr cenv.g arg)) -> - OptimizeExpr cenv env (Expr.Op(TOp.ILAsm(i_ldlen, [cenv.g.int_ty]), [], [arg], m)) + OptimizeExpr cenv env (Expr.Op (TOp.ILAsm (i_ldlen, [cenv.g.int_ty]), [], [arg], m)) // Empty IL instruction lists are used as casts in prim-types.fs. But we can get rid of them // if the types match up. - | TOp.ILAsm([], [ty]), _, [a] when typeEquiv cenv.g (tyOfExpr cenv.g a) ty -> OptimizeExpr cenv env a + | TOp.ILAsm ([], [ty]), _, [a] when typeEquiv cenv.g (tyOfExpr cenv.g a) ty -> OptimizeExpr cenv env a // Optimize calls when concatenating strings, e.g. "1" + "2" + "3" + "4" .. etc. - | TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ] when IsSystemStringConcatArray methRef -> + | TOp.ILCall (_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op (TOp.Array, _, args, _) ] when IsSystemStringConcatArray methRef -> MakeOptimizedSystemStringConcatCall cenv env m args - | TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, args when IsSystemStringConcatOverload methRef -> + | TOp.ILCall (_, _, _, _, _, _, _, methRef, _, _, _), _, args when IsSystemStringConcatOverload methRef -> MakeOptimizedSystemStringConcatCall cenv env m args | _ -> @@ -2062,7 +2062,7 @@ and OptimizeExprOpReductions cenv env (op, tyargs, args, m) = and OptimizeExprOpReductionsAfter cenv env (op, tyargs, argsR, arginfos, m) = let knownValue = match op, arginfos with - | TOp.ValFieldGet (rf), [e1info] -> TryOptimizeRecordFieldGet cenv env (e1info, rf, tyargs, m) + | TOp.ValFieldGet rf, [e1info] -> TryOptimizeRecordFieldGet cenv env (e1info, rf, tyargs, m) | TOp.TupleFieldGet (tupInfo, n), [e1info] -> TryOptimizeTupleFieldGet cenv env (tupInfo, e1info, tyargs, n, m) | TOp.UnionCaseFieldGet (cspec, n), [e1info] -> TryOptimizeUnionCaseGet cenv env (e1info, cspec, tyargs, n, m) | _ -> None @@ -2108,7 +2108,7 @@ and OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu = | StripUnionCaseValue (uc, info) -> UnionCaseValue(uc, info) | _ -> valu 0, valu - | TOp.ILAsm(instrs, tys) -> + | TOp.ILAsm (instrs, tys) -> min instrs.Length 1, mkAssemblyCodeValueInfo cenv.g instrs argValues tys | TOp.Bytes bytes -> bytes.Length/10, valu @@ -2148,7 +2148,7 @@ and OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu = match TryOptimizeValInfo cenv env m vinfo with | Some res -> res, vinfo | None -> - Expr.Op(op, tyargs, argsR, m), + Expr.Op (op, tyargs, argsR, m), { TotalSize=argsTSize + cost FunctionSize=argsFSize + cost HasEffect=argEffects || effect @@ -2209,13 +2209,13 @@ and OptimizeFastIntegerForLoop cenv env (spStart, v, e1, dir, e2, e3, m) = let e2R, dir = match dir, e2R with // detect upwards for loops with bounds of the form "arr.Length - 1" and convert them to a C#-style for loop - | FSharpForLoopUp, Expr.Op(TOp.ILAsm([ (AI_sub | AI_sub_ovf)], _), _, [Expr.Op(TOp.ILAsm([ I_ldlen; (AI_conv DT_I4)], _), _, [arre], _); Expr.Const(Const.Int32 1, _, _)], _) + | FSharpForLoopUp, Expr.Op (TOp.ILAsm ([ (AI_sub | AI_sub_ovf)], _), _, [Expr.Op (TOp.ILAsm ([ I_ldlen; (AI_conv DT_I4)], _), _, [arre], _); Expr.Const (Const.Int32 1, _, _)], _) when not (snd(OptimizeExpr cenv env arre)).HasEffect -> mkLdlen cenv.g (e2R.Range) arre, CSharpForLoopUp // detect upwards for loops with constant bounds, but not MaxValue! - | FSharpForLoopUp, Expr.Const(Const.Int32 n, _, _) + | FSharpForLoopUp, Expr.Const (Const.Int32 n, _, _) when n < System.Int32.MaxValue -> mkIncr cenv.g (e2R.Range) e2R, CSharpForLoopUp @@ -2250,7 +2250,7 @@ and OptimizeLetRec cenv env (binds, bodyExpr, m) = // Trim out any optimization info that involves escaping values let evalueR = AbstractExprInfoByVars (vs, []) einfo.Info // REVIEW: size of constructing new closures - should probably add #freevars + #recfixups here - let bodyExprR = Expr.LetRec(bindsRR, bodyExprR, m, NewFreeVarsCache()) + let bodyExprR = Expr.LetRec (bindsRR, bodyExprR, m, NewFreeVarsCache()) let info = CombineValueInfos (einfo :: bindinfos) evalueR bodyExprR, info @@ -2270,11 +2270,11 @@ and OptimizeLinearExpr cenv env expr contf = if (flag = NormalSeq) && // Always eliminate '(); expr' sequences, even in debug code, to ensure that // conditional method calls don't leave a dangling breakpoint (see FSharp 1.0 bug 6034) - (cenv.settings.EliminateSequential () || (match e1R with Expr.Const(Const.Unit, _, _) -> true | _ -> false)) && + (cenv.settings.EliminateSequential () || (match e1R with Expr.Const (Const.Unit, _, _) -> true | _ -> false)) && not e1info.HasEffect then e2R, e2info else - Expr.Sequential(e1R, e2R, flag, spSeq, m), + Expr.Sequential (e1R, e2R, flag, spSeq, m), { TotalSize = e1info.TotalSize + e2info.TotalSize FunctionSize = e1info.FunctionSize + e2info.FunctionSize HasEffect = flag <> NormalSeq || e1info.HasEffect || e2info.HasEffect @@ -2344,7 +2344,7 @@ and OptimizeTryFinally cenv env (spTry, spFinally, e1, e2, m, ty) = | SequencePointAtTry _ -> SequencePointsAtSeq | SequencePointInBodyOfTry -> SequencePointsAtSeq | NoSequencePointAtTry -> SuppressSequencePointOnExprOfSequential - Expr.Sequential(e1R, e2R, ThenDoSeq, sp, m), info + Expr.Sequential (e1R, e2R, ThenDoSeq, sp, m), info else mkTryFinally cenv.g (e1R, e2R, m, ty, spTry, spFinally), info @@ -2393,7 +2393,7 @@ and OptimizeTraitCall cenv env (traitInfo, args, m) = // Resolution fails when optimizing generic code, ignore the failure | _ -> let argsR, arginfos = OptimizeExprsThenConsiderSplits cenv env args - OptimizeExprOpFallback cenv env (TOp.TraitCall(traitInfo), [], argsR, m) arginfos UnknownValue + OptimizeExprOpFallback cenv env (TOp.TraitCall traitInfo, [], argsR, m) arginfos UnknownValue /// Make optimization decisions once we know the optimization information /// for a value @@ -2529,14 +2529,14 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = // // If C is a struct type then we have to take the address of 'c' - | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_comparison_inner_vref ty args -> + | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_comparison_inner_vref ty args -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedCompareToValues with | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) | _ -> None - | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_comparison_withc_inner_vref ty args -> + | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_comparison_withc_inner_vref ty args -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedCompareToWithComparerValues, args with @@ -2552,7 +2552,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = // to be augmented with a visible equality-without-comparer value. // REVIEW: GenericEqualityIntrinsic (which has no comparer) implements PER semantics (5537: this should be ER semantics) // We are devirtualizing to a Equals(T) method which also implements PER semantics (5537: this should be ER semantics) - | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_er_inner_vref ty args -> + | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_er_inner_vref ty args -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsValues with @@ -2560,7 +2560,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerFast - | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_inner_vref ty args -> + | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_inner_vref ty args -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, _, withcEqualsVal), [comp; x; y] -> @@ -2570,7 +2570,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparer - | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_per_inner_vref ty args && not(isRefTupleTy cenv.g ty) -> + | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_per_inner_vref ty args && not(isRefTupleTy cenv.g ty) -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, _, withcEqualsVal), [x; y] -> @@ -2579,7 +2579,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashIntrinsic - | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_inner_vref ty args -> + | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_inner_vref ty args -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, withcGetHashCodeVal, _), [x] -> @@ -2588,7 +2588,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic - | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_withc_inner_vref ty args -> + | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_withc_inner_vref ty args -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, withcGetHashCodeVal, _), [comp; x] -> @@ -2597,7 +2597,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types - | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_comparison_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val (v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_comparison_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2611,7 +2611,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types - | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_hash_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val (v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_hash_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2627,7 +2627,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic for tuple types // REVIEW (5537): GenericEqualityIntrinsic implements PER semantics, and we are replacing it to something also // implementing PER semantics. However GenericEqualityIntrinsic should implement ER semantics. - | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val (v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2641,7 +2641,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types - | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val (v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2655,7 +2655,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types - | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_hash_withc_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val (v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_hash_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2669,7 +2669,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerIntrinsic for tuple types - | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_equality_withc_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val (v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_equality_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2685,7 +2685,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = // Calls to LanguagePrimitives.IntrinsicFunctions.UnboxGeneric can be optimized to calls to UnboxFast when we know that the // target type isn't 'NullNotLiked', i.e. that the target type is not an F# union, record etc. // Note UnboxFast is just the .NET IL 'unbox.any' instruction. - | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.unbox_vref && + | Expr.Val (v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.unbox_vref && canUseUnboxFast cenv.g m ty -> Some(DevirtualizeApplication cenv env cenv.g.unbox_fast_vref ty tyargs args m) @@ -2693,13 +2693,13 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = // Calls to LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric can be optimized to calls to TypeTestFast when we know that the // target type isn't 'NullNotTrueValue', i.e. that the target type is not an F# union, record etc. // Note TypeTestFast is just the .NET IL 'isinst' instruction followed by a non-null comparison - | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.istype_vref && + | Expr.Val (v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.istype_vref && canUseTypeTestFast cenv.g ty -> Some(DevirtualizeApplication cenv env cenv.g.istype_fast_vref ty tyargs args m) // Don't fiddle with 'methodhandleof' calls - just remake the application - | Expr.Val(vref, _, _), _, _ when valRefEq cenv.g vref cenv.g.methodhandleof_vref -> + | Expr.Val (vref, _, _), _, _ when valRefEq cenv.g vref cenv.g.methodhandleof_vref -> Some( MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref, vref.Type, (if isNil tyargs then [] else [tyargs]), args, m), { TotalSize=1 FunctionSize=1 @@ -2730,7 +2730,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) let isBaseCall = not (List.isEmpty args) && match args.[0] with - | Expr.Val(vref, _, _) when vref.BaseOrThisInfo = BaseVal -> true + | Expr.Val (vref, _, _) when vref.BaseOrThisInfo = BaseVal -> true | _ -> false if isBaseCall then None else @@ -2745,7 +2745,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) match finfo.Info with | ValValue(vref, _) -> match vref.ApparentEnclosingEntity with - | Parent(tcr) when (tyconRefEq cenv.g cenv.g.lazy_tcr_canon tcr) -> + | Parent tcr when (tyconRefEq cenv.g cenv.g.lazy_tcr_canon tcr) -> match tcr.CompiledRepresentation with | CompiledTypeRepr.ILAsmNamed(iltr, _, _) -> iltr.Scope.AssemblyRef.Name = "FSharp.Core" | _ -> false @@ -2802,7 +2802,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = let shapes = match newf0 with - | Expr.Val(vref, _, _) -> + | Expr.Val (vref, _, _) -> match vref.ValReprInfo with | Some(ValReprInfo(_, detupArgsL, _)) -> let nargs = args.Length @@ -2866,7 +2866,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = match e with | Expr.Lambda (lambdaId, _, _, _, _, m, _) - | Expr.TyLambda(lambdaId, _, _, m, _) -> + | Expr.TyLambda (lambdaId, _, _, m, _) -> let tps, ctorThisValOpt, baseValOpt, vsl, body, bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo e let env = { env with functionVal = (match vspec with None -> None | Some v -> Some (v, topValInfo)) } let env = Option.foldBack (BindInternalValToUnknown cenv) ctorThisValOpt env @@ -2952,7 +2952,7 @@ and OptimizeDecisionTreeTargets cenv env m targets = and ReshapeExpr cenv (shape, e) = match shape, e with - | TupleValue(subshapes), Expr.Val(_vref, _vFlags, m) -> + | TupleValue subshapes, Expr.Val (_vref, _vFlags, m) -> let tinst = destRefTupleTy cenv.g (tyOfExpr cenv.g e) let subshapes = Array.toList subshapes mkRefTupled cenv.g m (List.mapi (fun i subshape -> ReshapeExpr cenv (subshape, mkTupleFieldGet cenv.g (tupInfoRef, e, tinst, i, m))) subshapes) tinst @@ -3086,8 +3086,8 @@ and TryOptimizeDecisionTreeTest cenv test vinfo = match test, vinfo with | DecisionTreeTest.UnionCase (c1, _), StripUnionCaseValue(c2, _) -> Some(cenv.g.unionCaseRefEq c1 c2) | DecisionTreeTest.ArrayLength (_, _), _ -> None - | DecisionTreeTest.Const c1, StripConstValue(c2) -> if c1 = Const.Zero || c2 = Const.Zero then None else Some(c1=c2) - | DecisionTreeTest.IsNull, StripConstValue(c2) -> Some(c2=Const.Zero) + | DecisionTreeTest.Const c1, StripConstValue c2 -> if c1 = Const.Zero || c2 = Const.Zero then None else Some(c1=c2) + | DecisionTreeTest.IsNull, StripConstValue c2 -> Some(c2=Const.Zero) | DecisionTreeTest.IsInst (_srcty1, _tgty1), _ -> None // These should not occur in optimization | DecisionTreeTest.ActivePatternCase (_, _, _vrefOpt1, _, _), _ -> None @@ -3100,11 +3100,11 @@ and OptimizeSwitch cenv env (e, cases, dflt, m) = let cases, dflt = if cenv.settings.EliminateSwitch() && not einfo.HasEffect then // Attempt to find a definite success, i.e. the first case where there is definite success - match (List.tryFind (function (TCase(d2, _)) when TryOptimizeDecisionTreeTest cenv d2 einfo.Info = Some(true) -> true | _ -> false) cases) with - | Some(TCase(_, case)) -> [], Some(case) + match (List.tryFind (function (TCase(d2, _)) when TryOptimizeDecisionTreeTest cenv d2 einfo.Info = Some true -> true | _ -> false) cases) with + | Some(TCase(_, case)) -> [], Some case | _ -> // Filter definite failures - cases |> List.filter (function (TCase(d2, _)) when TryOptimizeDecisionTreeTest cenv d2 einfo.Info = Some(false) -> false | _ -> true), + cases |> List.filter (function (TCase(d2, _)) when TryOptimizeDecisionTreeTest cenv d2 einfo.Info = Some false -> false | _ -> true), dflt else cases, dflt @@ -3290,7 +3290,7 @@ and OptimizeModuleExpr cenv env x = | TMDefLet(bind, m) -> if Zset.contains bind.Var deadSet then TMDefRec(false, [], [], m) else x | TMDefDo _ -> x - | TMDefs(defs) -> TMDefs(List.map elimModDef defs) + | TMDefs defs -> TMDefs(List.map elimModDef defs) | TMAbstract _ -> x and elimModuleBinding x = @@ -3327,10 +3327,10 @@ and OptimizeModuleDef cenv (env, bindInfosColl) x = ModuleOrNamespaceInfos = NameMap.ofList minfos}), (env, bindInfosColl) - | TMAbstract(mexpr) -> + | TMAbstract mexpr -> let mexpr, info = OptimizeModuleExpr cenv env mexpr let env = BindValsInModuleOrNamespace cenv info env - (TMAbstract(mexpr), info), (env, bindInfosColl) + (TMAbstract mexpr, info), (env, bindInfosColl) | TMDefLet(bind, m) -> let ((bindR, binfo) as bindInfo), env = OptimizeBinding cenv false env bind @@ -3344,9 +3344,9 @@ and OptimizeModuleDef cenv (env, bindInfosColl) x = (TMDefDo(e, m), EmptyModuleInfo), (env, bindInfosColl) - | TMDefs(defs) -> + | TMDefs defs -> let (defs, info), (env, bindInfosColl) = OptimizeModuleDefs cenv (env, bindInfosColl) defs - (TMDefs(defs), info), (env, bindInfosColl) + (TMDefs defs, info), (env, bindInfosColl) and OptimizeModuleBindings cenv (env, bindInfosColl) xs = List.mapFold (OptimizeModuleBinding cenv) (env, bindInfosColl) xs diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 0f4bf494c..262589fcd 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -60,7 +60,7 @@ type Pattern = | TPat_array(_, _, m) -> m | TPat_recd(_, _, _, m) -> m | TPat_range(_, _, m) -> m - | TPat_null(m) -> m + | TPat_null m -> m | TPat_isinst(_, _, _, m) -> m and PatternValBinding = PBind of Val * TypeScheme @@ -152,7 +152,7 @@ let rec pathEq p1 p2 = | PathUnionConstr(p1, _, _, n1), PathUnionConstr(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2 | PathArray(p1, _, _, n1), PathArray(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2 | PathExnConstr(p1, _, n1), PathExnConstr(p2, _, n2) -> (n1 = n2) && pathEq p1 p2 - | PathEmpty(_), PathEmpty(_) -> true + | PathEmpty _, PathEmpty _ -> true | _ -> false @@ -202,21 +202,21 @@ let RefuteDiscrimSet g m path discrims = go p (fun _ -> mkRefTupled g m k tys, eCoversVals) | PathRecd (p, tcref, tinst, j) -> let flds, eCoversVals = tcref |> actualTysOfInstanceRecdFields (mkTyconRefInst tcref tinst) |> mkOneKnown tm j - go p (fun _ -> Expr.Op(TOp.Recd(RecdExpr, tcref), tinst, flds, m), eCoversVals) + go p (fun _ -> Expr.Op (TOp.Recd (RecdExpr, tcref), tinst, flds, m), eCoversVals) | PathUnionConstr (p, ucref, tinst, j) -> let flds, eCoversVals = ucref |> actualTysOfUnionCaseFields (mkTyconRefInst ucref.TyconRef tinst)|> mkOneKnown tm j - go p (fun _ -> Expr.Op(TOp.UnionCase(ucref), tinst, flds, m), eCoversVals) + go p (fun _ -> Expr.Op (TOp.UnionCase ucref, tinst, flds, m), eCoversVals) | PathArray (p, ty, len, n) -> let flds, eCoversVals = mkOneKnown tm n (List.replicate len ty) - go p (fun _ -> Expr.Op(TOp.Array, [ty], flds, m), eCoversVals) + go p (fun _ -> Expr.Op (TOp.Array, [ty], flds, m), eCoversVals) | PathExnConstr (p, ecref, n) -> let flds, eCoversVals = ecref |> recdFieldTysOfExnDefRef |> mkOneKnown tm n - go p (fun _ -> Expr.Op(TOp.ExnConstr(ecref), [], flds, m), eCoversVals) + go p (fun _ -> Expr.Op (TOp.ExnConstr ecref, [], flds, m), eCoversVals) - | PathEmpty(ty) -> tm ty + | PathEmpty ty -> tm ty and mkOneKnown tm n tys = let flds = List.mapi (fun i ty -> if i = n then tm ty else (mkUnknown ty, false)) tys @@ -230,21 +230,21 @@ let RefuteDiscrimSet g m path discrims = | [DecisionTreeTest.IsInst (_, _)] -> snd(mkCompGenLocal m otherSubtypeText ty), false | (DecisionTreeTest.Const c :: rest) -> - let consts = Set.ofList (c :: List.choose (function DecisionTreeTest.Const(c) -> Some c | _ -> None) rest) + let consts = Set.ofList (c :: List.choose (function DecisionTreeTest.Const c -> Some c | _ -> None) rest) let c' = - Seq.tryFind (fun c -> not (consts.Contains(c))) + Seq.tryFind (fun c -> not (consts.Contains c)) (match c with - | Const.Bool _ -> [ true; false ] |> List.toSeq |> Seq.map (fun v -> Const.Bool(v)) - | Const.SByte _ -> Seq.append (seq { 0y .. System.SByte.MaxValue }) (seq { System.SByte.MinValue .. 0y })|> Seq.map (fun v -> Const.SByte(v)) - | Const.Int16 _ -> Seq.append (seq { 0s .. System.Int16.MaxValue }) (seq { System.Int16.MinValue .. 0s }) |> Seq.map (fun v -> Const.Int16(v)) - | Const.Int32 _ -> Seq.append (seq { 0 .. System.Int32.MaxValue }) (seq { System.Int32.MinValue .. 0 })|> Seq.map (fun v -> Const.Int32(v)) - | Const.Int64 _ -> Seq.append (seq { 0L .. System.Int64.MaxValue }) (seq { System.Int64.MinValue .. 0L })|> Seq.map (fun v -> Const.Int64(v)) - | Const.IntPtr _ -> Seq.append (seq { 0L .. System.Int64.MaxValue }) (seq { System.Int64.MinValue .. 0L })|> Seq.map (fun v -> Const.IntPtr(v)) - | Const.Byte _ -> seq { 0uy .. System.Byte.MaxValue } |> Seq.map (fun v -> Const.Byte(v)) - | Const.UInt16 _ -> seq { 0us .. System.UInt16.MaxValue } |> Seq.map (fun v -> Const.UInt16(v)) - | Const.UInt32 _ -> seq { 0u .. System.UInt32.MaxValue } |> Seq.map (fun v -> Const.UInt32(v)) - | Const.UInt64 _ -> seq { 0UL .. System.UInt64.MaxValue } |> Seq.map (fun v -> Const.UInt64(v)) - | Const.UIntPtr _ -> seq { 0UL .. System.UInt64.MaxValue } |> Seq.map (fun v -> Const.UIntPtr(v)) + | Const.Bool _ -> [ true; false ] |> List.toSeq |> Seq.map (fun v -> Const.Bool v) + | Const.SByte _ -> Seq.append (seq { 0y .. System.SByte.MaxValue }) (seq { System.SByte.MinValue .. 0y })|> Seq.map (fun v -> Const.SByte v) + | Const.Int16 _ -> Seq.append (seq { 0s .. System.Int16.MaxValue }) (seq { System.Int16.MinValue .. 0s }) |> Seq.map (fun v -> Const.Int16 v) + | Const.Int32 _ -> Seq.append (seq { 0 .. System.Int32.MaxValue }) (seq { System.Int32.MinValue .. 0 })|> Seq.map (fun v -> Const.Int32 v) + | Const.Int64 _ -> Seq.append (seq { 0L .. System.Int64.MaxValue }) (seq { System.Int64.MinValue .. 0L })|> Seq.map (fun v -> Const.Int64 v) + | Const.IntPtr _ -> Seq.append (seq { 0L .. System.Int64.MaxValue }) (seq { System.Int64.MinValue .. 0L })|> Seq.map (fun v -> Const.IntPtr v) + | Const.Byte _ -> seq { 0uy .. System.Byte.MaxValue } |> Seq.map (fun v -> Const.Byte v) + | Const.UInt16 _ -> seq { 0us .. System.UInt16.MaxValue } |> Seq.map (fun v -> Const.UInt16 v) + | Const.UInt32 _ -> seq { 0u .. System.UInt32.MaxValue } |> Seq.map (fun v -> Const.UInt32 v) + | Const.UInt64 _ -> seq { 0UL .. System.UInt64.MaxValue } |> Seq.map (fun v -> Const.UInt64 v) + | Const.UIntPtr _ -> seq { 0UL .. System.UInt64.MaxValue } |> Seq.map (fun v -> Const.UIntPtr v) | Const.Double _ -> seq { 0 .. System.Int32.MaxValue } |> Seq.map (fun v -> Const.Double(float v)) | Const.Single _ -> seq { 0 .. System.Int32.MaxValue } |> Seq.map (fun v -> Const.Single(float32 v)) | Const.Char _ -> seq { 32us .. System.UInt16.MaxValue } |> Seq.map (fun v -> Const.Char(char v)) @@ -277,11 +277,11 @@ let RefuteDiscrimSet g m path discrims = let nonCoveredEnumValues = Seq.tryFind (fun (_, fldValue) -> not (consts.Contains fldValue)) enumValues match nonCoveredEnumValues with - | None -> Expr.Const(c, m, ty), true + | None -> Expr.Const (c, m, ty), true | Some (fldName, _) -> let v = RecdFieldRef.RFRef(tcref, fldName) - Expr.Op(TOp.ValFieldGet v, [ty], [], m), false - | _ -> Expr.Const(c, m, ty), false + Expr.Op (TOp.ValFieldGet v, [ty], [], m), false + | _ -> Expr.Const (c, m, ty), false | (DecisionTreeTest.UnionCase (ucref1, tinst) :: rest) -> let ucrefs = ucref1 :: List.choose (function DecisionTreeTest.UnionCase(ucref, _) -> Some ucref | _ -> None) rest @@ -295,10 +295,10 @@ let RefuteDiscrimSet g m path discrims = | [] -> raise CannotRefute | ucref2 :: _ -> let flds = ucref2 |> actualTysOfUnionCaseFields (mkTyconRefInst tcref tinst) |> mkUnknowns - Expr.Op(TOp.UnionCase(ucref2), tinst, flds, m), false + Expr.Op (TOp.UnionCase ucref2, tinst, flds, m), false | [DecisionTreeTest.ArrayLength (n, ty)] -> - Expr.Op(TOp.Array, [ty], mkUnknowns (List.replicate (n+1) ty), m), false + Expr.Op (TOp.Array, [ty], mkUnknowns (List.replicate (n+1) ty), m), false | _ -> raise CannotRefute @@ -306,26 +306,26 @@ let RefuteDiscrimSet g m path discrims = let rec CombineRefutations g r1 r2 = match r1, r2 with - | Expr.Val(vref, _, _), other | other, Expr.Val(vref, _, _) when vref.LogicalName = "_" -> other - | Expr.Val(vref, _, _), other | other, Expr.Val(vref, _, _) when vref.LogicalName = notNullText -> other - | Expr.Val(vref, _, _), other | other, Expr.Val(vref, _, _) when vref.LogicalName = otherSubtypeText -> other + | Expr.Val (vref, _, _), other | other, Expr.Val (vref, _, _) when vref.LogicalName = "_" -> other + | Expr.Val (vref, _, _), other | other, Expr.Val (vref, _, _) when vref.LogicalName = notNullText -> other + | Expr.Val (vref, _, _), other | other, Expr.Val (vref, _, _) when vref.LogicalName = otherSubtypeText -> other - | Expr.Op((TOp.ExnConstr(ecref1) as op1), tinst1, flds1, m1), Expr.Op(TOp.ExnConstr(ecref2), _, flds2, _) when tyconRefEq g ecref1 ecref2 -> - Expr.Op(op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) + | Expr.Op ((TOp.ExnConstr ecref1 as op1), tinst1, flds1, m1), Expr.Op (TOp.ExnConstr ecref2, _, flds2, _) when tyconRefEq g ecref1 ecref2 -> + Expr.Op (op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) - | Expr.Op((TOp.UnionCase(ucref1) as op1), tinst1, flds1, m1), Expr.Op(TOp.UnionCase(ucref2), _, flds2, _) -> + | Expr.Op ((TOp.UnionCase ucref1 as op1), tinst1, flds1, m1), Expr.Op (TOp.UnionCase ucref2, _, flds2, _) -> if g.unionCaseRefEq ucref1 ucref2 then - Expr.Op(op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) + Expr.Op (op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) (* Choose the greater of the two ucrefs based on name ordering *) elif ucref1.CaseName < ucref2.CaseName then r2 else r1 - | Expr.Op(op1, tinst1, flds1, m1), Expr.Op(_, _, flds2, _) -> - Expr.Op(op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) + | Expr.Op (op1, tinst1, flds1, m1), Expr.Op (_, _, flds2, _) -> + Expr.Op (op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) - | Expr.Const(c1, m1, ty1), Expr.Const(c2, _, _) -> + | Expr.Const (c1, m1, ty1), Expr.Const (c2, _, _) -> let c12 = // Make sure longer strings are greater, not the case in the default ordinal comparison @@ -338,11 +338,11 @@ let rec CombineRefutations g r1 r2 = else s1 match c1, c2 with - | Const.String(s1), Const.String(s2) -> Const.String(MaxStrings s1 s2) - | Const.Decimal(s1), Const.Decimal(s2) -> Const.Decimal(max s1 s2) + | Const.String s1, Const.String s2 -> Const.String(MaxStrings s1 s2) + | Const.Decimal s1, Const.Decimal s2 -> Const.Decimal(max s1 s2) | _ -> max c1 c2 - Expr.Const(c12, m1, ty1) + Expr.Const (c12, m1, ty1) | _ -> r1 @@ -601,11 +601,11 @@ let rec BuildSwitch inpExprOpt g expr edges dflt m = let _v, vExpr, bind = mkCompGenLocalAndInvisbleBind g "testExpr" m testexpr mkLetBind m bind (mkLazyAnd g m (mkNonNullTest g m vExpr) (mkILAsmCeq g m (mkLdlen g m vExpr) (mkInt g m n))) | DecisionTreeTest.Const (Const.String _ as c) -> - mkCallEqualsOperator g m g.string_ty testexpr (Expr.Const(c, m, g.string_ty)) + mkCallEqualsOperator g m g.string_ty testexpr (Expr.Const (c, m, g.string_ty)) | DecisionTreeTest.Const (Const.Decimal _ as c) -> - mkCallEqualsOperator g m g.decimal_ty testexpr (Expr.Const(c, m, g.decimal_ty)) + mkCallEqualsOperator g m g.decimal_ty testexpr (Expr.Const (c, m, g.decimal_ty)) | DecisionTreeTest.Const ((Const.Double _ | Const.Single _ | Const.Int64 _ | Const.UInt64 _ | Const.IntPtr _ | Const.UIntPtr _) as c) -> - mkILAsmCeq g m testexpr (Expr.Const(c, m, tyOfExpr g testexpr)) + mkILAsmCeq g m testexpr (Expr.Const (c, m, tyOfExpr g testexpr)) | _ -> error(InternalError("strange switch", m)) mkBoolSwitch m testexpr tree sofar) edges @@ -631,17 +631,17 @@ let rec BuildSwitch inpExprOpt g expr edges dflt m = | None, h::t -> compactify (Some [h]) t | Some (prev::moreprev), h::t -> match constOfCase prev, constOfCase h with - | Const.SByte iprev, Const.SByte inext when int32(iprev) + 1 = int32 inext -> + | Const.SByte iprev, Const.SByte inext when int32 iprev + 1 = int32 inext -> compactify (Some (h::prev::moreprev)) t - | Const.Int16 iprev, Const.Int16 inext when int32(iprev) + 1 = int32 inext -> + | Const.Int16 iprev, Const.Int16 inext when int32 iprev + 1 = int32 inext -> compactify (Some (h::prev::moreprev)) t | Const.Int32 iprev, Const.Int32 inext when iprev+1 = inext -> compactify (Some (h::prev::moreprev)) t - | Const.Byte iprev, Const.Byte inext when int32(iprev) + 1 = int32 inext -> + | Const.Byte iprev, Const.Byte inext when int32 iprev + 1 = int32 inext -> compactify (Some (h::prev::moreprev)) t - | Const.UInt16 iprev, Const.UInt16 inext when int32(iprev)+1 = int32 inext -> + | Const.UInt16 iprev, Const.UInt16 inext when int32 iprev+1 = int32 inext -> compactify (Some (h::prev::moreprev)) t - | Const.UInt32 iprev, Const.UInt32 inext when int32(iprev)+1 = int32 inext -> + | Const.UInt32 iprev, Const.UInt32 inext when int32 iprev+1 = int32 inext -> compactify (Some (h::prev::moreprev)) t | Const.Char cprev, Const.Char cnext when (int32 cprev + 1 = int32 cnext) -> compactify (Some (h::prev::moreprev)) t @@ -748,7 +748,7 @@ let CompilePatternBasic // Add the incomplete or rethrow match clause on demand, printing a // warning if necessary (only if it is ever exercised) let incompleteMatchClauseOnce = ref None - let getIncompleteMatchClause (refuted) = + let getIncompleteMatchClause refuted = // This is lazy because emit a // warning when the lazy thunk gets evaluated match !incompleteMatchClauseOnce with @@ -805,7 +805,7 @@ let CompilePatternBasic let tg = TTarget(List.empty, throwExpr, SuppressSequencePointAtTarget ) mbuilder.AddTarget tg |> ignore let clause = TClause(TPat_wild matchm, None, tg, matchm) - incompleteMatchClauseOnce := Some(clause) + incompleteMatchClauseOnce := Some clause clause | Some c -> c @@ -816,7 +816,7 @@ let CompilePatternBasic let GetClause i refuted = if i < nclauses then clausesA.[i] - elif i = nclauses then getIncompleteMatchClause(refuted) + elif i = nclauses then getIncompleteMatchClause refuted else failwith "GetClause" let GetValsBoundByClause i refuted = (GetClause i refuted).BoundVals let GetWhenGuardOfClause i refuted = (GetClause i refuted).GuardExpr @@ -907,7 +907,7 @@ let CompilePatternBasic | None -> rhs' /// Select the set of discriminators which we can handle in one test, or as a series of - /// iterated tests, e.g. in the case of TPat_isinst. Ensure we only take at most one class of TPat_query(_) at a time. + /// iterated tests, e.g. in the case of TPat_isinst. Ensure we only take at most one class of `TPat_query` at a time. /// Record the rule numbers so we know which rule the TPat_query cam from, so that when we project through /// the frontier we only project the right rule. and ChooseSimultaneousEdges frontiers path = @@ -963,7 +963,7 @@ let CompilePatternBasic let argExpr = GetSubExprOfInput subexpr let argExpr = match argExpr, _origInputExprOpt with - | Expr.Val(v1, _, _), Some origInputExpr when valEq origInputVal v1.Deref && IsCopyableInputExpr origInputExpr -> origInputExpr + | Expr.Val (v1, _, _), Some origInputExpr when valEq origInputVal v1.Deref && IsCopyableInputExpr origInputExpr -> origInputExpr | _ -> argExpr let vOpt, addrExp, _readonly, _writeonly = mkExprAddrOfExprAux g true false NeverMutates argExpr None matchm match vOpt with @@ -1003,7 +1003,7 @@ let CompilePatternBasic let argExpr = GetSubExprOfInput subexpr let appExpr = mkApps g ((activePatExpr, tyOfExpr g activePatExpr), [], [argExpr], m) - Some(vExpr), Some(mkInvisibleBind v appExpr) + Some vExpr, Some(mkInvisibleBind v appExpr) | _ -> None, None @@ -1081,7 +1081,7 @@ let CompilePatternBasic isMemOfActives path active' && let p = lookupActive path active' |> snd match getDiscrimOfPattern p with - | Some(discrim) -> List.exists (isDiscrimSubsumedBy g amap exprm discrim) simulSetOfDiscrims + | Some discrim -> List.exists (isDiscrimSubsumedBy g amap exprm discrim) simulSetOfDiscrims | None -> false match simulSetOfDiscrims with @@ -1293,7 +1293,7 @@ let CompilePatternBasic ((clausesL |> List.mapi (fun i c -> let initialSubExpr = SubExpr((fun _tpinst x -> x), (exprForVal origInputVal.Range origInputVal, origInputVal)) - let investigations = BindProjectionPattern (Active(PathEmpty(inputTy), initialSubExpr, c.Pattern)) ([], ValMap<_>.Empty) + let investigations = BindProjectionPattern (Active(PathEmpty inputTy, initialSubExpr, c.Pattern)) ([], ValMap<_>.Empty) mkFrontiers investigations i) |> List.concat) @ diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index cf4d4e4ad..41f8e398c 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -202,7 +202,7 @@ type cenv = /// Check if the value is an argument of a function let IsValArgument env (v: Val) = - env.argVals.ContainsVal(v) + env.argVals.ContainsVal v /// Check if the value is a local, not an argument of a function. let IsValLocal env (v: Val) = @@ -551,9 +551,9 @@ let rec mkArgsForAppliedExpr isBaseCall argsl x = // recognise val | Expr.Val (vref, _, _) -> mkArgsForAppliedVal isBaseCall vref argsl // step through instantiations - | Expr.App(f, _fty, _tyargs, [], _) -> mkArgsForAppliedExpr isBaseCall argsl f + | Expr.App (f, _fty, _tyargs, [], _) -> mkArgsForAppliedExpr isBaseCall argsl f // step through subsumption coercions - | Expr.Op(TOp.Coerce, _, [f], _) -> mkArgsForAppliedExpr isBaseCall argsl f + | Expr.Op (TOp.Coerce, _, [f], _) -> mkArgsForAppliedExpr isBaseCall argsl f | _ -> [] /// Check types occurring in the TAST. @@ -631,7 +631,7 @@ let CheckTypeInstNoInnerByrefs cenv env m tyargs = /// Applied functions get wrapped in coerce nodes for subsumption coercions let (|OptionalCoerce|) = function - | Expr.Op(TOp.Coerce _, _, [Expr.App(f, _, _, [], _)], _) -> f + | Expr.Op (TOp.Coerce _, _, [Expr.App (f, _, _, [], _)], _) -> f | x -> x /// Check an expression doesn't contain a 'reraise' @@ -742,29 +742,29 @@ and CheckForOverAppliedExceptionRaisingPrimitive (cenv: cenv) expr = // Some things are more easily checked prior to NormalizeAndAdjustPossibleSubsumptionExprs match expr with - | Expr.App(f, _fty, _tyargs, argsl, _m) -> + | Expr.App (f, _fty, _tyargs, argsl, _m) -> if cenv.reportErrors then // Special diagnostics for `raise`, `failwith`, `failwithf`, `nullArg`, `invalidOp` library intrinsics commonly used to raise exceptions // to warn on over-application. match f with - | OptionalCoerce(Expr.Val(v, _, funcRange)) + | OptionalCoerce(Expr.Val (v, _, funcRange)) when (valRefEq g v g.raise_vref || valRefEq g v g.failwith_vref || valRefEq g v g.null_arg_vref || valRefEq g v g.invalid_op_vref) -> match argsl with | [] | [_] -> () | _ :: _ :: _ -> warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 1, argsl.Length), funcRange)) - | OptionalCoerce(Expr.Val(v, _, funcRange)) when valRefEq g v g.invalid_arg_vref -> + | OptionalCoerce(Expr.Val (v, _, funcRange)) when valRefEq g v g.invalid_arg_vref -> match argsl with | [] | [_] | [_; _] -> () | _ :: _ :: _ :: _ -> warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 2, argsl.Length), funcRange)) - | OptionalCoerce(Expr.Val(failwithfFunc, _, funcRange)) when valRefEq g failwithfFunc g.failwithf_vref -> + | OptionalCoerce(Expr.Val (failwithfFunc, _, funcRange)) when valRefEq g failwithfFunc g.failwithf_vref -> match argsl with - | Expr.App (Expr.Val(newFormat, _, _), _, [_; typB; typC; _; _], [Expr.Const(Const.String formatString, formatRange, _)], _) :: xs when valRefEq g newFormat g.new_format_vref -> + | Expr.App (Expr.Val (newFormat, _, _), _, [_; typB; typC; _; _], [Expr.Const (Const.String formatString, formatRange, _)], _) :: xs when valRefEq g newFormat g.new_format_vref -> match CheckFormatStrings.TryCountFormatStringArguments formatRange g formatString typB typC with | Some n -> let expected = n + 1 @@ -932,7 +932,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi | Expr.Val (vref, vFlags, m) -> CheckValUse cenv env (vref, vFlags, m) context - | Expr.Quote(ast, savedConv, _isFromQueryExpression, m, ty) -> + | Expr.Quote (ast, savedConv, _isFromQueryExpression, m, ty) -> CheckExprNoByrefs cenv {env with quote=true} ast if cenv.reportErrors then cenv.usesQuotations <- true @@ -968,7 +968,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi NoLimit // Allow base calls to F# methods - | Expr.App((InnerExprPat(ExprValWithPossibleTypeInst(v, vFlags, _, _) as f)), _fty, tyargs, (Expr.Val(baseVal, _, _) :: rest), m) + | Expr.App ((InnerExprPat(ExprValWithPossibleTypeInst(v, vFlags, _, _) as f)), _fty, tyargs, (Expr.Val (baseVal, _, _) :: rest), m) when ((match vFlags with VSlotDirectCall -> true | _ -> false) && baseVal.BaseOrThisInfo = BaseVal) -> @@ -987,7 +987,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi CheckExprs cenv env rest (mkArgsForAppliedExpr true rest f) // Allow base calls to IL methods - | Expr.Op (TOp.ILCall (virt, _, _, _, _, _, _, mref, enclTypeArgs, methTypeArgs, tys), tyargs, (Expr.Val(baseVal, _, _)::rest), m) + | Expr.Op (TOp.ILCall (virt, _, _, _, _, _, _, mref, enclTypeArgs, methTypeArgs, tys), tyargs, (Expr.Val (baseVal, _, _)::rest), m) when not virt && baseVal.BaseOrThisInfo = BaseVal -> // Disallow calls to abstract base methods on IL types. @@ -1023,13 +1023,13 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi NoLimit // Allow '%expr' in quotations - | Expr.App(Expr.Val(vref, _, _), _, tinst, [arg], m) when isSpliceOperator g vref && env.quote -> + | Expr.App (Expr.Val (vref, _, _), _, tinst, [arg], m) when isSpliceOperator g vref && env.quote -> CheckTypeInstNoInnerByrefs cenv env m tinst // it's the splice operator, a byref instantiation is allowed CheckExprNoByrefs cenv env arg NoLimit // Check an application - | Expr.App(f, _fty, tyargs, argsl, m) -> + | Expr.App (f, _fty, tyargs, argsl, m) -> let returnTy = tyOfExpr g expr // This is to handle recursive cases. Don't check 'returnTy' again if we are still inside a app expression. @@ -1043,7 +1043,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi let hasReceiver = match f with - | Expr.Val(vref, _, _) when vref.IsInstanceMember && not argsl.IsEmpty -> true + | Expr.Val (vref, _, _) when vref.IsInstanceMember && not argsl.IsEmpty -> true | _ -> false let contexts = mkArgsForAppliedExpr false argsl f @@ -1052,22 +1052,22 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi else CheckCall cenv env m returnTy argsl contexts context - | Expr.Lambda(_, _ctorThisValOpt, _baseValOpt, argvs, _, m, rty) -> + | Expr.Lambda (_, _ctorThisValOpt, _baseValOpt, argvs, _, m, rty) -> let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty in CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes - | Expr.TyLambda(_, tps, _, m, rty) -> + | Expr.TyLambda (_, tps, _, m, rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) let ty = mkForallTyIfNeeded tps rty in CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes - | Expr.TyChoose(tps, e1, _) -> + | Expr.TyChoose (tps, e1, _) -> let env = BindTypars g env tps CheckExprNoByrefs cenv env e1 NoLimit - | Expr.Match(_, _, dtree, targets, m, ty) -> + | Expr.Match (_, _, dtree, targets, m, ty) -> CheckTypeNoInnerByrefs cenv env m ty // computed byrefs allowed at each branch CheckDecisionTree cenv env dtree CheckDecisionTreeTargets cenv env targets context @@ -1085,7 +1085,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi | TTyconEqualsTycon(ty1, ty2) -> CheckTypeNoByrefs cenv env m ty1 CheckTypeNoByrefs cenv env m ty2 - | TTyconIsStruct(ty1) -> + | TTyconIsStruct ty1 -> CheckTypeNoByrefs cenv env m ty1) NoLimit @@ -1118,22 +1118,22 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = (* Special cases *) match op, tyargs, args with // Handle these as special cases since mutables are allowed inside their bodies - | TOp.While _, _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _)] -> + | TOp.While _, _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _)] -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprsNoByRefLike cenv env [e1;e2] - | TOp.TryFinally _, [_], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> + | TOp.TryFinally _, [_], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)] -> CheckTypeInstNoInnerByrefs cenv env m tyargs // result of a try/finally can be a byref ctorLimitedZoneCheck() let limit = CheckExpr cenv env e1 context // result of a try/finally can be a byref if in a position where the overall expression is can be a byref CheckExprNoByrefs cenv env e2 limit - | TOp.For(_), _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _);Expr.Lambda(_, _, _, [_], e3, _, _)] -> + | TOp.For _, _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _);Expr.Lambda (_, _, _, [_], e3, _, _)] -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprsNoByRefLike cenv env [e1;e2;e3] - | TOp.TryCatch _, [_], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], _e2, _, _); Expr.Lambda(_, _, _, [_], e3, _, _)] -> + | TOp.TryCatch _, [_], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], _e2, _, _); Expr.Lambda (_, _, _, [_], e3, _, _)] -> CheckTypeInstNoInnerByrefs cenv env m tyargs // result of a try/catch can be a byref ctorLimitedZoneCheck() let limit1 = CheckExpr cenv env e1 context // result of a try/catch can be a byref if in a position where the overall expression is can be a byref @@ -1180,7 +1180,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = CheckTypeInstNoByrefs cenv env m tyargs CheckExprsNoByRefLike cenv env args - | TOp.LValueOp(LAddrOf _, vref), _, _ -> + | TOp.LValueOp (LAddrOf _, vref), _, _ -> let limit1 = GetLimitValByRef cenv env m vref.Deref let limit2 = CheckExprsNoByRefLike cenv env args let limit = CombineTwoLimits limit1 limit2 @@ -1203,7 +1203,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = limit - | TOp.LValueOp(LByrefSet, vref), _, [arg] -> + | TOp.LValueOp (LByrefSet, vref), _, [arg] -> let limit = GetLimitVal cenv env m vref.Deref let isVrefLimited = not (HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit) let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg) @@ -1211,7 +1211,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(vref.DisplayName), m)) NoLimit - | TOp.LValueOp(LByrefGet, vref), _, [] -> + | TOp.LValueOp (LByrefGet, vref), _, [] -> let limit = GetLimitVal cenv env m vref.Deref if HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit then @@ -1227,7 +1227,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = else { scope = 1; flags = LimitFlags.None } - | TOp.LValueOp(LSet _, vref), _, [arg] -> + | TOp.LValueOp (LSet _, vref), _, [arg] -> let isVrefLimited = not (HasLimitFlag LimitFlags.StackReferringSpanLike (GetLimitVal cenv env m vref.Deref)) let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg) if isVrefLimited && isArgLimited then @@ -1288,7 +1288,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = // C# applies a rule where the APIs to struct types can't return the addresses of fields in that struct. // There seems no particular reason for this given that other protections in the language, though allowing // it would mean "readonly" on a struct doesn't imply immutabality-of-contents - it only implies - if context.PermitOnlyReturnable && (match obj with Expr.Val(vref, _, _) -> vref.BaseOrThisInfo = MemberThisVal | _ -> false) && isByrefTy g (tyOfExpr g obj) then + if context.PermitOnlyReturnable && (match obj with Expr.Val (vref, _, _) -> vref.BaseOrThisInfo = MemberThisVal | _ -> false) && isByrefTy g (tyOfExpr g obj) then errorR(Error(FSComp.SR.chkStructsMayNotReturnAddressesOfContents(), m)) if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then @@ -1313,7 +1313,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(uref.CaseName), m)) - if context.PermitOnlyReturnable && (match obj with Expr.Val(vref, _, _) -> vref.BaseOrThisInfo = MemberThisVal | _ -> false) && isByrefTy g (tyOfExpr g obj) then + if context.PermitOnlyReturnable && (match obj with Expr.Val (vref, _, _) -> vref.BaseOrThisInfo = MemberThisVal | _ -> false) && isByrefTy g (tyOfExpr g obj) then errorR(Error(FSComp.SR.chkStructsMayNotReturnAddressesOfContents(), m)) CheckTypeInstNoByrefs cenv env m tyargs @@ -1341,13 +1341,13 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = // permit byref for lhs lvalue of readonly value CheckExprsPermitByRefLike cenv env args - | [ I_ldsflda (fspec) ], [] -> + | [ I_ldsflda fspec ], [] -> if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(fspec.Name), m)) NoLimit - | [ I_ldflda (fspec) ], [obj] -> + | [ I_ldflda fspec ], [obj] -> if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(fspec.Name), m)) @@ -1374,7 +1374,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = // allow args to be byref here CheckExprsPermitByRefLike cenv env args - | TOp.Recd(_, _), _, _ -> + | TOp.Recd (_, _), _, _ -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprsPermitByRefLike cenv env args @@ -1387,12 +1387,12 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn // The topValInfo here says we are _guaranteeing_ to compile a function value // as a .NET method with precisely the corresponding argument counts. match e with - | Expr.TyChoose(tps, e1, m) -> + | Expr.TyChoose (tps, e1, m) -> let env = BindTypars g env tps CheckLambdas isTop memInfo cenv env inlined topValInfo alwaysCheckNoReraise e1 m ety context | Expr.Lambda (_, _, _, _, _, m, _) - | Expr.TyLambda(_, _, _, m, _) -> + | Expr.TyLambda (_, _, _, m, _) -> let tps, ctorThisValOpt, baseValOpt, vsl, body, bodyty = destTopLambda g cenv.amap topValInfo (e, ety) in let env = BindTypars g env tps let thisAndBase = Option.toList ctorThisValOpt @ Option.toList baseValOpt @@ -1560,7 +1560,7 @@ and CheckAttribArgExpr cenv env expr = match expr with // Detect standard constants - | Expr.Const(c, m, _) -> + | Expr.Const (c, m, _) -> match c with | Const.Bool _ | Const.Int32 _ @@ -1581,13 +1581,13 @@ and CheckAttribArgExpr cenv env expr = if cenv.reportErrors then errorR (Error (FSComp.SR.tastNotAConstantExpression(), m)) - | Expr.Op(TOp.Array, [_elemTy], args, _m) -> + | Expr.Op (TOp.Array, [_elemTy], args, _m) -> List.iter (CheckAttribArgExpr cenv env) args | TypeOfExpr g _ -> () | TypeDefOfExpr g _ -> () - | Expr.Op(TOp.Coerce, _, [arg], _) -> + | Expr.Op (TOp.Coerce, _, [arg], _) -> CheckAttribArgExpr cenv env arg | EnumExpr g arg1 -> CheckAttribArgExpr cenv env arg1 @@ -1611,7 +1611,7 @@ and CheckAttribs cenv env (attribs: Attribs) = |> Seq.map fst |> Seq.toList // Filter for allowMultiple = false - |> List.filter (fun (tcref, m) -> TryFindAttributeUsageAttribute cenv.g m tcref <> Some(true)) + |> List.filter (fun (tcref, m) -> TryFindAttributeUsageAttribute cenv.g m tcref <> Some true) if cenv.reportErrors then for (tcref, m) in duplicates do @@ -1636,7 +1636,7 @@ and CheckValSpec permitByRefLike cenv env v = and AdjustAccess isHidden (cpath: unit -> CompilationPath) access = if isHidden then - let (TAccess(l)) = access + let (TAccess l) = access // FSharp 1.0 bug 1908: Values hidden by signatures are implicitly at least 'internal' let scoref = cpath().ILScopeRef TAccess(CompPath(scoref, [])::l) @@ -1726,7 +1726,7 @@ and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v, bindRhs, _) as QuotationTranslator.ConvMethodBase qscope env (v.CompiledName, v) |> ignore with | QuotationTranslator.InvalidQuotedTerm e -> - errorR(e) + errorR e match v.MemberInfo with | Some memberInfo when not v.IsIncrClassGeneratedMember -> @@ -1788,14 +1788,14 @@ let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = let hasDefaultAugmentation = tcref.IsUnionTycon && match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with - | Some(Attrib(_, _, [ AttribBoolArg(b) ], _, _, _, _)) -> b + | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> b | _ -> true (* not hiddenRepr *) let kind = (if v.IsMember then "member" else "value") let check skipValCheck nm = if not skipValCheck && v.IsModuleBinding && - tcref.ModuleOrNamespaceType.AllValsByLogicalName.ContainsKey(nm) && + tcref.ModuleOrNamespaceType.AllValsByLogicalName.ContainsKey nm && not (valEq tcref.ModuleOrNamespaceType.AllValsByLogicalName.[nm] v) then error(Duplicate(kind, v.DisplayName, v.Range)) @@ -1810,8 +1810,8 @@ let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = | "Tags" -> errorR(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.typeInfoGeneratedType(), "Tags", tcref.Range)) | _ -> if hasDefaultAugmentation then - match tcref.GetUnionCaseByName(nm) with - | Some(uc) -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.typeInfoUnionCase(), uc.DisplayName, uc.Range)) + match tcref.GetUnionCaseByName nm with + | Some uc -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.typeInfoUnionCase(), uc.DisplayName, uc.Range)) | None -> () let hasNoArgs = @@ -1827,20 +1827,20 @@ let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = // Default augmentation contains the nasty 'Case' etc. let prefix = "New" - if nm.StartsWithOrdinal(prefix) then + if nm.StartsWithOrdinal prefix then match tcref.GetUnionCaseByName(nm.[prefix.Length ..]) with - | Some(uc) -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.chkUnionCaseCompiledForm(), uc.DisplayName, uc.Range)) + | Some uc -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.chkUnionCaseCompiledForm(), uc.DisplayName, uc.Range)) | None -> () // Default augmentation contains the nasty 'Is' etc. let prefix = "Is" - if nm.StartsWithOrdinal(prefix) && hasDefaultAugmentation then + if nm.StartsWithOrdinal prefix && hasDefaultAugmentation then match tcref.GetUnionCaseByName(nm.[prefix.Length ..]) with - | Some(uc) -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.chkUnionCaseDefaultAugmentation(), uc.DisplayName, uc.Range)) + | Some uc -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.chkUnionCaseDefaultAugmentation(), uc.DisplayName, uc.Range)) | None -> () - match tcref.GetFieldByName(nm) with - | Some(rf) -> error(NameClash(nm, kind, v.DisplayName, v.Range, "field", rf.Name, rf.Range)) + match tcref.GetFieldByName nm with + | Some rf -> error(NameClash(nm, kind, v.DisplayName, v.Range, "field", rf.Name, rf.Range)) | None -> () check false v.CoreDisplayName @@ -1915,7 +1915,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = let ty = generalizedTyconRef tcref let env = { env with reflect = env.reflect || HasFSharpAttribute g g.attrib_ReflectedDefinitionAttribute tycon.Attribs } - let env = BindTypars g env (tycon.Typars(m)) + let env = BindTypars g env (tycon.Typars m) CheckAttribs cenv env tycon.Attribs @@ -1948,7 +1948,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = let immediateProps = GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomewhere) g cenv.amap m ty let getHash (hash: Dictionary) nm = - match hash.TryGetValue(nm) with + match hash.TryGetValue nm with | true, h -> h | _ -> [] @@ -2011,19 +2011,19 @@ let CheckEntityDefn cenv env (tycon: Entity) = match (optArgInfo, callerInfo) with | _, NoCallerInfo -> () | NotOptional, _ -> errorR(Error(FSComp.SR.tcCallerInfoNotOptional(callerInfo.ToString()), m)) - | CallerSide(_), CallerLineNumber -> + | CallerSide _, CallerLineNumber -> if not (typeEquiv g g.int32_ty ty) then errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerLineNumber -> if not ((isOptionTy g ty) && (typeEquiv g g.int32_ty (destOptionTy g ty))) then errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m)) - | CallerSide(_), CallerFilePath -> + | CallerSide _, CallerFilePath -> if not (typeEquiv g g.string_ty ty) then errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerFilePath -> if not ((isOptionTy g ty) && (typeEquiv g g.string_ty (destOptionTy g ty))) then errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m)) - | CallerSide(_), CallerMemberName -> + | CallerSide _, CallerMemberName -> if not (typeEquiv g g.string_ty ty) then errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerMemberName -> @@ -2098,9 +2098,9 @@ let CheckEntityDefn cenv env (tycon: Entity) = | Some minfo -> let mtext = NicePrint.stringOfMethInfo cenv.amap m cenv.denv minfo if parentMethsOfSameName |> List.exists (checkForDup EraseNone) then - warning(Error(FSComp.SR.tcNewMemberHidesAbstractMember(mtext), m)) + warning(Error(FSComp.SR.tcNewMemberHidesAbstractMember mtext, m)) else - warning(Error(FSComp.SR.tcNewMemberHidesAbstractMemberWithSuffix(mtext), m)) + warning(Error(FSComp.SR.tcNewMemberHidesAbstractMemberWithSuffix mtext, m)) if minfo.IsDispatchSlot then @@ -2111,9 +2111,9 @@ let CheckEntityDefn cenv env (tycon: Entity) = if parentMethsOfSameName |> List.exists (checkForDup EraseAll) then if parentMethsOfSameName |> List.exists (checkForDup EraseNone) then - errorR(Error(FSComp.SR.chkDuplicateMethodInheritedType(nm), m)) + errorR(Error(FSComp.SR.chkDuplicateMethodInheritedType nm, m)) else - errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix(nm), m)) + errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix nm, m)) if TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref && not tycon.IsStructOrEnumTycon then errorR(Error(FSComp.SR.tcByRefLikeNotStruct(), tycon.Range)) @@ -2195,7 +2195,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = for f in tycon.AllInstanceFieldsAsList do // Check if it's marked unsafe let zeroInitUnsafe = TryFindFSharpBoolAttribute g g.attrib_DefaultValueAttribute f.FieldAttribs - if zeroInitUnsafe = Some(true) then + if zeroInitUnsafe = Some true then if not (TypeHasDefaultValue g m ty) then errorR(Error(FSComp.SR.chkValueWithDefaultValueMustHaveDefaultValue(), m)) @@ -2243,8 +2243,8 @@ and CheckDefnInModule cenv env x = CheckNothingAfterEntryPoint cenv m CheckNoReraise cenv None e CheckExprNoByrefs cenv env e - | TMAbstract(def) -> CheckModuleExpr cenv env def - | TMDefs(defs) -> CheckDefnsInModule cenv env defs + | TMAbstract def -> CheckModuleExpr cenv env def + | TMDefs defs -> CheckDefnsInModule cenv env defs and CheckModuleSpec cenv env x = match x with @@ -2299,6 +2299,6 @@ let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, vi CheckModuleExpr cenv env mexpr CheckAttribs cenv env extraAttribs - if cenv.usesQuotations && QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat(g) = QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus then + if cenv.usesQuotations && QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat g = QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus then viewCcu.UsesFSharp20PlusQuotations <- true cenv.entryPointGiven, cenv.anonRecdTypes diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index cd71d0b75..2e6fcd707 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -131,11 +131,11 @@ let wfail e = raise (InvalidQuotedTerm e) let (|ModuleValueOrMemberUse|_|) g expr = let rec loop expr args = match stripExpr expr with - | Expr.App((InnerExprPat(Expr.Val(vref, vFlags, _) as f)), fty, tyargs, actualArgs, _m) when vref.IsMemberOrModuleBinding -> + | Expr.App ((InnerExprPat(Expr.Val (vref, vFlags, _) as f)), fty, tyargs, actualArgs, _m) when vref.IsMemberOrModuleBinding -> Some(vref, vFlags, f, fty, tyargs, actualArgs @ args) - | Expr.App(f, _fty, [], actualArgs, _) -> + | Expr.App (f, _fty, [], actualArgs, _) -> loop f (actualArgs @ args) - | (Expr.Val(vref, vFlags, _m) as f) when (match vref.DeclaringEntity with ParentNone -> false | _ -> true) -> + | (Expr.Val (vref, vFlags, _m) as f) when (match vref.DeclaringEntity with ParentNone -> false | _ -> true) -> let fty = tyOfExpr g f Some(vref, vFlags, f, fty, [], args) | _ -> @@ -144,14 +144,14 @@ let (|ModuleValueOrMemberUse|_|) g expr = let (|SimpleArrayLoopUpperBound|_|) expr = match expr with - | Expr.Op(TOp.ILAsm([AI_sub], _), _, [Expr.Op(TOp.ILAsm([I_ldlen; AI_conv ILBasicType.DT_I4], _), _, _, _); Expr.Const(Const.Int32 1, _, _) ], _) -> Some () + | Expr.Op (TOp.ILAsm ([AI_sub], _), _, [Expr.Op (TOp.ILAsm ([I_ldlen; AI_conv ILBasicType.DT_I4], _), _, _, _); Expr.Const (Const.Int32 1, _, _) ], _) -> Some () | _ -> None let (|SimpleArrayLoopBody|_|) g expr = match expr with - | Expr.Lambda(_, a, b, ([_] as args), Expr.Let(TBind(forVarLoop, Expr.Op(TOp.ILAsm([I_ldelem_any(ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx], m1), seqPoint), body, m2, freeVars), m, ty) -> - let body = Expr.Let(TBind(forVarLoop, mkCallArrayGet g m1 elemTy arr idx, seqPoint), body, m2, freeVars) - let expr = Expr.Lambda(newUnique(), a, b, args, body, m, ty) + | Expr.Lambda (_, a, b, ([_] as args), Expr.Let (TBind(forVarLoop, Expr.Op (TOp.ILAsm ([I_ldelem_any(ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx], m1), seqPoint), body, m2, freeVars), m, ty) -> + let body = Expr.Let (TBind(forVarLoop, mkCallArrayGet g m1 elemTy arr idx, seqPoint), body, m2, freeVars) + let expr = Expr.Lambda (newUnique(), a, b, args, body, m, ty) Some (arr, elemTy, expr) | _ -> None @@ -163,9 +163,9 @@ let (|ObjectInitializationCheck|_|) g expr = _, _, TDSwitch ( - Expr.Op(TOp.ILAsm([AI_clt], _), _, [Expr.Op(TOp.ValFieldGet((RFRef(_, name))), _, [Expr.Val(selfRef, NormalValUse, _)], _); Expr.Const(Const.Int32 1, _, _)], _), _, _, _ + Expr.Op (TOp.ILAsm ([AI_clt], _), _, [Expr.Op (TOp.ValFieldGet ((RFRef(_, name))), _, [Expr.Val (selfRef, NormalValUse, _)], _); Expr.Const (Const.Int32 1, _, _)], _), _, _, _ ), - [| TTarget([], Expr.App(Expr.Val(failInitRef, _, _), _, _, _, _), _); _ |], _, resultTy + [| TTarget([], Expr.App (Expr.Val (failInitRef, _, _), _, _, _, _), _); _ |], _, resultTy ) when IsCompilerGeneratedName name && name.StartsWithOrdinal("init") && @@ -221,7 +221,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // Recognize applications of module functions. match expr with // Detect expression tree exprSplices - | Expr.App(InnerExprPat(Expr.Val(vf, _, _)), _, _, x0::rest, m) + | Expr.App (InnerExprPat(Expr.Val (vf, _, _)), _, _, x0::rest, m) when isSplice cenv.g vf -> let idx = cenv.exprSplices.Count let ty = tyOfExpr cenv.g expr @@ -326,11 +326,11 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // we got here if quotation is represents a call with unit argument // let f () = () // <@ f @> // => (\arg -> f arg) => arg is Expr.Val - no-effects, first case - // <@ f() @> // Expr.Const(Unit) - no-effects - first case + // <@ f() @> // Expr.Const (Unit) - no-effects - first case // <@ f (someFunctionThatReturnsUnit) @> - potential effects - second case match arg with | Expr.Val _ - | Expr.Const(Const.Unit, _, _) -> subCall + | Expr.Const (Const.Unit, _, _) -> subCall | _ -> let argQ = ConvExpr cenv env arg QP.mkSequential(argQ, subCall) @@ -340,33 +340,33 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // Blast type application nodes and expression application nodes apart so values are left with just their type arguments - | Expr.App(f, fty, (_ :: _ as tyargs), (_ :: _ as args), m) -> + | Expr.App (f, fty, (_ :: _ as tyargs), (_ :: _ as args), m) -> let rfty = applyForallTy cenv.g fty tyargs ConvExpr cenv env (primMkApp (primMkApp (f, fty) tyargs [] m, rfty) [] args m) // Uses of possibly-polymorphic values - | Expr.App(InnerExprPat(Expr.Val(vref, _vFlags, m)), _fty, tyargs, [], _) -> + | Expr.App (InnerExprPat(Expr.Val (vref, _vFlags, m)), _fty, tyargs, [], _) -> ConvValRef true cenv env m vref tyargs // Simple applications - | Expr.App(f, _fty, tyargs, args, m) -> + | Expr.App (f, _fty, tyargs, args, m) -> if not (List.isEmpty tyargs) then wfail(Error(FSComp.SR.crefQuotationsCantContainGenericExprs(), m)) List.fold (fun fR arg -> QP.mkApp (fR, ConvExpr cenv env arg)) (ConvExpr cenv env f) args // REVIEW: what is the quotation view of literals accessing enumerations? Currently they show up as integers. - | Expr.Const(c, m, ty) -> + | Expr.Const (c, m, ty) -> ConvConst cenv env m c ty - | Expr.Val(vref, _vFlags, m) -> + | Expr.Val (vref, _vFlags, m) -> ConvValRef true cenv env m vref [] - | Expr.Let(bind, body, _, _) -> + | Expr.Let (bind, body, _, _) -> // The binding may be a compiler-generated binding that gets removed in the quotation presentation match ConvLetBind cenv env bind with | None, env -> ConvExpr cenv env body | Some(bindR), env -> QP.mkLet(bindR, ConvExpr cenv env body) - | Expr.LetRec(binds, body, _, _) -> + | Expr.LetRec (binds, body, _, _) -> let vs = valsOfBinds binds let vsR = vs |> List.map (ConvVal cenv env) let env = BindFlatVals env vs @@ -374,13 +374,13 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let bindsR = List.zip vsR (binds |> List.map (fun b -> ConvExpr cenv env b.Expr)) QP.mkLetRec(bindsR, bodyR) - | Expr.Lambda(_, _, _, vs, b, _, _) -> + | Expr.Lambda (_, _, _, vs, b, _, _) -> let v, b = MultiLambdaToTupledLambda cenv.g vs b let vR = ConvVal cenv env v let bR = ConvExpr cenv (BindVal env v) b QP.mkLambda(vR, bR) - | Expr.Quote(ast, _, _, _, ety) -> + | Expr.Quote (ast, _, _, _, ety) -> // F# 2.0-3.1 had a bug with nested 'raw' quotations. F# 4.0 + FSharp.Core 4.4.0.0+ allows us to do the right thing. if cenv.quotationFormat = QuotationSerializationFormat.FSharp_40_Plus && // Look for a 'raw' quotation @@ -398,7 +398,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. ConvDecisionTree cenv env tgs typR dtree // initialization check - | Expr.Sequential(ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) -> ConvExpr cenv env x1 + | Expr.Sequential (ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) -> ConvExpr cenv env x1 | Expr.Sequential (x0, x1, NormalSeq, _, _) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) | Expr.Obj (_, ty, _, _, [TObjExprMethod(TSlotSig(_, ctyp, _, _, _, _), _, tps, [tmvs], e, _) as tmethod], _, m) when isDelegateTy cenv.g ty -> let f = mkLambdas m tps tmvs (e, GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) @@ -411,7 +411,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | Expr.Sequential (x0, x1, ThenDoSeq, _, _) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) | Expr.Obj (_lambdaId, _typ, _basev, _basecall, _overrides, _iimpls, m) -> wfail(Error(FSComp.SR.crefQuotationsCantContainObjExprs(), m)) - | Expr.Op(op, tyargs, args, m) -> + | Expr.Op (op, tyargs, args, m) -> match op, tyargs, args with | TOp.UnionCase ucref, _, _ -> let mkR = ConvUnionCaseRef cenv ucref m @@ -448,45 +448,45 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | TOp.UnionCaseFieldGet (ucref, n), tyargs, [e] -> ConvUnionFieldGet cenv env m ucref n tyargs e - | TOp.ValFieldGetAddr(_rfref, _readonly), _tyargs, _ -> + | TOp.ValFieldGetAddr (_rfref, _readonly), _tyargs, _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m)) | TOp.UnionCaseFieldGetAddr _, _tyargs, _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m)) - | TOp.ValFieldGet(_rfref), _tyargs, [] -> + | TOp.ValFieldGet (_rfref), _tyargs, [] -> wfail(Error(FSComp.SR.crefQuotationsCantContainStaticFieldRef(), m)) - | TOp.ValFieldGet(rfref), tyargs, args -> + | TOp.ValFieldGet (rfref), tyargs, args -> ConvClassOrRecdFieldGet cenv env m rfref tyargs args - | TOp.TupleFieldGet(tupInfo, n), tyargs, [e] -> + | TOp.TupleFieldGet (tupInfo, n), tyargs, [e] -> let eR = ConvLValueExpr cenv env e let tyR = ConvType cenv env m (mkAnyTupledTy cenv.g tupInfo tyargs) QP.mkTupleGet(tyR, n, eR) - | TOp.ILAsm(([ I_ldfld(_, _, fspec) ] - | [ I_ldfld(_, _, fspec); AI_nop ] + | TOp.ILAsm (([ I_ldfld (_, _, fspec) ] + | [ I_ldfld (_, _, fspec); AI_nop ] | [ I_ldsfld (_, fspec) ] | [ I_ldsfld (_, fspec); AI_nop ]), _), enclTypeArgs, args -> ConvLdfld cenv env m fspec enclTypeArgs args - | TOp.ILAsm([ I_stfld(_, _, fspec) | I_stsfld (_, fspec) ], _), enclTypeArgs, args -> + | TOp.ILAsm ([ I_stfld (_, _, fspec) | I_stsfld (_, fspec) ], _), enclTypeArgs, args -> let tyargsR = ConvTypes cenv env m enclTypeArgs let parentTyconR = ConvILTypeRefUnadjusted cenv m fspec.DeclaringTypeRef let argsR = ConvLValueArgs cenv env args QP.mkFieldSet( (parentTyconR, fspec.Name), tyargsR, argsR) - | TOp.ILAsm([ AI_ceq ], _), _, [arg1;arg2] -> + | TOp.ILAsm ([ AI_ceq ], _), _, [arg1;arg2] -> let ty = tyOfExpr cenv.g arg1 let eq = mkCallEqualsOperator cenv.g m ty arg1 arg2 ConvExpr cenv env eq - | TOp.ILAsm([ I_throw ], _), _, [arg1] -> + | TOp.ILAsm ([ I_throw ], _), _, [arg1] -> let raiseExpr = mkCallRaise cenv.g m (tyOfExpr cenv.g expr) arg1 ConvExpr cenv env raiseExpr - | TOp.ILAsm(_il, _), _, _ -> + | TOp.ILAsm (_il, _), _, _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainInlineIL(), m)) | TOp.ExnConstr tcref, _, args -> @@ -520,7 +520,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let propRetTypeR = ConvType cenv envinner m fspec.FormalType QP.mkPropSet( (parentTyconR, fldOrPropName, propRetTypeR, []), tyargsR, argsR) - | TOp.ExnFieldGet(tcref, i), [], [obj] -> + | TOp.ExnFieldGet (tcref, i), [], [obj] -> let exnc = stripExnEqns tcref let fspec = exnc.TrueInstanceFieldsAsList.[i] let parentTyconR = ConvTyconRef cenv tcref m @@ -540,13 +540,13 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // rebuild reraise() and Convert mkReraiseLibCall cenv.g toTy m |> ConvExpr cenv env - | TOp.LValueOp(LAddrOf _, vref), [], [] -> + | TOp.LValueOp (LAddrOf _, vref), [], [] -> QP.mkAddressOf(ConvValRef false cenv env m vref []) - | TOp.LValueOp(LByrefSet, vref), [], [e] -> + | TOp.LValueOp (LByrefSet, vref), [], [e] -> QP.mkAddressSet(ConvValRef false cenv env m vref [], ConvExpr cenv env e) - | TOp.LValueOp(LSet, vref), [], [e] -> + | TOp.LValueOp (LSet, vref), [], [e] -> // Sets of module values become property sets match vref.DeclaringEntity with | Parent tcref when IsCompiledAsStaticProperty cenv.g vref.Deref -> @@ -557,27 +557,27 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | _ -> QP.mkVarSet( ConvValRef false cenv env m vref [], ConvExpr cenv env e) - | TOp.LValueOp(LByrefGet, vref), [], [] -> + | TOp.LValueOp (LByrefGet, vref), [], [] -> ConvValRef false cenv env m vref [] | TOp.Array, [ty], xa -> QP.mkNewArray(ConvType cenv env m ty, ConvExprs cenv env xa) - | TOp.While _, [], [Expr.Lambda(_, _, _, [_], test, _, _);Expr.Lambda(_, _, _, [_], body, _, _)] -> + | TOp.While _, [], [Expr.Lambda (_, _, _, [_], test, _, _);Expr.Lambda (_, _, _, [_], body, _, _)] -> QP.mkWhileLoop(ConvExpr cenv env test, ConvExpr cenv env body) - | TOp.For(_, FSharpForLoopUp), [], [Expr.Lambda(_, _, _, [_], lim0, _, _); Expr.Lambda(_, _, _, [_], SimpleArrayLoopUpperBound, lm, _); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> + | TOp.For (_, FSharpForLoopUp), [], [Expr.Lambda (_, _, _, [_], lim0, _, _); Expr.Lambda (_, _, _, [_], SimpleArrayLoopUpperBound, lm, _); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> let lim1 = let len = mkCallArrayLength cenv.g lm elemTy arr // Array.length arr - mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty len (Expr.Const(Const.Int32 1, m, cenv.g.int32_ty)) // len - 1 + mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty len (Expr.Const (Const.Int32 1, m, cenv.g.int32_ty)) // len - 1 QP.mkForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body) - | TOp.For(_, dir), [], [Expr.Lambda(_, _, _, [_], lim0, _, _);Expr.Lambda(_, _, _, [_], lim1, _, _);body] -> + | TOp.For (_, dir), [], [Expr.Lambda (_, _, _, [_], lim0, _, _);Expr.Lambda (_, _, _, [_], lim1, _, _);body] -> match dir with | FSharpForLoopUp -> QP.mkForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body) | _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainDescendingForLoops(), m)) - | TOp.ILCall(_, _, _, isNewObj, valUseFlags, isProp, _, ilMethRef, enclTypeArgs, methTypeArgs, _tys), [], callArgs -> + | TOp.ILCall (_, _, _, isNewObj, valUseFlags, isProp, _, ilMethRef, enclTypeArgs, methTypeArgs, _tys), [], callArgs -> let parentTyconR = ConvILTypeRefUnadjusted cenv m ilMethRef.DeclaringTypeRef let isNewObj = isNewObj || (match valUseFlags with CtorValUsedAsSuperInit | CtorValUsedAsSelfInit -> true | _ -> false) let methArgTypesR = List.map (ConvILType cenv env m) ilMethRef.ArgTypes @@ -588,10 +588,10 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let tyargs = (enclTypeArgs@methTypeArgs) ConvObjectModelCall cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, methArgTypesR, methRetTypeR, methName, tyargs, methTypeArgs.Length, callArgs) - | TOp.TryFinally _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> + | TOp.TryFinally _, [_resty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)] -> QP.mkTryFinally(ConvExpr cenv env e1, ConvExpr cenv env e2) - | TOp.TryCatch _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [vf], ef, _, _); Expr.Lambda(_, _, _, [vh], eh, _, _)] -> + | TOp.TryCatch _, [_resty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [vf], ef, _, _); Expr.Lambda (_, _, _, [vh], eh, _, _)] -> let vfR = ConvVal cenv env vf let envf = BindVal env vf let vhR = ConvVal cenv env vh @@ -599,15 +599,15 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkTryWith(ConvExpr cenv env e1, vfR, ConvExpr cenv envf ef, vhR, ConvExpr cenv envh eh) | TOp.Bytes bytes, [], [] -> - ConvExpr cenv env (Expr.Op(TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m)) + ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m)) | TOp.UInt16s arr, [], [] -> - ConvExpr cenv env (Expr.Op(TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m)) + ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m)) | TOp.UnionCaseProof _, _, [e] -> ConvExpr cenv env e // Note: we erase the union case proof conversions when converting to quotations | TOp.UnionCaseTagGet _tycr, _tinst, [_cx] -> wfail(Error(FSComp.SR.crefQuotationsCantFetchUnionIndexes(), m)) | TOp.UnionCaseFieldSet (_c, _i), _tinst, [_cx;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetUnionFields(), m)) - | TOp.ExnFieldSet(_tcref, _i), [], [_ex;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetExceptionFields(), m)) + | TOp.ExnFieldSet (_tcref, _i), [], [_ex;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetExceptionFields(), m)) | TOp.RefAddrGet _, _, _ -> wfail(Error(FSComp.SR.crefQuotationsCantRequireByref(), m)) | TOp.TraitCall (_ss), _, _ -> wfail(Error(FSComp.SR.crefQuotationsCantCallTraitMembers(), m)) | _ -> @@ -656,7 +656,7 @@ and ConvLetBind cenv env (bind : Binding) = // 'if istype e then ...unbox e .... ' // It's bit annoying that pattern matching does this transformation. Like all premature optimization we pay a // cost here to undo it. - | Expr.Op(TOp.ILAsm([ I_isinst _ ], _), [ty], [e], _) -> + | Expr.Op (TOp.ILAsm ([ I_isinst _ ], _), [ty], [e], _) -> None, BindIsInstVal env bind.Var (ty, e) // Remove let = from quotation tree @@ -664,7 +664,7 @@ and ConvLetBind cenv env (bind : Binding) = None, BindSubstVal env bind.Var bind.Expr // Remove let unionCase = ... from quotation tree - | Expr.Op(TOp.UnionCaseProof _, _, [e], _) -> + | Expr.Op (TOp.UnionCaseProof _, _, [e], _) -> None, BindSubstVal env bind.Var e | _ -> @@ -685,14 +685,14 @@ and ConvLValueExpr cenv env expr = // This function has to undo the work of mkExprAddrOfExpr and ConvLValueExprCore cenv env expr = match expr with - | Expr.Op(op, tyargs, args, m) -> + | Expr.Op (op, tyargs, args, m) -> match op, args, tyargs with - | TOp.LValueOp(LAddrOf _, vref), _, _ -> ConvValRef false cenv env m vref [] - | TOp.ValFieldGetAddr(rfref, _), _, _ -> ConvClassOrRecdFieldGet cenv env m rfref tyargs args - | TOp.UnionCaseFieldGetAddr(ucref, n, _), [e], _ -> ConvUnionFieldGet cenv env m ucref n tyargs e - | TOp.ILAsm([ I_ldflda(fspec) ], _rtys), _, _ -> ConvLdfld cenv env m fspec tyargs args - | TOp.ILAsm([ I_ldsflda(fspec) ], _rtys), _, _ -> ConvLdfld cenv env m fspec tyargs args - | TOp.ILAsm(([ I_ldelema(_ro, _isNativePtr, shape, _tyarg) ] ), _), (arr::idxs), [elemty] -> + | TOp.LValueOp (LAddrOf _, vref), _, _ -> ConvValRef false cenv env m vref [] + | TOp.ValFieldGetAddr (rfref, _), _, _ -> ConvClassOrRecdFieldGet cenv env m rfref tyargs args + | TOp.UnionCaseFieldGetAddr (ucref, n, _), [e], _ -> ConvUnionFieldGet cenv env m ucref n tyargs e + | TOp.ILAsm ([ I_ldflda(fspec) ], _rtys), _, _ -> ConvLdfld cenv env m fspec tyargs args + | TOp.ILAsm ([ I_ldsflda(fspec) ], _rtys), _, _ -> ConvLdfld cenv env m fspec tyargs args + | TOp.ILAsm (([ I_ldelema(_ro, _isNativePtr, shape, _tyarg) ] ), _), (arr::idxs), [elemty] -> match shape.Rank, idxs with | 1, [idx1] -> ConvExpr cenv env (mkCallArrayGet cenv.g m elemty arr idx1) | 2, [idx1; idx2] -> ConvExpr cenv env (mkCallArray2DGet cenv.g m elemty arr idx1 idx2) @@ -903,7 +903,7 @@ and ConvDecisionTree cenv env tgs typR x = | DecisionTreeTest.IsNull -> // Decompile cached isinst tests match e1 with - | Expr.Val(vref, _, _) when env.isinstVals.ContainsVal vref.Deref -> + | Expr.Val (vref, _, _) when env.isinstVals.ContainsVal vref.Deref -> let (ty, e) = env.isinstVals.[vref.Deref] let tyR = ConvType cenv env m ty let eR = ConvExpr cenv env e diff --git a/src/fsharp/SimulatedMSBuildReferenceResolver.fs b/src/fsharp/SimulatedMSBuildReferenceResolver.fs index cf0aeecf8..ef0fdf13c 100644 --- a/src/fsharp/SimulatedMSBuildReferenceResolver.fs +++ b/src/fsharp/SimulatedMSBuildReferenceResolver.fs @@ -26,9 +26,9 @@ let internal SimulatedMSBuildResolver = "v4.5" "v4.0" |] - { new Resolver with + { new Resolver with member x.HighestInstalledNetFrameworkVersion() = - + let root = x.DotNetFrameworkReferenceAssembliesRootDirectory let fwOpt = supportedFrameworks |> Seq.tryFind(fun fw -> Directory.Exists(Path.Combine(root, fw) )) match fwOpt with @@ -37,11 +37,11 @@ let internal SimulatedMSBuildResolver = member __.DotNetFrameworkReferenceAssembliesRootDirectory = #if !FX_RESHAPED_MSBUILD - if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then - let PF = + if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then + let PF = match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with | null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF - | s -> s + | s -> s PF + @"\Reference Assemblies\Microsoft\Framework\.NETFramework" else #endif @@ -51,153 +51,153 @@ let internal SimulatedMSBuildResolver = fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, logMessage, logWarningOrError) = #if !FX_NO_WIN_REGISTRY - let registrySearchPaths() = + let registrySearchPaths() = [ let registryKey = @"Software\Microsoft\.NetFramework" - use key = Registry.LocalMachine.OpenSubKey(registryKey) - match key with + use key = Registry.LocalMachine.OpenSubKey registryKey + match key with | null -> () - | _ -> + | _ -> for subKeyName in key.GetSubKeyNames() do - use subKey = key.OpenSubKey(subKeyName) + use subKey = key.OpenSubKey subKeyName use subSubKey = subKey.OpenSubKey("AssemblyFoldersEx") - match subSubKey with + match subSubKey with | null -> () - | _ -> + | _ -> for subSubSubKeyName in subSubKey.GetSubKeyNames() do - use subSubSubKey = subSubKey.OpenSubKey(subSubSubKeyName) - match subSubSubKey.GetValue(null) with + use subSubSubKey = subSubKey.OpenSubKey subSubSubKeyName + match subSubSubKey.GetValue null with | :? string as s -> yield s - | _ -> () + | _ -> () use subSubKey = key.OpenSubKey("AssemblyFolders") - match subSubKey with + match subSubKey with | null -> () - | _ -> + | _ -> for subSubSubKeyName in subSubKey.GetSubKeyNames() do - let subSubSubKey = subSubKey.OpenSubKey(subSubSubKeyName) - match subSubSubKey.GetValue(null) with + let subSubSubKey = subSubKey.OpenSubKey subSubSubKeyName + match subSubSubKey.GetValue null with | :? string as s -> yield s | _ -> () ] #endif let results = ResizeArray() - let searchPaths = - [ yield! targetFrameworkDirectories - yield! explicitIncludeDirs + let searchPaths = + [ yield! targetFrameworkDirectories + yield! explicitIncludeDirs yield fsharpCoreDir - yield implicitIncludeDir + yield implicitIncludeDir #if !FX_NO_WIN_REGISTRY - if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then - yield! registrySearchPaths() + if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then + yield! registrySearchPaths() #endif ] for (r, baggage) in references do //printfn "resolving %s" r let mutable found = false - let success path = - if not found then + let success path = + if not found then //printfn "resolved %s --> %s" r path found <- true - results.Add { itemSpec = path; prepareToolTip = snd; baggage=baggage } + results.Add { itemSpec = path; prepareToolTip = snd; baggage=baggage } - try - if not found && Path.IsPathRooted(r) then - if FileSystem.SafeExists(r) then + try + if not found && Path.IsPathRooted r then + if FileSystem.SafeExists r then success r with e -> logWarningOrError false "SR001" (e.ToString()) #if !FX_RESHAPED_MSBUILD // For this one we need to get the version search exactly right, without doing a load - try - if not found && r.StartsWithOrdinal("FSharp.Core, Version=") && Environment.OSVersion.Platform = PlatformID.Win32NT then - let n = AssemblyName(r) - let fscoreDir0 = - let PF = + try + if not found && r.StartsWithOrdinal("FSharp.Core, Version=") && Environment.OSVersion.Platform = PlatformID.Win32NT then + let n = AssemblyName r + let fscoreDir0 = + let PF = match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with - | null -> Environment.GetEnvironmentVariable("ProgramFiles") - | s -> s + | null -> Environment.GetEnvironmentVariable("ProgramFiles") + | s -> s PF + @"\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\" + n.Version.ToString() - let trialPath = Path.Combine(fscoreDir0,n.Name + ".dll") - if FileSystem.SafeExists(trialPath) then + let trialPath = Path.Combine(fscoreDir0, n.Name + ".dll") + if FileSystem.SafeExists trialPath then success trialPath with e -> logWarningOrError false "SR001" (e.ToString()) #endif - let isFileName = - r.EndsWith("dll",StringComparison.OrdinalIgnoreCase) || - r.EndsWith("exe",StringComparison.OrdinalIgnoreCase) + let isFileName = + r.EndsWith("dll", StringComparison.OrdinalIgnoreCase) || + r.EndsWith("exe", StringComparison.OrdinalIgnoreCase) let qual = if isFileName then r else try AssemblyName(r).Name + ".dll" with _ -> r + ".dll" - for searchPath in searchPaths do - try - if not found then - let trialPath = Path.Combine(searchPath,qual) - if FileSystem.SafeExists(trialPath) then + for searchPath in searchPaths do + try + if not found then + let trialPath = Path.Combine(searchPath, qual) + if FileSystem.SafeExists trialPath then success trialPath with e -> logWarningOrError false "SR001" (e.ToString()) #if !FX_RESHAPED_MSBUILD - try + try // Seach the GAC on Windows - if not found && not isFileName && Environment.OSVersion.Platform = PlatformID.Win32NT then - let n = AssemblyName(r) + if not found && not isFileName && Environment.OSVersion.Platform = PlatformID.Win32NT then + let n = AssemblyName r let netfx = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() - let gac = Path.Combine(Path.GetDirectoryName(Path.GetDirectoryName(netfx.TrimEnd('\\'))),"assembly") - match n.Version, n.GetPublicKeyToken() with - | null, _ | _,null -> - let options = - [ if Directory.Exists(gac) then - for gacdir in Directory.EnumerateDirectories(gac) do - let assemblyDir = Path.Combine(gacdir,n.Name) - if Directory.Exists(assemblyDir) then - for tdir in Directory.EnumerateDirectories(assemblyDir) do - let trialPath = Path.Combine(tdir,qual) - if FileSystem.SafeExists(trialPath) then + let gac = Path.Combine(Path.GetDirectoryName(Path.GetDirectoryName(netfx.TrimEnd('\\'))), "assembly") + match n.Version, n.GetPublicKeyToken() with + | null, _ | _, null -> + let options = + [ if Directory.Exists gac then + for gacdir in Directory.EnumerateDirectories gac do + let assemblyDir = Path.Combine(gacdir, n.Name) + if Directory.Exists assemblyDir then + for tdir in Directory.EnumerateDirectories assemblyDir do + let trialPath = Path.Combine(tdir, qual) + if FileSystem.SafeExists trialPath then yield trialPath ] //printfn "sorting GAC paths: %A" options - options + options |> List.sort // puts latest version last |> List.tryLast |> function None -> () | Some p -> success p - | v,tok -> - if Directory.Exists(gac) then - for gacdir in Directory.EnumerateDirectories(gac) do + | v, tok -> + if Directory.Exists gac then + for gacdir in Directory.EnumerateDirectories gac do //printfn "searching GAC directory: %s" gacdir - let assemblyDir = Path.Combine(gacdir,n.Name) - if Directory.Exists(assemblyDir) then + let assemblyDir = Path.Combine(gacdir, n.Name) + if Directory.Exists assemblyDir then //printfn "searching GAC directory: %s" assemblyDir let tokText = String.concat "" [| for b in tok -> sprintf "%02x" b |] - let verdir = Path.Combine(assemblyDir,"v4.0_"+v.ToString()+"__"+tokText) + let verdir = Path.Combine(assemblyDir, "v4.0_"+v.ToString()+"__"+tokText) //printfn "searching GAC directory: %s" verdir - if Directory.Exists(verdir) then - let trialPath = Path.Combine(verdir,qual) + if Directory.Exists verdir then + let trialPath = Path.Combine(verdir, qual) //printfn "searching GAC: %s" trialPath - if FileSystem.SafeExists(trialPath) then + if FileSystem.SafeExists trialPath then success trialPath with e -> logWarningOrError false "SR001" (e.ToString()) #endif results.ToArray() } -let internal GetBestAvailableResolver() = +let internal GetBestAvailableResolver() = #if !FX_RESHAPED_MSBUILD - let tryMSBuild v = + let tryMSBuild v = // Detect if MSBuild is on the machine, if so use the resolver from there let mb = try Assembly.Load(sprintf "Microsoft.Build.Framework, Version=%s.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" v) |> Option.ofObj with _ -> None let assembly = mb |> Option.bind (fun _ -> try Assembly.Load(sprintf "FSharp.Compiler.Service.MSBuild.v%s" v) |> Option.ofObj with _ -> None) let ty = assembly |> Option.bind (fun a -> a.GetType("FSharp.Compiler.MSBuildReferenceResolver") |> Option.ofObj) - let obj = ty |> Option.bind (fun ty -> ty.InvokeMember("get_Resolver",BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.InvokeMethod ||| BindingFlags.NonPublic, null, null, [| |]) |> Option.ofObj) + let obj = ty |> Option.bind (fun ty -> ty.InvokeMember("get_Resolver", BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.InvokeMethod ||| BindingFlags.NonPublic, null, null, [| |]) |> Option.ofObj) let resolver = obj |> Option.bind (fun obj -> match obj with :? Resolver as r -> Some r | _ -> None) resolver - match tryMSBuild "12" with + match tryMSBuild "12" with | Some r -> r - | None -> + | None -> #endif - SimulatedMSBuildResolver + SimulatedMSBuildResolver #if INTERACTIVE @@ -205,21 +205,21 @@ let internal GetBestAvailableResolver() = SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory SimulatedMSBuildResolver.HighestInstalledNetFrameworkVersion() -let fscoreDir = - if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then // file references only valid on Windows - let PF = +let fscoreDir = + if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then // file references only valid on Windows + let PF = match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with | null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF - | s -> s - PF + @"\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.4.0.0" - else + | s -> s + PF + @"\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.4.0.0" + else System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() -let resolve s = +let resolve s = SimulatedMSBuildResolver.Resolve - (ResolutionEnvironment.EditingOrCompilation,[| for a in s -> (a, "") |],"v4.5.1", - [SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory + @"\v4.5.1" ],"", "", - fscoreDir,[],__SOURCE_DIRECTORY__,ignore, (fun _ _ -> ()), (fun _ _-> ())) + (ResolutionEnvironment.EditingOrCompilation, [| for a in s -> (a, "") |], "v4.5.1", + [SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory + @"\v4.5.1" ], "", "", + fscoreDir, [], __SOURCE_DIRECTORY__, ignore, (fun _ _ -> ()), (fun _ _-> ())) // Resolve partial name to something on search path resolve ["FSharp.Core" ] diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index df39365b1..1346330b2 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -253,7 +253,7 @@ and remapTyparConstraintsAux tyenv cs = | TyparConstraint.IsUnmanaged _ | TyparConstraint.IsNonNullableStruct _ | TyparConstraint.IsReferenceType _ - | TyparConstraint.RequiresDefaultConstructor _ -> Some(x)) + | TyparConstraint.RequiresDefaultConstructor _ -> Some x) and remapTraitAux tyenv (TTrait(tys, nm, mf, argtys, rty, slnCell)) = let slnCell = @@ -610,7 +610,7 @@ let mkByrefTyWithInference (g: TcGlobals) ty1 ty2 = let mkArrayTy (g: TcGlobals) rank ty m = if rank < 1 || rank > 32 then - errorR(Error(FSComp.SR.tastopsMaxArrayThirtyTwo(rank), m)) + errorR(Error(FSComp.SR.tastopsMaxArrayThirtyTwo rank, m)) TType_app (g.il_arr_tcr_map.[3], [ty]) else TType_app (g.il_arr_tcr_map.[rank - 1], [ty]) @@ -1109,7 +1109,7 @@ let ensureCcuHasModuleOrNamespaceAtPath (ccu: CcuThunk) path (CompPath(_, cpath) let modName = hpath.idText if not (Map.containsKey modName mtype.AllEntitiesByCompiledAndLogicalMangledNames) then let smodul = NewModuleOrNamespace (Some(CompPath(scoref, prior_cpath))) taccessPublic hpath xml [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType mkind)) - mtype.AddModuleOrNamespaceByMutation(smodul) + mtype.AddModuleOrNamespaceByMutation smodul let modul = Map.find modName mtype.AllEntitiesByCompiledAndLogicalMangledNames loop (prior_cpath@[(modName, Namespace)]) tpath tcpath modul @@ -1140,10 +1140,10 @@ let tryDestRefTupleExpr e = match e with Expr.Op (TOp.Tuple tupInfo, _, es, _) w let rec rangeOfExpr x = match x with | Expr.Val (_, _, m) | Expr.Op (_, _, _, m) | Expr.Const (_, m, _) | Expr.Quote (_, _, _, m, _) - | Expr.Obj (_, _, _, _, _, _, m) | Expr.App(_, _, _, _, m) | Expr.Sequential (_, _, _, _, m) + | Expr.Obj (_, _, _, _, _, _, m) | Expr.App (_, _, _, _, m) | Expr.Sequential (_, _, _, _, m) | Expr.StaticOptimization (_, _, _, m) | Expr.Lambda (_, _, _, _, _, m, _) | Expr.TyLambda (_, _, _, m, _)| Expr.TyChoose (_, _, m) | Expr.LetRec (_, _, m, _) | Expr.Let (_, _, m, _) | Expr.Match (_, _, _, _, m, _) -> m - | Expr.Link(eref) -> rangeOfExpr (!eref) + | Expr.Link eref -> rangeOfExpr (!eref) type Expr with member x.Range = rangeOfExpr x @@ -1158,7 +1158,7 @@ let primMkMatch(spBind, exprm, tree, targets, matchm, ty) = Expr.Match (spBind, type MatchBuilder(spBind, inpRange: Range.range) = let targets = new ResizeArray<_>(10) - member x.AddTarget(tg) = + member x.AddTarget tg = let n = targets.Count targets.Add tg n @@ -1169,7 +1169,7 @@ type MatchBuilder(spBind, inpRange: Range.range) = member x.Close(dtree, m, ty) = primMkMatch (spBind, inpRange, dtree, targets.ToArray(), m, ty) -let mkBoolSwitch m g t e = TDSwitch(g, [TCase(DecisionTreeTest.Const(Const.Bool(true)), t)], Some e, m) +let mkBoolSwitch m g t e = TDSwitch(g, [TCase(DecisionTreeTest.Const(Const.Bool true), t)], Some e, m) let primMkCond spBind spTarget1 spTarget2 m ty e1 e2 e3 = let mbuilder = new MatchBuilder(spBind, m) @@ -1183,7 +1183,7 @@ let mkCond spBind spTarget m ty e1 e2 e3 = primMkCond spBind spTarget spTarget m // Primitive constructors //--------------------------------------------------------------------------- -let exprForValRef m vref = Expr.Val(vref, NormalValUse, m) +let exprForValRef m vref = Expr.Val (vref, NormalValUse, m) let exprForVal m v = exprForValRef m (mkLocalValRef v) let mkLocalAux m s ty mut compgen = let thisv = NewVal(s, m, None, ty, mut, compgen, None, taccessPublic, ValNotInRecScope, None, NormalVal, [], ValInline.Optional, XmlDoc.Empty, false, false, false, false, false, false, None, ParentNone) @@ -1230,7 +1230,7 @@ let mkMultiLambdaBind v letSeqPtOpt m tps vsl (b, rty) = let mkBind seqPtOpt v e = TBind(v, e, seqPtOpt) -let mkLetBind m bind body = Expr.Let(bind, body, m, NewFreeVarsCache()) +let mkLetBind m bind body = Expr.Let (bind, body, m, NewFreeVarsCache()) let mkLetsBind m binds body = List.foldBack (mkLetBind m) binds body let mkLetsFromBindings m binds body = List.foldBack (mkLetBind m) binds body let mkLet seqPtOpt m v x body = mkLetBind m (mkBind seqPtOpt v x) body @@ -1248,7 +1248,7 @@ let mkInvisibleLet m v x body = mkLetBind m (mkInvisibleBind v x) body let mkInvisibleLets m vs xs body = mkLetsBind m (mkInvisibleBinds vs xs) body let mkInvisibleLetsFromBindings m vs xs body = mkLetsFromBindings m (mkInvisibleBinds vs xs) body -let mkLetRecBinds m binds body = if isNil binds then body else Expr.LetRec(binds, body, m, NewFreeVarsCache()) +let mkLetRecBinds m binds body = if isNil binds then body else Expr.LetRec (binds, body, m, NewFreeVarsCache()) //------------------------------------------------------------------------- // Type schemes... @@ -1297,53 +1297,53 @@ let isBeingGeneralized tp typeScheme = // Build conditional expressions... //------------------------------------------------------------------------- -let mkLazyAnd (g: TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 e2 (Expr.Const(Const.Bool false, m, g.bool_ty)) -let mkLazyOr (g: TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 (Expr.Const(Const.Bool true, m, g.bool_ty)) e2 +let mkLazyAnd (g: TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 e2 (Expr.Const (Const.Bool false, m, g.bool_ty)) +let mkLazyOr (g: TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 (Expr.Const (Const.Bool true, m, g.bool_ty)) e2 let mkCoerceExpr(e, to_ty, m, from_ty) = Expr.Op (TOp.Coerce, [to_ty;from_ty], [e], m) -let mkAsmExpr(code, tinst, args, rettys, m) = Expr.Op (TOp.ILAsm(code, rettys), tinst, args, m) +let mkAsmExpr (code, tinst, args, rettys, m) = Expr.Op (TOp.ILAsm (code, rettys), tinst, args, m) let mkUnionCaseExpr(uc, tinst, args, m) = Expr.Op (TOp.UnionCase uc, tinst, args, m) let mkExnExpr(uc, args, m) = Expr.Op (TOp.ExnConstr uc, [], args, m) -let mkTupleFieldGetViaExprAddr(tupInfo, e, tinst, i, m) = Expr.Op (TOp.TupleFieldGet(tupInfo, i), tinst, [e], m) -let mkAnonRecdFieldGetViaExprAddr(anonInfo, e, tinst, i, m) = Expr.Op (TOp.AnonRecdGet(anonInfo, i), tinst, [e], m) +let mkTupleFieldGetViaExprAddr(tupInfo, e, tinst, i, m) = Expr.Op (TOp.TupleFieldGet (tupInfo, i), tinst, [e], m) +let mkAnonRecdFieldGetViaExprAddr(anonInfo, e, tinst, i, m) = Expr.Op (TOp.AnonRecdGet (anonInfo, i), tinst, [e], m) -let mkRecdFieldGetViaExprAddr(e, fref, tinst, m) = Expr.Op (TOp.ValFieldGet(fref), tinst, [e], m) -let mkRecdFieldGetAddrViaExprAddr(readonly, e, fref, tinst, m) = Expr.Op (TOp.ValFieldGetAddr(fref, readonly), tinst, [e], m) +let mkRecdFieldGetViaExprAddr (e, fref, tinst, m) = Expr.Op (TOp.ValFieldGet fref, tinst, [e], m) +let mkRecdFieldGetAddrViaExprAddr(readonly, e, fref, tinst, m) = Expr.Op (TOp.ValFieldGetAddr (fref, readonly), tinst, [e], m) -let mkStaticRecdFieldGetAddr(readonly, fref, tinst, m) = Expr.Op (TOp.ValFieldGetAddr(fref, readonly), tinst, [], m) -let mkStaticRecdFieldGet(fref, tinst, m) = Expr.Op (TOp.ValFieldGet(fref), tinst, [], m) -let mkStaticRecdFieldSet(fref, tinst, e, m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e], m) +let mkStaticRecdFieldGetAddr(readonly, fref, tinst, m) = Expr.Op (TOp.ValFieldGetAddr (fref, readonly), tinst, [], m) +let mkStaticRecdFieldGet (fref, tinst, m) = Expr.Op (TOp.ValFieldGet fref, tinst, [], m) +let mkStaticRecdFieldSet(fref, tinst, e, m) = Expr.Op (TOp.ValFieldSet fref, tinst, [e], m) let mkArrayElemAddress g (readonly, ilInstrReadOnlyAnnotation, isNativePtr, shape, elemTy, exprs, m) = Expr.Op (TOp.ILAsm ([IL.I_ldelema(ilInstrReadOnlyAnnotation, isNativePtr, shape, mkILTyvarTy 0us)], [mkByrefTyWithFlag g readonly elemTy]), [elemTy], exprs, m) -let mkRecdFieldSetViaExprAddr (e1, fref, tinst, e2, m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e1;e2], m) +let mkRecdFieldSetViaExprAddr (e1, fref, tinst, e2, m) = Expr.Op (TOp.ValFieldSet fref, tinst, [e1;e2], m) -let mkUnionCaseTagGetViaExprAddr (e1, cref, tinst, m) = Expr.Op (TOp.UnionCaseTagGet(cref), tinst, [e1], m) +let mkUnionCaseTagGetViaExprAddr (e1, cref, tinst, m) = Expr.Op (TOp.UnionCaseTagGet cref, tinst, [e1], m) /// Make a 'TOp.UnionCaseProof' expression, which proves a union value is over a particular case (used only for ref-unions, not struct-unions) -let mkUnionCaseProof (e1, cref: UnionCaseRef, tinst, m) = if cref.Tycon.IsStructOrEnumTycon then e1 else Expr.Op (TOp.UnionCaseProof(cref), tinst, [e1], m) +let mkUnionCaseProof (e1, cref: UnionCaseRef, tinst, m) = if cref.Tycon.IsStructOrEnumTycon then e1 else Expr.Op (TOp.UnionCaseProof cref, tinst, [e1], m) /// Build a 'TOp.UnionCaseFieldGet' expression for something we've already determined to be a particular union case. For ref-unions, /// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, /// the input should be the address of the expression. -let mkUnionCaseFieldGetProvenViaExprAddr (e1, cref, tinst, j, m) = Expr.Op (TOp.UnionCaseFieldGet(cref, j), tinst, [e1], m) +let mkUnionCaseFieldGetProvenViaExprAddr (e1, cref, tinst, j, m) = Expr.Op (TOp.UnionCaseFieldGet (cref, j), tinst, [e1], m) /// Build a 'TOp.UnionCaseFieldGetAddr' expression for a field of a union when we've already determined the value to be a particular union case. For ref-unions, /// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, /// the input should be the address of the expression. -let mkUnionCaseFieldGetAddrProvenViaExprAddr (readonly, e1, cref, tinst, j, m) = Expr.Op (TOp.UnionCaseFieldGetAddr(cref, j, readonly), tinst, [e1], m) +let mkUnionCaseFieldGetAddrProvenViaExprAddr (readonly, e1, cref, tinst, j, m) = Expr.Op (TOp.UnionCaseFieldGetAddr (cref, j, readonly), tinst, [e1], m) /// Build a 'get' expression for something we've already determined to be a particular union case, but where /// the static type of the input is not yet proven to be that particular union case. This requires a type /// cast to 'prove' the condition. -let mkUnionCaseFieldGetUnprovenViaExprAddr (e1, cref, tinst, j, m) = mkUnionCaseFieldGetProvenViaExprAddr(mkUnionCaseProof(e1, cref, tinst, m), cref, tinst, j, m) +let mkUnionCaseFieldGetUnprovenViaExprAddr (e1, cref, tinst, j, m) = mkUnionCaseFieldGetProvenViaExprAddr (mkUnionCaseProof(e1, cref, tinst, m), cref, tinst, j, m) -let mkUnionCaseFieldSet (e1, cref, tinst, j, e2, m) = Expr.Op (TOp.UnionCaseFieldSet(cref, j), tinst, [e1;e2], m) +let mkUnionCaseFieldSet (e1, cref, tinst, j, e2, m) = Expr.Op (TOp.UnionCaseFieldSet (cref, j), tinst, [e1;e2], m) -let mkExnCaseFieldGet (e1, ecref, j, m) = Expr.Op (TOp.ExnFieldGet(ecref, j), [], [e1], m) -let mkExnCaseFieldSet (e1, ecref, j, e2, m) = Expr.Op (TOp.ExnFieldSet(ecref, j), [], [e1;e2], m) +let mkExnCaseFieldGet (e1, ecref, j, m) = Expr.Op (TOp.ExnFieldGet (ecref, j), [], [e1], m) +let mkExnCaseFieldSet (e1, ecref, j, e2, m) = Expr.Op (TOp.ExnFieldSet (ecref, j), [], [e1;e2], m) let mkDummyLambda (g: TcGlobals) (e: Expr, ety) = let m = e.Range @@ -1356,12 +1356,12 @@ let mkFor (g: TcGlobals) (spFor, v, e1, dir, e2, e3: Expr, m) = Expr.Op (TOp.For (spFor, dir), [], [mkDummyLambda g (e1, g.int_ty) ;mkDummyLambda g (e2, g.int_ty);mkLambda e3.Range v (e3, g.unit_ty)], m) let mkTryWith g (e1, vf, ef: Expr, vh, eh: Expr, m, ty, spTry, spWith) = - Expr.Op (TOp.TryCatch(spTry, spWith), [ty], [mkDummyLambda g (e1, ty);mkLambda ef.Range vf (ef, ty);mkLambda eh.Range vh (eh, ty)], m) + Expr.Op (TOp.TryCatch (spTry, spWith), [ty], [mkDummyLambda g (e1, ty);mkLambda ef.Range vf (ef, ty);mkLambda eh.Range vh (eh, ty)], m) let mkTryFinally (g: TcGlobals) (e1, e2, m, ty, spTry, spFinally) = - Expr.Op (TOp.TryFinally(spTry, spFinally), [ty], [mkDummyLambda g (e1, ty);mkDummyLambda g (e2, g.unit_ty)], m) + Expr.Op (TOp.TryFinally (spTry, spFinally), [ty], [mkDummyLambda g (e1, ty);mkDummyLambda g (e2, g.unit_ty)], m) -let mkDefault (m, ty) = Expr.Const(Const.Zero, m, ty) +let mkDefault (m, ty) = Expr.Const (Const.Zero, m, ty) let mkValSet m v e = Expr.Op (TOp.LValueOp (LSet, v), [], [e], m) let mkAddrSet m v e = Expr.Op (TOp.LValueOp (LByrefSet, v), [], [e], m) @@ -1481,7 +1481,7 @@ let actualTyOfRecdFieldRef (fref: RecdFieldRef) tinst = actualTyOfRecdFieldForTycon fref.Tycon tinst fref.RecdField let actualTyOfUnionFieldRef (fref: UnionCaseRef) n tinst = - actualTyOfRecdFieldForTycon fref.Tycon tinst (fref.FieldByIndex(n)) + actualTyOfRecdFieldForTycon fref.Tycon tinst (fref.FieldByIndex n) //--------------------------------------------------------------------------- @@ -2662,7 +2662,7 @@ type DisplayEnv = contextAccessibility: Accessibility generatedValueLayout : (Val -> layout option) } - member x.SetOpenPaths(paths) = + member x.SetOpenPaths paths = { x with openTopPathsSorted = (lazy (paths |> List.sortWith (fun p1 p2 -> -(compare p1 p2)))) openTopPathsRaw = paths @@ -2718,8 +2718,8 @@ let fullNameOfParentOfPubPathAsLayout pp = | PubPath([| _ |]) -> ValueNone | pp -> ValueSome(layoutOfPath (Array.toList pp.EnclosingPath)) -let fullNameOfPubPath (PubPath(p)) = textOfPath p -let fullNameOfPubPathAsLayout (PubPath(p)) = layoutOfPath (Array.toList p) +let fullNameOfPubPath (PubPath p) = textOfPath p +let fullNameOfPubPathAsLayout (PubPath p) = layoutOfPath (Array.toList p) let fullNameOfParentOfNonLocalEntityRef (nlr: NonLocalEntityRef) = if nlr.Path.Length < 2 then ValueNone @@ -2902,15 +2902,15 @@ let IsMatchingFSharpAttributeOpt g attrOpt (Attrib(tcref2, _, _, _, _, _, _)) = let (|ExtractAttribNamedArg|_|) nm args = args |> List.tryPick (function (AttribNamedArg(nm2, _, _, v)) when nm = nm2 -> Some v | _ -> None) -let (|AttribInt32Arg|_|) = function AttribExpr(_, Expr.Const (Const.Int32(n), _, _)) -> Some(n) | _ -> None -let (|AttribInt16Arg|_|) = function AttribExpr(_, Expr.Const (Const.Int16(n), _, _)) -> Some(n) | _ -> None -let (|AttribBoolArg|_|) = function AttribExpr(_, Expr.Const (Const.Bool(n), _, _)) -> Some(n) | _ -> None -let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String(n), _, _)) -> Some(n) | _ -> None +let (|AttribInt32Arg|_|) = function AttribExpr(_, Expr.Const (Const.Int32 n, _, _)) -> Some n | _ -> None +let (|AttribInt16Arg|_|) = function AttribExpr(_, Expr.Const (Const.Int16 n, _, _)) -> Some n | _ -> None +let (|AttribBoolArg|_|) = function AttribExpr(_, Expr.Const (Const.Bool n, _, _)) -> Some n | _ -> None +let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String n, _, _)) -> Some n | _ -> None let TryFindFSharpBoolAttributeWithDefault dflt g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ ], _, _, _, _)) -> Some(dflt) - | Some(Attrib(_, _, [ AttribBoolArg(b) ], _, _, _, _)) -> Some(b) + | Some(Attrib(_, _, [ ], _, _, _, _)) -> Some dflt + | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> Some b | _ -> None let TryFindFSharpBoolAttribute g nm attrs = TryFindFSharpBoolAttributeWithDefault true g nm attrs @@ -2918,12 +2918,12 @@ let TryFindFSharpBoolAttributeAssumeFalse g nm attrs = TryFindFSharpBoolAttribut let TryFindFSharpInt32Attribute g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ AttribInt32Arg(b) ], _, _, _, _)) -> Some b + | Some(Attrib(_, _, [ AttribInt32Arg b ], _, _, _, _)) -> Some b | _ -> None let TryFindFSharpStringAttribute g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ AttribStringArg(b) ], _, _, _, _)) -> Some b + | Some(Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> Some b | _ -> None let TryFindILAttribute (AttribInfo (atref, _)) attrs = @@ -2944,7 +2944,7 @@ let TryBindTyconRefAttribute g (m: range) (AttribInfo (atref, _) as args) (tcref #if !NO_EXTENSIONTYPING | ProvidedTypeMetadata info -> let provAttribs = info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)), m) - match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), atref.FullName)), m) with + match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure id, atref.FullName)), m) with | Some args -> f3 args | None -> None #endif @@ -2961,7 +2961,7 @@ let TryFindTyconRefBoolAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref (function | ([ ], _) -> Some true - | ([ILAttribElem.Bool (v) ], _) -> Some v + | ([ILAttribElem.Bool v ], _) -> Some v | _ -> None) (function | (Attrib(_, _, [ ], _, _, _, _)) -> Some true @@ -2975,7 +2975,7 @@ let TryFindTyconRefBoolAttribute g m attribSpec tcref = let TryFindAttributeUsageAttribute g m tcref = TryBindTyconRefAttribute g m g.attrib_AttributeUsageAttribute tcref (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", _, _, ILAttribElem.Bool res) -> Some res | _ -> None)) - (fun (Attrib(_, _, _, named, _, _, _)) -> named |> List.tryPick (function AttribNamedArg("AllowMultiple", _, _, AttribBoolArg(res) ) -> Some res | _ -> None)) + (fun (Attrib(_, _, _, named, _, _, _)) -> named |> List.tryPick (function AttribNamedArg("AllowMultiple", _, _, AttribBoolArg res ) -> Some res | _ -> None)) (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", Some ((:? bool as res) : obj)) -> Some res | _ -> None)) @@ -2984,8 +2984,8 @@ let TryFindAttributeUsageAttribute g m tcref = /// This is used to detect the 'DefaultMemberAttribute' and 'ConditionalAttribute' attributes (on type definitions) let TryFindTyconRefStringAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref - (function ([ILAttribElem.String (Some(msg)) ], _) -> Some msg | _ -> None) - (function (Attrib(_, _, [ AttribStringArg(msg) ], _, _, _, _)) -> Some msg | _ -> None) + (function ([ILAttribElem.String (Some msg) ], _) -> Some msg | _ -> None) + (function (Attrib(_, _, [ AttribStringArg msg ], _, _, _, _)) -> Some msg | _ -> None) (function ([ Some ((:? string as msg) : obj) ], _) -> Some msg | _ -> None) /// Check if a type definition has a specific attribute @@ -3113,12 +3113,12 @@ type ValRef with let (|UnopExpr|_|) _g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, _, [arg1], _) -> Some (vref, arg1) + | Expr.App (Expr.Val (vref, _, _), _, _, [arg1], _) -> Some (vref, arg1) | _ -> None let (|BinopExpr|_|) _g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, _, [arg1;arg2], _) -> Some (vref, arg1, arg2) + | Expr.App (Expr.Val (vref, _, _), _, _, [arg1;arg2], _) -> Some (vref, arg1, arg2) | _ -> None let (|SpecificUnopExpr|_|) g vrefReqd expr = @@ -3145,7 +3145,7 @@ let (|AttribBitwiseOrExpr|_|) g expr = // is defined. These get through type checking because enums implicitly support the '|||' operator through // the automatic resolution of undefined operators (see tc.fs, Item.ImplicitOp). This then compiles as an // application of a lambda to two arguments. We recognize this pattern here - | Expr.App(Expr.Lambda _, _, _, [arg1;arg2], _) when g.compilingFslib -> + | Expr.App (Expr.Lambda _, _, _, [arg1;arg2], _) when g.compilingFslib -> Some(arg1, arg2) | _ -> None @@ -3171,22 +3171,22 @@ let isTypeDefOfValRef g vref = let (|UncheckedDefaultOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isUncheckedDefaultOfValRef g vref -> Some ty + | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isUncheckedDefaultOfValRef g vref -> Some ty | _ -> None let (|TypeOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isTypeOfValRef g vref -> Some ty + | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isTypeOfValRef g vref -> Some ty | _ -> None let (|SizeOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isSizeOfValRef g vref -> Some ty + | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isSizeOfValRef g vref -> Some ty | _ -> None let (|TypeDefOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> Some ty + | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> Some ty | _ -> None //-------------------------------------------------------------------------- @@ -3319,7 +3319,7 @@ module DebugPrint = let varL = tpL |> stampL typar.Stamp match Zmap.tryFind typar env.inplaceConstraints with - | Some (typarConstraintTy) -> + | Some typarConstraintTy -> if Zset.contains typar env.singletons then leftL (tagText "#") ^^ auxTyparConstraintTypL env typarConstraintTy else @@ -3506,12 +3506,12 @@ module DebugPrint = | Const.UIntPtr x -> (x |> string)+"un" | Const.Single d -> (let s = d.ToString("g12", System.Globalization.CultureInfo.InvariantCulture) - if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s + if String.forall (fun c -> System.Char.IsDigit c || c = '-') s then s + ".0" else s) + "f" | Const.Double d -> let s = d.ToString("g12", System.Globalization.CultureInfo.InvariantCulture) - if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s + if String.forall (fun c -> System.Char.IsDigit c || c = '-') s then s + ".0" else s | Const.Char c -> "'" + c.ToString() + "'" @@ -3655,16 +3655,16 @@ module DebugPrint = | NormalSeq -> "; (*Seq*)" | ThenDoSeq -> "; (*ThenDo*)" ((exprL expr1 ^^ rightL (tagText flag)) @@ exprL expr2) |> wrap - | Expr.Lambda(_, _, baseValOpt, argvs, body, _, _) -> + | Expr.Lambda (_, _, baseValOpt, argvs, body, _, _) -> let formalsL = spaceListL (List.map valAtBindL argvs) in let bindingL = match baseValOpt with | None -> wordL(tagText "lam") ^^ formalsL ^^ rightL(tagText ".") | Some basev -> wordL(tagText "lam") ^^ (leftL(tagText "base=") ^^ valAtBindL basev) --- formalsL ^^ rightL(tagText ".") in (bindingL ++ exprL body) |> wrap - | Expr.TyLambda(_, argtyvs, body, _, _) -> + | Expr.TyLambda (_, argtyvs, body, _, _) -> ((wordL(tagText "LAM") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap - | Expr.TyChoose(argtyvs, body, _) -> + | Expr.TyChoose (argtyvs, body, _) -> ((wordL(tagText "CHOOSE") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap | Expr.App (f, _, tys, argtys, _) -> let flayout = atomL f @@ -3677,9 +3677,9 @@ module DebugPrint = (wordL(tagText "RecLink") --- atomL (!rX)) |> wrap | Expr.Match (_, _, dtree, targets, _, _) -> leftL(tagText "[") ^^ (decisionTreeL dtree @@ aboveListL (List.mapi targetL (targets |> Array.toList)) ^^ rightL(tagText "]")) - | Expr.Op (TOp.UnionCase (c), _, args, _) -> + | Expr.Op (TOp.UnionCase c, _, args, _) -> (unionCaseRefL c ++ spaceListL (List.map atomL args)) |> wrap - | Expr.Op (TOp.ExnConstr (ecref), _, args, _) -> + | Expr.Op (TOp.ExnConstr ecref, _, args, _) -> wordL (tagText ecref.LogicalName) ^^ bracketL (commaListL (List.map atomL args)) | Expr.Op (TOp.Tuple _, _, xs, _) -> tupleL (List.map exprL xs) @@ -4450,13 +4450,13 @@ and accFreeInExprNonLinear opts x acc = | Expr.Quote (ast, {contents=None}, _, _, ty) -> accFreeInExpr opts ast (accFreeVarsInTy opts ty acc) - | Expr.App(f0, f0ty, tyargs, args, _) -> + | Expr.App (f0, f0ty, tyargs, args, _) -> accFreeVarsInTy opts f0ty (accFreeInExpr opts f0 (accFreeVarsInTys opts tyargs (accFreeInExprs opts args acc))) - | Expr.Link(eref) -> accFreeInExpr opts !eref acc + | Expr.Link eref -> accFreeInExpr opts !eref acc | Expr.Sequential (expr1, expr2, _, _, _) -> let acc = accFreeInExpr opts expr1 acc @@ -4544,7 +4544,7 @@ and accFreeInOp opts op acc = | TOp.Reraise -> accUsesRethrow true acc - | TOp.TraitCall(TTrait(tys, _, _, argtys, rty, sln)) -> + | TOp.TraitCall (TTrait(tys, _, _, argtys, rty, sln)) -> Option.foldBack (accFreeVarsInTraitSln opts) sln.Value (accFreeVarsInTys opts tys (accFreeVarsInTys opts argtys @@ -4635,7 +4635,7 @@ let rec stripLambdaN n expr = let tryStripLambdaN n expr = match expr with - | Expr.Lambda(_, None, None, _, _, _, _) -> + | Expr.Lambda (_, None, None, _, _, _, _) -> let argvsl, bodyExpr, remaining = stripLambdaN n expr if remaining = 0 then Some (argvsl, bodyExpr) else None @@ -4795,7 +4795,7 @@ let mkStaticOptimizationExpr g (cs, e1, e2, m) = let d = DecideStaticOptimizations g cs in if d = StaticOptimizationAnswer.No then e2 elif d = StaticOptimizationAnswer.Yes then e1 - else Expr.StaticOptimization(cs, e1, e2, m) + else Expr.StaticOptimization (cs, e1, e2, m) //-------------------------------------------------------------------------- // Copy expressions, including new names for locally bound values. @@ -4942,7 +4942,7 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = | Expr.TyChoose (tps, b, m) -> let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - Expr.TyChoose(tps', remapExpr g compgen tmenvinner b, m) + Expr.TyChoose (tps', remapExpr g compgen tmenvinner b, m) | Expr.LetRec (binds, e, m, _) -> let binds', tmenvinner = copyAndRemapAndBindBindings g compgen tmenv binds @@ -4986,7 +4986,7 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = let tinst = remapTypes tmenv tinst let arg = remapExpr g compgen tmenv arg let tmp, _ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfRecdFieldRef rfref tinst) - mkCompGenLet m tmp (mkRecdFieldGetViaExprAddr(arg, rfref, tinst, m)) (mkValAddr m readonly (mkLocalValRef tmp)) + mkCompGenLet m tmp (mkRecdFieldGetViaExprAddr (arg, rfref, tinst, m)) (mkValAddr m readonly (mkLocalValRef tmp)) | Expr.Op (TOp.UnionCaseFieldGetAddr (uref, cidx, readonly), tinst, [arg], m) when not (uref.FieldByIndex(cidx).IsMutable) && @@ -4995,7 +4995,7 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = let tinst = remapTypes tmenv tinst let arg = remapExpr g compgen tmenv arg let tmp, _ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfUnionFieldRef uref cidx tinst) - mkCompGenLet m tmp (mkUnionCaseFieldGetProvenViaExprAddr(arg, uref, tinst, cidx, m)) (mkValAddr m readonly (mkLocalValRef tmp)) + mkCompGenLet m tmp (mkUnionCaseFieldGetProvenViaExprAddr (arg, uref, tinst, cidx, m)) (mkValAddr m readonly (mkLocalValRef tmp)) | Expr.Op (op, tinst, args, m) -> let op' = remapOp tmenv op @@ -5004,15 +5004,15 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = if op === op' && tinst === tinst' && args === args' then expr else Expr.Op (op', tinst', args', m) - | Expr.App(e1, e1ty, tyargs, args, m) -> + | Expr.App (e1, e1ty, tyargs, args, m) -> let e1' = remapExpr g compgen tmenv e1 let e1ty' = remapPossibleForallTy g tmenv e1ty let tyargs' = remapTypes tmenv tyargs let args' = remapExprs g compgen tmenv args if e1 === e1' && e1ty === e1ty' && tyargs === tyargs' && args === args' then expr - else Expr.App(e1', e1ty', tyargs', args', m) + else Expr.App (e1', e1ty', tyargs', args', m) - | Expr.Link(eref) -> + | Expr.Link eref -> remapExpr g compgen tmenv !eref | Expr.StaticOptimization (cs, e2, e3, m) -> @@ -5066,28 +5066,28 @@ and remapLinearExpr g compgen tmenv expr contf = and remapConstraint tyenv c = match c with | TTyconEqualsTycon(ty1, ty2) -> TTyconEqualsTycon(remapType tyenv ty1, remapType tyenv ty2) - | TTyconIsStruct(ty1) -> TTyconIsStruct(remapType tyenv ty1) + | TTyconIsStruct ty1 -> TTyconIsStruct(remapType tyenv ty1) and remapOp tmenv op = match op with - | TOp.Recd (ctor, tcref) -> TOp.Recd(ctor, remapTyconRef tmenv.tyconRefRemap tcref) - | TOp.UnionCaseTagGet tcref -> TOp.UnionCaseTagGet(remapTyconRef tmenv.tyconRefRemap tcref) - | TOp.UnionCase ucref -> TOp.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap ucref) - | TOp.UnionCaseProof ucref -> TOp.UnionCaseProof(remapUnionCaseRef tmenv.tyconRefRemap ucref) - | TOp.ExnConstr ec -> TOp.ExnConstr(remapTyconRef tmenv.tyconRefRemap ec) - | TOp.ExnFieldGet (ec, n) -> TOp.ExnFieldGet(remapTyconRef tmenv.tyconRefRemap ec, n) - | TOp.ExnFieldSet (ec, n) -> TOp.ExnFieldSet(remapTyconRef tmenv.tyconRefRemap ec, n) - | TOp.ValFieldSet rfref -> TOp.ValFieldSet(remapRecdFieldRef tmenv.tyconRefRemap rfref) - | TOp.ValFieldGet rfref -> TOp.ValFieldGet(remapRecdFieldRef tmenv.tyconRefRemap rfref) - | TOp.ValFieldGetAddr (rfref, readonly) -> TOp.ValFieldGetAddr(remapRecdFieldRef tmenv.tyconRefRemap rfref, readonly) - | TOp.UnionCaseFieldGet (ucref, n) -> TOp.UnionCaseFieldGet(remapUnionCaseRef tmenv.tyconRefRemap ucref, n) - | TOp.UnionCaseFieldGetAddr (ucref, n, readonly) -> TOp.UnionCaseFieldGetAddr(remapUnionCaseRef tmenv.tyconRefRemap ucref, n, readonly) - | TOp.UnionCaseFieldSet (ucref, n) -> TOp.UnionCaseFieldSet(remapUnionCaseRef tmenv.tyconRefRemap ucref, n) + | TOp.Recd (ctor, tcref) -> TOp.Recd (ctor, remapTyconRef tmenv.tyconRefRemap tcref) + | TOp.UnionCaseTagGet tcref -> TOp.UnionCaseTagGet (remapTyconRef tmenv.tyconRefRemap tcref) + | TOp.UnionCase ucref -> TOp.UnionCase (remapUnionCaseRef tmenv.tyconRefRemap ucref) + | TOp.UnionCaseProof ucref -> TOp.UnionCaseProof (remapUnionCaseRef tmenv.tyconRefRemap ucref) + | TOp.ExnConstr ec -> TOp.ExnConstr (remapTyconRef tmenv.tyconRefRemap ec) + | TOp.ExnFieldGet (ec, n) -> TOp.ExnFieldGet (remapTyconRef tmenv.tyconRefRemap ec, n) + | TOp.ExnFieldSet (ec, n) -> TOp.ExnFieldSet (remapTyconRef tmenv.tyconRefRemap ec, n) + | TOp.ValFieldSet rfref -> TOp.ValFieldSet (remapRecdFieldRef tmenv.tyconRefRemap rfref) + | TOp.ValFieldGet rfref -> TOp.ValFieldGet (remapRecdFieldRef tmenv.tyconRefRemap rfref) + | TOp.ValFieldGetAddr (rfref, readonly) -> TOp.ValFieldGetAddr (remapRecdFieldRef tmenv.tyconRefRemap rfref, readonly) + | TOp.UnionCaseFieldGet (ucref, n) -> TOp.UnionCaseFieldGet (remapUnionCaseRef tmenv.tyconRefRemap ucref, n) + | TOp.UnionCaseFieldGetAddr (ucref, n, readonly) -> TOp.UnionCaseFieldGetAddr (remapUnionCaseRef tmenv.tyconRefRemap ucref, n, readonly) + | TOp.UnionCaseFieldSet (ucref, n) -> TOp.UnionCaseFieldSet (remapUnionCaseRef tmenv.tyconRefRemap ucref, n) | TOp.ILAsm (instrs, tys) -> let tys2 = remapTypes tmenv tys if tys === tys2 then op else TOp.ILAsm (instrs, tys2) - | TOp.TraitCall traitInfo -> TOp.TraitCall(remapTraitAux tmenv traitInfo) + | TOp.TraitCall traitInfo -> TOp.TraitCall (remapTraitAux tmenv traitInfo) | TOp.LValueOp (kind, lvr) -> TOp.LValueOp (kind, remapValRef tmenv lvr) | TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, valUseFlags, isProperty, noTailCall, ilMethRef, enclTypeArgs, methTypeArgs, tys) -> TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, remapValFlags tmenv valUseFlags, @@ -5452,18 +5452,18 @@ let rec remarkExpr m x = | Expr.Op (op, tinst, args, _) -> let op = match op with - | TOp.TryFinally(_, _) -> TOp.TryFinally(NoSequencePointAtTry, NoSequencePointAtFinally) - | TOp.TryCatch(_, _) -> TOp.TryCatch(NoSequencePointAtTry, NoSequencePointAtWith) + | TOp.TryFinally (_, _) -> TOp.TryFinally (NoSequencePointAtTry, NoSequencePointAtFinally) + | TOp.TryCatch (_, _) -> TOp.TryCatch (NoSequencePointAtTry, NoSequencePointAtWith) | _ -> op Expr.Op (op, tinst, remarkExprs m args, m) - | Expr.Link (eref) -> + | Expr.Link eref -> // Preserve identity of fixup nodes during remarkExpr eref := remarkExpr m !eref x - | Expr.App(e1, e1ty, tyargs, args, _) -> - Expr.App(remarkExpr m e1, e1ty, tyargs, remarkExprs m args, m) + | Expr.App (e1, e1ty, tyargs, args, _) -> + Expr.App (remarkExpr m e1, e1ty, tyargs, remarkExprs m args, m) | Expr.Sequential (e1, e2, dir, _, _) -> Expr.Sequential (remarkExpr m e1, remarkExpr m e2, dir, SuppressSequencePointOnExprOfSequential, m) @@ -5584,44 +5584,44 @@ let mkByteArrayTy (g: TcGlobals) = mkArrayType g g.byte_ty let rec tyOfExpr g e = match e with - | Expr.App(_, fty, tyargs, args, _) -> applyTys g fty (tyargs, args) + | Expr.App (_, fty, tyargs, args, _) -> applyTys g fty (tyargs, args) | Expr.Obj (_, ty, _, _, _, _, _) | Expr.Match (_, _, _, _, _, ty) - | Expr.Quote(_, _, _, _, ty) - | Expr.Const(_, _, ty) -> (ty) - | Expr.Val(vref, _, _) -> vref.Type - | Expr.Sequential(a, b, k, _, _) -> tyOfExpr g (match k with NormalSeq -> b | ThenDoSeq -> a) - | Expr.Lambda(_, _, _, vs, _, _, rty) -> (mkRefTupledVarsTy g vs --> rty) - | Expr.TyLambda(_, tyvs, _, _, rty) -> (tyvs +-> rty) - | Expr.Let(_, e, _, _) - | Expr.TyChoose(_, e, _) + | Expr.Quote (_, _, _, _, ty) + | Expr.Const (_, _, ty) -> (ty) + | Expr.Val (vref, _, _) -> vref.Type + | Expr.Sequential (a, b, k, _, _) -> tyOfExpr g (match k with NormalSeq -> b | ThenDoSeq -> a) + | Expr.Lambda (_, _, _, vs, _, _, rty) -> (mkRefTupledVarsTy g vs --> rty) + | Expr.TyLambda (_, tyvs, _, _, rty) -> (tyvs +-> rty) + | Expr.Let (_, e, _, _) + | Expr.TyChoose (_, e, _) | Expr.Link { contents=e} | Expr.StaticOptimization (_, _, e, _) - | Expr.LetRec(_, e, _, _) -> tyOfExpr g e + | Expr.LetRec (_, e, _, _) -> tyOfExpr g e | Expr.Op (op, tinst, _, _) -> match op with | TOp.Coerce -> (match tinst with [to_ty;_fromTy] -> to_ty | _ -> failwith "bad TOp.Coerce node") - | (TOp.ILCall (_, _, _, _, _, _, _, _, _, _, rtys) | TOp.ILAsm(_, rtys)) -> (match rtys with [h] -> h | _ -> g.unit_ty) + | (TOp.ILCall (_, _, _, _, _, _, _, _, _, _, rtys) | TOp.ILAsm (_, rtys)) -> (match rtys with [h] -> h | _ -> g.unit_ty) | TOp.UnionCase uc -> actualResultTyOfUnionCase tinst uc | TOp.UnionCaseProof uc -> mkProvenUnionCaseTy uc tinst | TOp.Recd (_, tcref) -> mkAppTy tcref tinst | TOp.ExnConstr _ -> g.exn_ty | TOp.Bytes _ -> mkByteArrayTy g | TOp.UInt16s _ -> mkArrayType g g.uint16_ty - | TOp.AnonRecdGet(_, i) -> List.item i tinst - | TOp.TupleFieldGet(_, i) -> List.item i tinst + | TOp.AnonRecdGet (_, i) -> List.item i tinst + | TOp.TupleFieldGet (_, i) -> List.item i tinst | TOp.Tuple tupInfo -> mkAnyTupledTy g tupInfo tinst | TOp.AnonRecd anonInfo -> mkAnyAnonRecdTy g anonInfo tinst | (TOp.For _ | TOp.While _) -> g.unit_ty | TOp.Array -> (match tinst with [ty] -> mkArrayType g ty | _ -> failwith "bad TOp.Array node") | (TOp.TryCatch _ | TOp.TryFinally _) -> (match tinst with [ty] -> ty | _ -> failwith "bad TOp_try node") - | TOp.ValFieldGetAddr(fref, readonly) -> mkByrefTyWithFlag g readonly (actualTyOfRecdFieldRef fref tinst) - | TOp.ValFieldGet(fref) -> actualTyOfRecdFieldRef fref tinst + | TOp.ValFieldGetAddr (fref, readonly) -> mkByrefTyWithFlag g readonly (actualTyOfRecdFieldRef fref tinst) + | TOp.ValFieldGet fref -> actualTyOfRecdFieldRef fref tinst | (TOp.ValFieldSet _ | TOp.UnionCaseFieldSet _ | TOp.ExnFieldSet _ | TOp.LValueOp ((LSet | LByrefSet), _)) ->g.unit_ty | TOp.UnionCaseTagGet _ -> g.int_ty - | TOp.UnionCaseFieldGetAddr(cref, j, readonly) -> mkByrefTyWithFlag g readonly (actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j)) - | TOp.UnionCaseFieldGet(cref, j) -> actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j) - | TOp.ExnFieldGet(ecref, j) -> recdFieldTyOfExnDefRefByIdx ecref j + | TOp.UnionCaseFieldGetAddr (cref, j, readonly) -> mkByrefTyWithFlag g readonly (actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j)) + | TOp.UnionCaseFieldGet (cref, j) -> actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j) + | TOp.ExnFieldGet (ecref, j) -> recdFieldTyOfExnDefRefByIdx ecref j | TOp.LValueOp (LByrefGet, v) -> destByrefTy g v.Type | TOp.LValueOp (LAddrOf readonly, v) -> mkByrefTyWithFlag g readonly v.Type | TOp.RefAddrGet readonly -> (match tinst with [ty] -> mkByrefTyWithFlag g readonly ty | _ -> failwith "bad TOp.RefAddrGet node") @@ -5638,7 +5638,7 @@ let rec tyOfExpr g e = //--------------------------------------------------------------------------- let primMkApp (f, fty) tyargs argsl m = - Expr.App(f, fty, tyargs, argsl, m) + Expr.App (f, fty, tyargs, argsl, m) // Check for the funky where a generic type instantiation at function type causes a generic function // to appear to accept more arguments than it really does, e.g. "id id 1", where the first "id" is @@ -5663,11 +5663,11 @@ let rec mkExprApplAux g f fty argsl m = // // Combine the term application with a term application, but only when f' is an under-applied value of known arity match f with - | Expr.App(f', fty', tyargs, pargs, m2) + | Expr.App (f', fty', tyargs, pargs, m2) when (isNil pargs || (match stripExpr f' with - | Expr.Val(v, _, _) -> + | Expr.Val (v, _, _) -> match v.ValReprInfo with | Some info -> info.NumCurriedArgs > pargs.Length | None -> false @@ -5951,7 +5951,7 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress // LVALUE of "x" where "x" is mutable local, mutable intra-assembly module/static binding, or operation doesn't mutate. // Note: we can always take the address of mutable intra-assembly values - | Expr.Val(vref, _, m) when MustTakeAddressOfVal g vref || CanTakeAddressOfImmutableVal g m vref mut -> + | Expr.Val (vref, _, m) when MustTakeAddressOfVal g vref || CanTakeAddressOfImmutableVal g m vref mut -> let readonly = not (MustTakeAddressOfVal g vref) let writeonly = false None, mkValAddr m readonly vref, readonly, writeonly @@ -5972,11 +5972,11 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress None, mkStaticRecdFieldGetAddr(readonly, rfref, tinst, m), readonly, writeonly // LVALUE of "e.f" where "f" is an F# union field. - | Expr.Op (TOp.UnionCaseFieldGet (uref, cidx), tinst, [objExpr], m) when MustTakeAddressOfRecdField (uref.FieldByIndex(cidx)) || CanTakeAddressOfUnionFieldRef g m uref cidx tinst mut -> + | Expr.Op (TOp.UnionCaseFieldGet (uref, cidx), tinst, [objExpr], m) when MustTakeAddressOfRecdField (uref.FieldByIndex cidx) || CanTakeAddressOfUnionFieldRef g m uref cidx tinst mut -> let objTy = tyOfExpr g objExpr let takeAddrOfObjExpr = isStructTy g objTy // It seems this will always be false - the address will already have been taken let wrap, expra, readonly, writeonly = mkExprAddrOfExprAux g takeAddrOfObjExpr false mut objExpr None m - let readonly = readonly || isInByrefTy g objTy || not (MustTakeAddressOfRecdField (uref.FieldByIndex(cidx))) + let readonly = readonly || isInByrefTy g objTy || not (MustTakeAddressOfRecdField (uref.FieldByIndex cidx)) let writeonly = writeonly || isOutByrefTy g objTy wrap, mkUnionCaseFieldGetAddrProvenViaExprAddr(readonly, expra, uref, tinst, cidx, m), readonly, writeonly @@ -5984,20 +5984,20 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress | Expr.Op (TOp.ILAsm ([IL.I_ldsfld(_vol, fspec)], [ty2]), tinst, [], m) -> let readonly = false // we never consider taking the address of a .NET static field to give an inref pointer let writeonly = false - None, Expr.Op (TOp.ILAsm ([IL.I_ldsflda(fspec)], [mkByrefTy g ty2]), tinst, [], m), readonly, writeonly + None, Expr.Op (TOp.ILAsm ([IL.I_ldsflda fspec], [mkByrefTy g ty2]), tinst, [], m), readonly, writeonly // LVALUE of "e.f" where "f" is a .NET instance field. - | Expr.Op (TOp.ILAsm ([IL.I_ldfld(_align, _vol, fspec)], [ty2]), tinst, [objExpr], m) -> + | Expr.Op (TOp.ILAsm ([IL.I_ldfld (_align, _vol, fspec)], [ty2]), tinst, [objExpr], m) -> let objTy = tyOfExpr g objExpr let takeAddrOfObjExpr = isStructTy g objTy // It seems this will always be false - the address will already have been taken // we never consider taking the address of an .NET instance field to give an inref pointer, unless the object pointer is an inref pointer let wrap, expra, readonly, writeonly = mkExprAddrOfExprAux g takeAddrOfObjExpr false mut objExpr None m let readonly = readonly || isInByrefTy g objTy let writeonly = writeonly || isOutByrefTy g objTy - wrap, Expr.Op (TOp.ILAsm ([IL.I_ldflda(fspec)], [mkByrefTyWithFlag g readonly ty2]), tinst, [expra], m), readonly, writeonly + wrap, Expr.Op (TOp.ILAsm ([IL.I_ldflda fspec], [mkByrefTyWithFlag g readonly ty2]), tinst, [expra], m), readonly, writeonly // LVALUE of "e.[n]" where e is an array of structs - | Expr.App(Expr.Val(vf, _, _), _, [elemTy], [aexpr;nexpr], _) when (valRefEq g vf g.array_get_vref) -> + | Expr.App (Expr.Val (vf, _, _), _, [elemTy], [aexpr;nexpr], _) when (valRefEq g vf g.array_get_vref) -> let readonly = false // array address is never forced to be readonly let writeonly = false @@ -6005,12 +6005,12 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress let ilInstrReadOnlyAnnotation = if isTyparTy g elemTy && useReadonlyForGenericArrayAddress then ReadonlyAddress else NormalAddress let isNativePtr = match addrExprVal with - | Some(vf) -> valRefEq g vf g.addrof2_vref + | Some vf -> valRefEq g vf g.addrof2_vref | _ -> false None, mkArrayElemAddress g (readonly, ilInstrReadOnlyAnnotation, isNativePtr, shape, elemTy, [aexpr; nexpr], m), readonly, writeonly // LVALUE of "e.[n1, n2]", "e.[n1, n2, n3]", "e.[n1, n2, n3, n4]" where e is an array of structs - | Expr.App(Expr.Val(vref, _, _), _, [elemTy], (aexpr:: args), _) + | Expr.App (Expr.Val (vref, _, _), _, [elemTy], (aexpr:: args), _) when (valRefEq g vref g.array2D_get_vref || valRefEq g vref g.array3D_get_vref || valRefEq g vref g.array4D_get_vref) -> let readonly = false // array address is never forced to be readonly @@ -6019,13 +6019,13 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress let ilInstrReadOnlyAnnotation = if isTyparTy g elemTy && useReadonlyForGenericArrayAddress then ReadonlyAddress else NormalAddress let isNativePtr = match addrExprVal with - | Some(vf) -> valRefEq g vf g.addrof2_vref + | Some vf -> valRefEq g vf g.addrof2_vref | _ -> false None, mkArrayElemAddress g (readonly, ilInstrReadOnlyAnnotation, isNativePtr, shape, elemTy, (aexpr:: args), m), readonly, writeonly // LVALUE: "&meth(args)" where meth has a byref or inref return. Includes "&span.[idx]". - | Expr.Let(TBind(vref, e, _), Expr.Op(TOp.LValueOp (LByrefGet, vref2), _, _, _), _, _) + | Expr.Let (TBind(vref, e, _), Expr.Op (TOp.LValueOp (LByrefGet, vref2), _, _, _), _, _) when (valRefEq g (mkLocalValRef vref) vref2) && (MustTakeAddressOfByrefGet g vref2 || CanTakeAddressOfByrefGet g vref2 mut) -> let ty = tyOfExpr g e @@ -6034,11 +6034,11 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress None, e, readonly, writeonly // Give a nice error message for address-of-byref - | Expr.Val(vref, _, m) when isByrefTy g vref.Type -> + | Expr.Val (vref, _, m) when isByrefTy g vref.Type -> error(Error(FSComp.SR.tastUnexpectedByRef(), m)) // Give a nice error message for DefinitelyMutates of address-of on mutable values in other assemblies - | Expr.Val(vref, _, m) when (mut = DefinitelyMutates || mut = AddressOfOp) && vref.IsMutable -> + | Expr.Val (vref, _, m) when (mut = DefinitelyMutates || mut = AddressOfOp) && vref.IsMutable -> error(Error(FSComp.SR.tastInvalidAddressOfMutableAcrossAssemblyBoundary(), m)) // Give a nice error message for AddressOfOp on immutable values @@ -6098,14 +6098,14 @@ let mkAnonRecdFieldGet g (anonInfo: AnonRecdTypeInfo, e, tinst, i, m) = let mkRecdFieldGet g (e, fref: RecdFieldRef, tinst, m) = assert (not (isByrefTy g (tyOfExpr g e))) let wrap, e', _readonly, _writeonly = mkExprAddrOfExpr g fref.Tycon.IsStructOrEnumTycon false NeverMutates e None m - wrap (mkRecdFieldGetViaExprAddr(e', fref, tinst, m)) + wrap (mkRecdFieldGetViaExprAddr (e', fref, tinst, m)) let mkUnionCaseFieldGetUnproven g (e, cref: UnionCaseRef, tinst, j, m) = assert (not (isByrefTy g (tyOfExpr g e))) let wrap, e', _readonly, _writeonly = mkExprAddrOfExpr g cref.Tycon.IsStructOrEnumTycon false NeverMutates e None m wrap (mkUnionCaseFieldGetUnprovenViaExprAddr (e', cref, tinst, j, m)) -let mkArray (argty, args, m) = Expr.Op(TOp.Array, [argty], args, m) +let mkArray (argty, args, m) = Expr.Op (TOp.Array, [argty], args, m) //--------------------------------------------------------------------------- // Compute fixups for letrec's. @@ -6140,14 +6140,14 @@ let rec IterateRecursiveFixups g (selfv: Val option) rvs ((access: Expr), set) e errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeInConstructionOfTuple(), m)) e))) - | Expr.Op (TOp.UnionCase (c), tinst, args, m) -> + | Expr.Op (TOp.UnionCase c, tinst, args, m) -> args |> List.iteri (fun n -> IterateRecursiveFixups g None rvs (mkUnionCaseFieldGetUnprovenViaExprAddr (access, c, tinst, n, m), (fun e -> // NICE: it would be better to do this check in the type checker let tcref = c.TyconRef - if not (c.FieldByIndex(n)).IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then + if not (c.FieldByIndex n).IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then errorR(Error(FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType(tcref.LogicalName), m)) mkUnionCaseFieldSet (access, c, tinst, n, e, m)))) @@ -6155,7 +6155,7 @@ let rec IterateRecursiveFixups g (selfv: Val option) rvs ((access: Expr), set) e (tcref.TrueInstanceFieldsAsRefList, args) ||> List.iter2 (fun fref arg -> let fspec = fref.RecdField IterateRecursiveFixups g None rvs - (mkRecdFieldGetViaExprAddr(access, fref, tinst, m), + (mkRecdFieldGetViaExprAddr (access, fref, tinst, m), (fun e -> // NICE: it would be better to do this check in the type checker if not fspec.IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then @@ -6239,13 +6239,13 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = let z = exprF z x0 exprF z x1 - | Expr.Lambda(_lambdaId, _ctorThisValOpt, _baseValOpt, _argvs, body, _m, _rty) -> + | Expr.Lambda (_lambdaId, _ctorThisValOpt, _baseValOpt, _argvs, body, _m, _rty) -> exprF z body - | Expr.TyLambda(_lambdaId, _argtyvs, body, _m, _rty) -> + | Expr.TyLambda (_lambdaId, _argtyvs, body, _m, _rty) -> exprF z body - | Expr.TyChoose(_, body, _) -> + | Expr.TyChoose (_, body, _) -> exprF z body | Expr.App (f, _fty, _tys, argtys, _) -> @@ -6268,11 +6268,11 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = // tailcall targetF z targets.[targets.Length - 1] - | Expr.Quote(e, {contents=Some(_typeDefs, _argTypes, argExprs, _)}, _, _, _) -> + | Expr.Quote (e, {contents=Some(_typeDefs, _argTypes, argExprs, _)}, _, _, _) -> let z = exprF z e exprsF z argExprs - | Expr.Quote(e, {contents=None}, _, _m, _) -> + | Expr.Quote (e, {contents=None}, _, _m, _) -> exprF z e | Expr.Obj (_n, _typ, _basev, basecall, overrides, iimpls, _m) -> @@ -6374,23 +6374,23 @@ let ExprStats x = // Make expressions //------------------------------------------------------------------------- -let mkString (g: TcGlobals) m n = Expr.Const(Const.String n, m, g.string_ty) +let mkString (g: TcGlobals) m n = Expr.Const (Const.String n, m, g.string_ty) -let mkBool (g: TcGlobals) m b = Expr.Const(Const.Bool b, m, g.bool_ty) +let mkBool (g: TcGlobals) m b = Expr.Const (Const.Bool b, m, g.bool_ty) -let mkByte (g: TcGlobals) m b = Expr.Const(Const.Byte b, m, g.byte_ty) +let mkByte (g: TcGlobals) m b = Expr.Const (Const.Byte b, m, g.byte_ty) -let mkUInt16 (g: TcGlobals) m b = Expr.Const(Const.UInt16 b, m, g.uint16_ty) +let mkUInt16 (g: TcGlobals) m b = Expr.Const (Const.UInt16 b, m, g.uint16_ty) let mkTrue g m = mkBool g m true let mkFalse g m = mkBool g m false -let mkUnit (g: TcGlobals) m = Expr.Const(Const.Unit, m, g.unit_ty) +let mkUnit (g: TcGlobals) m = Expr.Const (Const.Unit, m, g.unit_ty) -let mkInt32 (g: TcGlobals) m n = Expr.Const(Const.Int32 n, m, g.int32_ty) +let mkInt32 (g: TcGlobals) m n = Expr.Const (Const.Int32 n, m, g.int32_ty) -let mkInt g m n = mkInt32 g m (n) +let mkInt g m n = mkInt32 g m n let mkZero g m = mkInt g m 0 @@ -6400,7 +6400,7 @@ let mkTwo g m = mkInt g m 2 let mkMinusOne g m = mkInt g m (-1) -let destInt32 = function Expr.Const(Const.Int32 n, _, _) -> Some n | _ -> None +let destInt32 = function Expr.Const (Const.Int32 n, _, _) -> Some n | _ -> None let isIDelegateEventType g ty = match tryDestAppTy g ty with @@ -6422,7 +6422,7 @@ let mkIObserverType (g: TcGlobals) ty1 = TType_app (g.tcref_IObserver, [ty1]) let mkRefCellContentsRef (g: TcGlobals) = mkRecdFieldRef g.refcell_tcr_canon "contents" -let mkSequential spSeq m e1 e2 = Expr.Sequential(e1, e2, NormalSeq, spSeq, m) +let mkSequential spSeq m e1 e2 = Expr.Sequential (e1, e2, NormalSeq, spSeq, m) let mkCompGenSequential m e1 e2 = mkSequential SuppressSequencePointOnExprOfSequential m e1 e2 @@ -6432,7 +6432,7 @@ let rec mkSequentials spSeq g m es = | e:: es -> mkSequential spSeq m e (mkSequentials spSeq g m es) | [] -> mkUnit g m -let mkGetArg0 m ty = mkAsmExpr( [ mkLdarg0 ], [], [], [ty], m) +let mkGetArg0 m ty = mkAsmExpr ( [ mkLdarg0 ], [], [], [ty], m) //------------------------------------------------------------------------- // Tuples... @@ -6450,7 +6450,7 @@ let mkRefTupledNoTypes g m args = mkRefTupled g m args (List.map (tyOfExpr g) ar let mkRefTupledVars g m vs = mkRefTupled g m (List.map (exprForVal m) vs) (typesOfVals vs) -let mkAnonRecd (_g: TcGlobals) m anonInfo es tys = Expr.Op (TOp.AnonRecd (anonInfo),tys,es,m) +let mkAnonRecd (_g: TcGlobals) m anonInfo es tys = Expr.Op (TOp.AnonRecd anonInfo,tys,es,m) //-------------------------------------------------------------------------- // Permute expressions @@ -6526,7 +6526,7 @@ let mkRecordExpr g (lnk, tcref, tinst, rfrefs: RecdFieldRef list, args, m) = let argTys = List.map (fun rfref -> actualTyOfRecdFieldRef rfref tinst) rfrefs let names = rfrefs |> List.map (fun rfref -> rfref.FieldName) let binds, args = permuteExprList sigma args argTys names - mkLetsBind m binds (Expr.Op (TOp.Recd(lnk, tcref), tinst, args, m)) + mkLetsBind m binds (Expr.Op (TOp.Recd (lnk, tcref), tinst, args, m)) //------------------------------------------------------------------------- // List builders @@ -6759,7 +6759,7 @@ let mkCallNewFormat (g: TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExp let TryEliminateDesugaredConstants g m c = match c with | Const.Decimal d -> - match System.Decimal.GetBits(d) with + match System.Decimal.GetBits d with | [| lo;med;hi; signExp |] -> let scale = (min (((signExp &&& 0xFF0000) >>> 16) &&& 0xFF) 28) |> byte let isNegative = (signExp &&& 0x80000000) <> 0 @@ -6840,10 +6840,10 @@ let mkCallLiftValueWithDefn g m qty e1 = match vref.TryDeref with | ValueSome _ -> let copyOfExpr = copyExpr g ValCopyFlag.CloneAll e1 - let quoteOfCopyOfExpr = Expr.Quote(copyOfExpr, ref None, false, m, qty) + let quoteOfCopyOfExpr = Expr.Quote (copyOfExpr, ref None, false, m, qty) mkApps g (typedExprForIntrinsic g m g.lift_value_with_defn_info, [[ty]], [mkRefTupledNoTypes g m [e1; quoteOfCopyOfExpr]], m) | ValueNone -> - Expr.Quote(e1, ref None, false, m, qty) + Expr.Quote (e1, ref None, false, m, qty) let mkCallCheckThis g m ty e1 = mkApps g (typedExprForIntrinsic g m g.check_this_info, [[ty]], [e1], m) @@ -6868,23 +6868,23 @@ let mkGetStringChar = mkGetString let mkGetStringLength g m e = let mspec = mspec_String_Length g /// ILCall(useCallvirt, isProtected, valu, newobj, valUseFlags, isProp, noTailCall, mref, actualTypeInst, actualMethInst, retTy) - Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, true, false, mspec.MethodRef, [], [], [g.int32_ty]), [], [e], m) + Expr.Op (TOp.ILCall (false, false, false, false, ValUseFlag.NormalValUse, true, false, mspec.MethodRef, [], [], [g.int32_ty]), [], [e], m) let mkStaticCall_String_Concat2 g m arg1 arg2 = let mspec = mspec_String_Concat2 g - Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2], m) + Expr.Op (TOp.ILCall (false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2], m) let mkStaticCall_String_Concat3 g m arg1 arg2 arg3 = let mspec = mspec_String_Concat3 g - Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2; arg3], m) + Expr.Op (TOp.ILCall (false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2; arg3], m) let mkStaticCall_String_Concat4 g m arg1 arg2 arg3 arg4 = let mspec = mspec_String_Concat4 g - Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2; arg3; arg4], m) + Expr.Op (TOp.ILCall (false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2; arg3; arg4], m) let mkStaticCall_String_Concat_Array g m arg = let mspec = mspec_String_Concat_Array g - Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg], m) + Expr.Op (TOp.ILCall (false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg], m) // Quotations can't contain any IL. // As a result, we aim to get rid of all IL generation in the typechecker and pattern match @@ -6892,9 +6892,9 @@ let mkStaticCall_String_Concat_Array g m arg = // Hence each of the following are marked with places where they are generated. // Generated by the optimizer and the encoding of 'for' loops -let mkDecr (g: TcGlobals) m e = mkAsmExpr([ IL.AI_sub ], [], [e; mkOne g m], [g.int_ty], m) +let mkDecr (g: TcGlobals) m e = mkAsmExpr ([ IL.AI_sub ], [], [e; mkOne g m], [g.int_ty], m) -let mkIncr (g: TcGlobals) m e = mkAsmExpr([ IL.AI_add ], [], [mkOne g m; e], [g.int_ty], m) +let mkIncr (g: TcGlobals) m e = mkAsmExpr ([ IL.AI_add ], [], [mkOne g m; e], [g.int_ty], m) // Generated by the pattern match compiler and the optimizer for // 1. array patterns @@ -6915,18 +6915,18 @@ let mkILAsmClt (g: TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_clt ], [], [e1; e2], // This is generated in the initialization of the "ctorv" field in the typechecker's compilation of // an implicit class construction. -let mkNull m ty = Expr.Const(Const.Zero, m, ty) +let mkNull m ty = Expr.Const (Const.Zero, m, ty) let mkThrow m ty e = mkAsmExpr ([ IL.I_throw ], [], [e], [ty], m) let destThrow = function - | Expr.Op (TOp.ILAsm([IL.I_throw], [ty2]), [], [e], m) -> Some (m, ty2, e) + | Expr.Op (TOp.ILAsm ([IL.I_throw], [ty2]), [], [e], m) -> Some (m, ty2, e) | _ -> None let isThrow x = Option.isSome (destThrow x) // reraise - parsed as library call - internally represented as op form. -let mkReraiseLibCall (g: TcGlobals) ty m = let ve, vt = typedExprForIntrinsic g m g.reraise_info in Expr.App(ve, vt, [ty], [mkUnit g m], m) +let mkReraiseLibCall (g: TcGlobals) ty m = let ve, vt = typedExprForIntrinsic g m g.reraise_info in Expr.App (ve, vt, [ty], [mkUnit g m], m) let mkReraise m returnTy = Expr.Op (TOp.Reraise, [returnTy], [], m) (* could suppress unitArg *) @@ -6947,7 +6947,7 @@ let tref_SourceConstructFlags (g: TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, let mkCompilationMappingAttrPrim (g: TcGlobals) k nums = mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, ((mkILNonGenericValueTy (tref_SourceConstructFlags g)) :: (nums |> List.map (fun _ -> g.ilg.typ_Int32))), - ((k :: nums) |> List.map (fun n -> ILAttribElem.Int32(n))), + ((k :: nums) |> List.map (fun n -> ILAttribElem.Int32 n)), []) let mkCompilationMappingAttr g kind = mkCompilationMappingAttrPrim g kind [] @@ -6958,7 +6958,7 @@ let mkCompilationMappingAttrWithVariantNumAndSeqNum g kind varNum seqNum = mkCom let mkCompilationArgumentCountsAttr (g: TcGlobals) nums = mkILCustomAttribute g.ilg (tref_CompilationArgumentCountsAttr g, [ mkILArr1DTy g.ilg.typ_Int32 ], - [ILAttribElem.Array (g.ilg.typ_Int32, List.map (fun n -> ILAttribElem.Int32(n)) nums)], + [ILAttribElem.Array (g.ilg.typ_Int32, List.map (fun n -> ILAttribElem.Int32 n) nums)], []) let mkCompilationSourceNameAttr (g: TcGlobals) n = @@ -7050,7 +7050,7 @@ let IsMatchingSignatureDataVersionAttr ilg (version: ILVersionInfo) cattr = false let mkCompilerGeneratedAttr (g: TcGlobals) n = - mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, [mkILNonGenericValueTy (tref_SourceConstructFlags g)], [ILAttribElem.Int32(n)], []) + mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, [mkILNonGenericValueTy (tref_SourceConstructFlags g)], [ILAttribElem.Int32 n], []) //-------------------------------------------------------------------------- // tupled lambda --> method/function with a given topValInfo specification. @@ -7125,7 +7125,7 @@ let MultiLambdaToTupledLambdaIfNeeded g (vs, arg) body = let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl: TType list list, argsl: Expr list, m) = match f with - | Expr.Let(bind, body, mlet, _) -> + | Expr.Let (bind, body, mlet, _) -> // Lift bindings out, i.e. (let x = e in f) y --> let x = e in f y // This increases the scope of 'x', which I don't like as it mucks with debugging // scopes of variables, but this is an important optimization, especially when the '|>' @@ -7139,7 +7139,7 @@ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl: TType list list, arg | tyargs :: rest -> // Bind type parameters by immediate substitution match f with - | Expr.TyLambda(_, tyvs, body, _, bodyty) when tyvs.Length = List.length tyargs -> + | Expr.TyLambda (_, tyvs, body, _, bodyty) when tyvs.Length = List.length tyargs -> let tpenv = bindTypars tyvs tyargs emptyTyparInst let body = remarkExpr m (instExpr g tpenv body) let bodyty' = instType tpenv bodyty @@ -7200,7 +7200,7 @@ let AdjustValForExpectedArity g m (vref: ValRef) flags topValInfo = let tpenv = bindTypars tps tyargs' emptyTyparInst let rty' = instType tpenv rty let vsl = MakeArgsForTopArgs g m argtysl tpenv - let call = MakeApplicationAndBetaReduce g (Expr.Val(vref, flags, m), vref.Type, [tyargs'], (List.map (mkRefTupledVars g m) vsl), m) + let call = MakeApplicationAndBetaReduce g (Expr.Val (vref, flags, m), vref.Type, [tyargs'], (List.map (mkRefTupledVars g m) vsl), m) let tauexpr, tauty = List.foldBack (fun vs (e, ty) -> mkMultiLambda m vs (e, ty), (mkRefTupledVarsTy g vs --> ty)) @@ -7519,7 +7519,7 @@ let NormalizeAndAdjustPossibleSubsumptionExprs g inputExpr = let expr, args = // AdjustPossibleSubsumptionExpr can take into account an application match stripExpr inputExpr with - | Expr.App(f, _fty, [], args, _) -> + | Expr.App (f, _fty, [], args, _) -> f, args | _ -> @@ -7532,7 +7532,7 @@ let NormalizeAndAdjustPossibleSubsumptionExprs g inputExpr = expr' | Some (expr', args') -> //printfn "adjusted...." - Expr.App(expr', tyOfExpr g expr', [], args', inputExpr.Range) + Expr.App (expr', tyOfExpr g expr', [], args', inputExpr.Range) //--------------------------------------------------------------------------- @@ -7574,7 +7574,7 @@ let LinearizeTopMatchAux g parent (spBind, m, tree, targets, m2, ty) = match tys with | [] -> failwith "itemsProj: no items?" | [_] -> x (* no projection needed *) - | tys -> Expr.Op (TOp.TupleFieldGet(tupInfoRef, i), tys, [x], m) + | tys -> Expr.Op (TOp.TupleFieldGet (tupInfoRef, i), tys, [x], m) let isThrowingTarget = function TTarget(_, x, _) -> isThrow x if 1 + List.count isThrowingTarget targetsL = targetsL.Length then (* Have failing targets and ONE successful one, so linearize *) @@ -7706,7 +7706,7 @@ let XmlDocArgsEnc g (gtpsType, gtpsMethod) argTs = let buildAccessPath (cp: CompilationPath option) = match cp with - | Some(cp) -> + | Some cp -> let ap = cp.AccessPath |> List.map fst |> List.toArray System.String.Join(".", ap) | None -> "Extension Type" @@ -7780,7 +7780,7 @@ let enum_CompilationRepresentationAttribute_PermitNull = 0b0000000000001000 let HasUseNullAsTrueValueAttribute g attribs = match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attribs with - | Some(flags) -> ((flags &&& enum_CompilationRepresentationAttribute_PermitNull) <> 0) + | Some flags -> ((flags &&& enum_CompilationRepresentationAttribute_PermitNull) <> 0) | _ -> false let TyconHasUseNullAsTrueValueAttribute g (tycon: Tycon) = HasUseNullAsTrueValueAttribute g tycon.Attribs @@ -7847,7 +7847,7 @@ let rec TypeHasDefaultValue g m ty = // Note this includes fields implied by the use of the implicit class construction syntax tcref.AllInstanceFieldsAsList // We can ignore fields with the DefaultValue(false) attribute - |> List.filter (fun fld -> not (TryFindFSharpBoolAttribute g g.attrib_DefaultValueAttribute fld.FieldAttribs = Some(false))) + |> List.filter (fun fld -> not (TryFindFSharpBoolAttribute g g.attrib_DefaultValueAttribute fld.FieldAttribs = Some false)) flds |> List.forall (actualTyOfRecdField (mkTyconRefInst tcref tinst) >> TypeHasDefaultValue g m) elif isStructTupleTy g ty then @@ -7946,7 +7946,7 @@ let mkIfThen (g: TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding Supp let ModuleNameIsMangled g attrs = match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attrs with - | Some(flags) -> ((flags &&& enum_CompilationRepresentationAttribute_ModuleSuffix) <> 0) + | Some flags -> ((flags &&& enum_CompilationRepresentationAttribute_ModuleSuffix) <> 0) | _ -> false let CompileAsEvent g attrs = HasFSharpAttribute g g.attrib_CLIEventAttribute attrs @@ -7962,7 +7962,7 @@ let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo: ValMemberIn // Otherwise check attributes to see if there is an explicit instance or explicit static flag let explicitInstance, explicitStatic = match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attrs with - | Some(flags) -> + | Some flags -> ((flags &&& enum_CompilationRepresentationAttribute_Instance) <> 0), ((flags &&& enum_CompilationRepresentationAttribute_Static) <> 0) | _ -> false, false @@ -7995,11 +7995,11 @@ let isComInteropTy g ty = let tcref = tcrefOfAppTy g ty match g.attrib_ComImportAttribute with | None -> false - | Some attr -> TryFindFSharpBoolAttribute g attr tcref.Attribs = Some(true) + | Some attr -> TryFindFSharpBoolAttribute g attr tcref.Attribs = Some true let ValSpecIsCompiledAsInstance g (v: Val) = match v.MemberInfo with - | Some(membInfo) -> + | Some membInfo -> // Note it doesn't matter if we pass 'v.TopValDeclaringEntity' or 'v.MemberApparentEntity' here. // These only differ if the value is an extension member, and in that case MemberIsCompiledAsInstance always returns // false anyway @@ -8015,7 +8015,7 @@ let ValRefIsCompiledAsInstanceMember g (vref: ValRef) = ValSpecIsCompiledAsInsta let GetMemberCallInfo g (vref: ValRef, vFlags) = match vref.MemberInfo with - | Some(membInfo) when not vref.IsExtensionMember -> + | Some membInfo when not vref.IsExtensionMember -> let numEnclTypeArgs = vref.MemberApparentEntity.TyparsNoRange.Length let virtualCall = (membInfo.MemberFlags.IsOverrideOrExplicitImpl || @@ -8156,17 +8156,17 @@ and rewriteExprStructure env expr = | Expr.Const _ | Expr.Val _ -> expr - | Expr.App(f0, f0ty, tyargs, args, m) -> + | Expr.App (f0, f0ty, tyargs, args, m) -> let f0' = RewriteExpr env f0 let args' = rewriteExprs env args if f0 === f0' && args === args' then expr - else Expr.App(f0', f0ty, tyargs, args', m) + else Expr.App (f0', f0ty, tyargs, args', m) - | Expr.Quote(ast, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> - Expr.Quote((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=Some(typeDefs, argTypes, rewriteExprs env argExprs, data)}, isFromQueryExpression, m, ty) + | Expr.Quote (ast, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> + Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=Some(typeDefs, argTypes, rewriteExprs env argExprs, data)}, isFromQueryExpression, m, ty) - | Expr.Quote(ast, {contents=None}, isFromQueryExpression, m, ty) -> - Expr.Quote((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=None}, isFromQueryExpression, m, ty) + | Expr.Quote (ast, {contents=None}, isFromQueryExpression, m, ty) -> + Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=None}, isFromQueryExpression, m, ty) | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> mkObjExpr(ty, basev, RewriteExpr env basecall, List.map (rewriteObjExprOverride env) overrides, @@ -8179,15 +8179,15 @@ and rewriteExprStructure env expr = if args === args' then expr else Expr.Op (c, tyargs, args', m) - | Expr.Lambda(_lambdaId, ctorThisValOpt, baseValOpt, argvs, body, m, rty) -> + | Expr.Lambda (_lambdaId, ctorThisValOpt, baseValOpt, argvs, body, m, rty) -> let body = RewriteExpr env body rebuildLambda m ctorThisValOpt baseValOpt argvs (body, rty) - | Expr.TyLambda(_lambdaId, argtyvs, body, m, rty) -> + | Expr.TyLambda (_lambdaId, argtyvs, body, m, rty) -> let body = RewriteExpr env body mkTypeLambda m argtyvs (body, rty) - | Expr.Match(spBind, exprm, dtree, targets, m, ty) -> + | Expr.Match (spBind, exprm, dtree, targets, m, ty) -> let dtree' = rewriteDecisionTree env dtree let targets' = rewriteTargets env targets mkAndSimplifyMatch spBind exprm m ty dtree' targets' @@ -8195,7 +8195,7 @@ and rewriteExprStructure env expr = | Expr.LetRec (binds, e, m, _) -> let binds = rewriteBinds env binds let e' = RewriteExpr env e - Expr.LetRec(binds, e', m, NewFreeVarsCache()) + Expr.LetRec (binds, e', m, NewFreeVarsCache()) | Expr.Let _ -> failwith "unreachable - linear let" @@ -8204,10 +8204,10 @@ and rewriteExprStructure env expr = | Expr.StaticOptimization (constraints, e2, e3, m) -> let e2' = RewriteExpr env e2 let e3' = RewriteExpr env e3 - Expr.StaticOptimization(constraints, e2', e3', m) + Expr.StaticOptimization (constraints, e2', e3', m) | Expr.TyChoose (a, b, m) -> - Expr.TyChoose(a, RewriteExpr env b, m) + Expr.TyChoose (a, RewriteExpr env b, m) and rewriteLinearExpr env expr contf = // schedule a rewrite on the way back up by adding to the continuation @@ -8227,7 +8227,7 @@ and rewriteLinearExpr env expr contf = // tailcall rewriteLinearExpr env expr2 (contf << (fun expr2' -> if expr1 === expr1' && expr2 === expr2' then expr - else Expr.Sequential(expr1', expr2', dir, spSeq, m))) + else Expr.Sequential (expr1', expr2', dir, spSeq, m))) | LinearOpExpr (op, tyargs, argsFront, argLast, m) -> let argsFront' = rewriteExprs env argsFront @@ -8470,9 +8470,9 @@ let IsSimpleSyntacticConstantExpr g inputExpr = valRefEq g vref g.bitwise_or_vref) && (not (typeEquiv g (tyOfExpr g arg1) g.string_ty) && not (typeEquiv g (tyOfExpr g arg1) g.decimal_ty) ) -> checkExpr vrefs arg1 && checkExpr vrefs arg2 - | Expr.Val(vref, _, _) -> vref.Deref.IsCompiledAsStaticPropertyWithoutField || vrefs.Contains vref.Stamp - | Expr.Match(_, _, dtree, targets, _, _) -> checkDecisionTree vrefs dtree && targets |> Array.forall (checkDecisionTreeTarget vrefs) - | Expr.Let(b, e, _, _) -> checkExpr vrefs b.Expr && checkExpr (vrefs.Add b.Var.Stamp) e + | Expr.Val (vref, _, _) -> vref.Deref.IsCompiledAsStaticPropertyWithoutField || vrefs.Contains vref.Stamp + | Expr.Match (_, _, dtree, targets, _, _) -> checkDecisionTree vrefs dtree && targets |> Array.forall (checkDecisionTreeTarget vrefs) + | Expr.Let (b, e, _, _) -> checkExpr vrefs b.Expr && checkExpr (vrefs.Add b.Var.Stamp) e // Detect standard constants | Expr.TyChoose (_, b, _) -> checkExpr vrefs b | Expr.Const _ @@ -8501,14 +8501,14 @@ let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt let m = unionRanges arg1.Range arg2.Range try match arg1, arg2 with - | Expr.Const(Const.Int32 x1, _, ty), Expr.Const(Const.Int32 x2, _, _) -> Expr.Const(Const.Int32 (opInt32 x1 x2), m, ty) - | Expr.Const(Const.SByte x1, _, ty), Expr.Const(Const.SByte x2, _, _) -> Expr.Const(Const.SByte (opInt8 x1 x2), m, ty) - | Expr.Const(Const.Int16 x1, _, ty), Expr.Const(Const.Int16 x2, _, _) -> Expr.Const(Const.Int16 (opInt16 x1 x2), m, ty) - | Expr.Const(Const.Int64 x1, _, ty), Expr.Const(Const.Int64 x2, _, _) -> Expr.Const(Const.Int64 (opInt64 x1 x2), m, ty) - | Expr.Const(Const.Byte x1, _, ty), Expr.Const(Const.Byte x2, _, _) -> Expr.Const(Const.Byte (opUInt8 x1 x2), m, ty) - | Expr.Const(Const.UInt16 x1, _, ty), Expr.Const(Const.UInt16 x2, _, _) -> Expr.Const(Const.UInt16 (opUInt16 x1 x2), m, ty) - | Expr.Const(Const.UInt32 x1, _, ty), Expr.Const(Const.UInt32 x2, _, _) -> Expr.Const(Const.UInt32 (opUInt32 x1 x2), m, ty) - | Expr.Const(Const.UInt64 x1, _, ty), Expr.Const(Const.UInt64 x2, _, _) -> Expr.Const(Const.UInt64 (opUInt64 x1 x2), m, ty) + | Expr.Const (Const.Int32 x1, _, ty), Expr.Const (Const.Int32 x2, _, _) -> Expr.Const (Const.Int32 (opInt32 x1 x2), m, ty) + | Expr.Const (Const.SByte x1, _, ty), Expr.Const (Const.SByte x2, _, _) -> Expr.Const (Const.SByte (opInt8 x1 x2), m, ty) + | Expr.Const (Const.Int16 x1, _, ty), Expr.Const (Const.Int16 x2, _, _) -> Expr.Const (Const.Int16 (opInt16 x1 x2), m, ty) + | Expr.Const (Const.Int64 x1, _, ty), Expr.Const (Const.Int64 x2, _, _) -> Expr.Const (Const.Int64 (opInt64 x1 x2), m, ty) + | Expr.Const (Const.Byte x1, _, ty), Expr.Const (Const.Byte x2, _, _) -> Expr.Const (Const.Byte (opUInt8 x1 x2), m, ty) + | Expr.Const (Const.UInt16 x1, _, ty), Expr.Const (Const.UInt16 x2, _, _) -> Expr.Const (Const.UInt16 (opUInt16 x1 x2), m, ty) + | Expr.Const (Const.UInt32 x1, _, ty), Expr.Const (Const.UInt32 x2, _, _) -> Expr.Const (Const.UInt32 (opUInt32 x1 x2), m, ty) + | Expr.Const (Const.UInt64 x1, _, ty), Expr.Const (Const.UInt64 x2, _, _) -> Expr.Const (Const.UInt64 (opUInt64 x1 x2), m, ty) | _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m)) with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m)) @@ -8517,7 +8517,7 @@ let rec EvalAttribArgExpr g x = match x with // Detect standard constants - | Expr.Const(c, m, _) -> + | Expr.Const (c, m, _) -> match c with | Const.Bool _ | Const.Int32 _ @@ -8552,7 +8552,7 @@ let rec EvalAttribArgExpr g x = // At compile-time we check arithmetic let v1, v2 = EvalAttribArgExpr g arg1, EvalAttribArgExpr g arg2 match v1, v2 with - | Expr.Const(Const.String x1, m, ty), Expr.Const(Const.String x2, _, _) -> Expr.Const(Const.String (x1 + x2), m, ty) + | Expr.Const (Const.String x1, m, ty), Expr.Const (Const.String x2, _, _) -> Expr.Const (Const.String (x1 + x2), m, ty) | _ -> #if ALLOW_ARITHMETIC_OPS_IN_LITERAL_EXPRESSIONS_AND_ATTRIBUTE_ARGS EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) g v1 v2 @@ -8573,7 +8573,7 @@ let rec EvalAttribArgExpr g x = and EvaledAttribExprEquality g e1 e2 = match e1, e2 with - | Expr.Const(c1, _, _), Expr.Const(c2, _, _) -> c1 = c2 + | Expr.Const (c1, _, _), Expr.Const (c2, _, _) -> c1 = c2 | TypeOfExpr g ty1, TypeOfExpr g ty2 -> typeEquiv g ty1 ty2 | TypeDefOfExpr g ty1, TypeDefOfExpr g ty2 -> typeEquiv g ty1 ty2 | _ -> false @@ -8657,7 +8657,7 @@ let rec mkCompiledTuple g isStruct (argtys, args, m) = | _ -> let a, b, c, d = mkCompiledTuple g isStruct (argtysB, argsB, m) let ty8plus = TType_app(a, b) - let v8plus = Expr.Op (TOp.Tuple(mkTupInfo isStruct), b, c, d) + let v8plus = Expr.Op (TOp.Tuple (mkTupInfo isStruct), b, c, d) ty8plus, v8plus let argtysAB = argtysA @ [ty8] (mkCompiledTupleTyconRef g isStruct (List.length argtysAB), argtysAB, argsA @ [v8], m) @@ -8670,48 +8670,48 @@ let mkILFieldSpecForTupleItem (ty: ILType) n = let mkGetTupleItemN g m n (ty: ILType) isStruct te retty = if isStruct then - mkAsmExpr([mkNormalLdfld (mkILFieldSpecForTupleItem ty n) ], [], [te], [retty], m) + mkAsmExpr ([mkNormalLdfld (mkILFieldSpecForTupleItem ty n) ], [], [te], [retty], m) else - mkAsmExpr([IL.mkNormalCall(mkILMethodSpecForTupleItem g ty n)], [], [te], [retty], m) + mkAsmExpr ([IL.mkNormalCall(mkILMethodSpecForTupleItem g ty n)], [], [te], [retty], m) /// Match an Int32 constant expression let (|Int32Expr|_|) expr = match expr with - | Expr.Const(Const.Int32 n, _, _) -> Some n + | Expr.Const (Const.Int32 n, _, _) -> Some n | _ -> None /// Match a try-finally expression let (|TryFinally|_|) expr = match expr with - | Expr.Op (TOp.TryFinally _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)], _) -> Some(e1, e2) + | Expr.Op (TOp.TryFinally _, [_resty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)], _) -> Some(e1, e2) | _ -> None // detect ONLY the while loops that result from compiling 'for ... in ... do ...' let (|WhileLoopForCompiledForEachExpr|_|) expr = match expr with - | Expr.Op (TOp.While (_, WhileLoopForCompiledForEachExprMarker), _, [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)], m) -> Some(e1, e2, m) + | Expr.Op (TOp.While (_, WhileLoopForCompiledForEachExprMarker), _, [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)], m) -> Some(e1, e2, m) | _ -> None let (|Let|_|) expr = match expr with - | Expr.Let(TBind(v, e1, sp), e2, _, _) -> Some(v, e1, sp, e2) + | Expr.Let (TBind(v, e1, sp), e2, _, _) -> Some(v, e1, sp, e2) | _ -> None let (|RangeInt32Step|_|) g expr = match expr with // detect 'n .. m' - | Expr.App(Expr.Val(vf, _, _), _, [tyarg], [startExpr;finishExpr], _) + | Expr.App (Expr.Val (vf, _, _), _, [tyarg], [startExpr;finishExpr], _) when valRefEq g vf g.range_op_vref && typeEquiv g tyarg g.int_ty -> Some(startExpr, 1, finishExpr) // detect (RangeInt32 startExpr N finishExpr), the inlined/compiled form of 'n .. m' and 'n .. N .. m' - | Expr.App(Expr.Val(vf, _, _), _, [], [startExpr; Int32Expr n; finishExpr], _) + | Expr.App (Expr.Val (vf, _, _), _, [], [startExpr; Int32Expr n; finishExpr], _) when valRefEq g vf g.range_int32_op_vref -> Some(startExpr, n, finishExpr) | _ -> None let (|GetEnumeratorCall|_|) expr = match expr with - | Expr.Op (TOp.ILCall( _, _, _, _, _, _, _, iLMethodRef, _, _, _), _, [Expr.Val(vref, _, _) | Expr.Op(_, _, [Expr.Val(vref, ValUseFlag.NormalValUse, _)], _) ], _) -> - if iLMethodRef.Name = "GetEnumerator" then Some(vref) + | Expr.Op (TOp.ILCall ( _, _, _, _, _, _, _, iLMethodRef, _, _, _), _, [Expr.Val (vref, _, _) | Expr.Op (_, _, [Expr.Val (vref, ValUseFlag.NormalValUse, _)], _) ], _) -> + if iLMethodRef.Name = "GetEnumerator" then Some vref else None | _ -> None @@ -8733,8 +8733,8 @@ let (|CompiledForEachExpr|_|) g expr = let mBody = bodyExpr.Range let mWholeExpr = expr.Range - let spForLoop, mForLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart), spStart | _ -> NoSequencePointAtForLoop, mEnumExpr - let spWhileLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtWhileLoop(spStart)| _ -> NoSequencePointAtWhileLoop + let spForLoop, mForLoop = match enumeratorBind with SequencePointAtBinding spStart -> SequencePointAtForLoop spStart, spStart | _ -> NoSequencePointAtForLoop, mEnumExpr + let spWhileLoop = match enumeratorBind with SequencePointAtBinding spStart -> SequencePointAtWhileLoop spStart| _ -> NoSequencePointAtWhileLoop let enumerableTy = tyOfExpr g enumerableExpr Some (enumerableTy, enumerableExpr, elemVar, bodyExpr, (mEnumExpr, mBody, spForLoop, mForLoop, spWhileLoop, mWholeExpr)) @@ -8815,7 +8815,7 @@ let DetectAndOptimizeForExpression g option expr = let expr = // let mutable current = enumerableExpr - let spBind = (match spForLoop with SequencePointAtForLoop(spStart) -> SequencePointAtBinding(spStart) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding) + let spBind = (match spForLoop with SequencePointAtForLoop spStart -> SequencePointAtBinding spStart | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding) mkLet spBind mEnumExpr currentVar enumerableExpr // let mutable next = current.TailOrNull (mkCompGenLet mForLoop nextVar tailOrNullExpr diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index d1b44c792..ceb22d992 100755 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -47,7 +47,7 @@ type PickledDataWithReferences<'rawData> = x.FixupThunks |> Array.iter(fun reqd-> match loader reqd.AssemblyName with - | Some(loaded) -> reqd.Fixup(loaded) + | Some loaded -> reqd.Fixup loaded | None -> reqd.FixupOrphaned() ) x.RawData @@ -68,7 +68,7 @@ type Table<'T> = let n = tbl.count tbl.count <- tbl.count + 1 tbl.tbl.[x] <- n - tbl.rows.Add(x) + tbl.rows.Add x n member tbl.FindOrAdd x = let mutable res = Unchecked.defaultof<_> @@ -199,13 +199,13 @@ let p_used_space1 f st = let p_bytes (s: byte[]) st = let len = s.Length - p_int32 (len) st + p_int32 len st st.os.EmitBytes s let p_prim_string (s: string) st = let bytes = Encoding.UTF8.GetBytes s let len = bytes.Length - p_int32 (len) st + p_int32 len st st.os.EmitBytes bytes let p_int c st = p_int32 c st @@ -220,8 +220,8 @@ let p_int64 (i: int64) st = let p_uint64 (x: uint64) st = p_int64 (int64 x) st -let bits_of_float32 (x: float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x), 0) -let bits_of_float (x: float) = System.BitConverter.DoubleToInt64Bits(x) +let bits_of_float32 (x: float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes x, 0) +let bits_of_float (x: float) = System.BitConverter.DoubleToInt64Bits x let p_single i st = p_int32 (bits_of_float32 i) st let p_double i st = p_int64 (bits_of_float i) st @@ -304,8 +304,8 @@ let u_int64 st = b1 ||| (b2 <<< 32) let u_uint64 st = uint64 (u_int64 st) -let float32_of_bits (x: int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) -let float_of_bits (x: int64) = System.BitConverter.Int64BitsToDouble(x) +let float32_of_bits (x: int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes x, 0) +let float_of_bits (x: int64) = System.BitConverter.Int64BitsToDouble x let u_single st = float32_of_bits (u_int32 st) let u_double st = float_of_bits (u_int64 st) @@ -662,9 +662,9 @@ let u_lazy u st = lazy (let st = { st with is = st.is.CloneAndSeek idx1 } u st) /// Force the reading of the data as a "tripwire" for each of the OSGN thunks - for i = otyconsIdx1 to otyconsIdx2-1 do wire (st.ientities.Get(i)) res done - for i = ovalsIdx1 to ovalsIdx2-1 do wire (st.ivals.Get(i)) res done - for i = otyparsIdx1 to otyparsIdx2-1 do wire (st.itypars.Get(i)) res done + for i = otyconsIdx1 to otyconsIdx2-1 do wire (st.ientities.Get i) res done + for i = ovalsIdx1 to ovalsIdx2-1 do wire (st.ivals.Get i) res done + for i = otyparsIdx1 to otyparsIdx2-1 do wire (st.itypars.Get i) res done res #else ignore (len, otyconsIdx1, otyconsIdx2, otyparsIdx1, otyparsIdx2, ovalsIdx1, ovalsIdx2) @@ -720,7 +720,7 @@ let lookup_pubpath st pubpathTab x = lookup_uniq st pubpathTab x let u_encoded_pubpath = u_array u_int let u_pubpath st = lookup_uniq st st.ipubpaths (u_int st) -let encode_pubpath stringTab pubpathTab (PubPath(a)) = encode_uniq pubpathTab (Array.map (encode_string stringTab) a) +let encode_pubpath stringTab pubpathTab (PubPath a) = encode_uniq pubpathTab (Array.map (encode_string stringTab) a) let p_encoded_pubpath = p_array p_int let p_pubpath x st = p_int (encode_pubpath st.ostrings st.opubpaths x) st @@ -2141,7 +2141,7 @@ and u_entity_spec_data st : Entity = entity_attribs=x6 entity_tycon_repr=x7 entity_tycon_tcaug=x9 - entity_flags=EntityFlags(x11) + entity_flags=EntityFlags x11 entity_cpath=x12 entity_modul_contents=MaybeLazy.Lazy x13 entity_il_repr_cache=newCache() @@ -2280,7 +2280,7 @@ and u_ValData st = val_range = (match x1a with None -> range0 | Some(a, _) -> a) val_type = x2 val_stamp = newStamp() - val_flags = ValFlags(x4) + val_flags = ValFlags x4 val_opt_data = match x1z, x1a, x10, x14, x13, x15, x8, x13b, x12, x9 with | None, None, None, None, TAccess [], None, None, ParentNone, "", [] -> None @@ -2333,7 +2333,7 @@ and p_const x st = | Const.String s -> p_byte 14 st; p_string s st | Const.Unit -> p_byte 15 st | Const.Zero -> p_byte 16 st - | Const.Decimal s -> p_byte 17 st; p_array p_int32 (System.Decimal.GetBits(s)) st + | Const.Decimal s -> p_byte 17 st; p_array p_int32 (System.Decimal.GetBits s) st and u_const st = let tag = u_byte st @@ -2355,7 +2355,7 @@ and u_const st = | 14 -> u_string st |> Const.String | 15 -> Const.Unit | 16 -> Const.Zero - | 17 -> u_array u_int32 st |> (fun bits -> Const.Decimal (new System.Decimal(bits))) + | 17 -> u_array u_int32 st |> (fun bits -> Const.Decimal (System.Decimal bits)) | _ -> ufailwith st "u_const" @@ -2430,9 +2430,9 @@ and p_op x st = else p_byte 2 st | TOp.Recd (a, b) -> p_byte 3 st; p_tup2 p_recdInfo (p_tcref "recd op") (a, b) st - | TOp.ValFieldSet (a) -> p_byte 4 st; p_rfref a st - | TOp.ValFieldGet (a) -> p_byte 5 st; p_rfref a st - | TOp.UnionCaseTagGet (a) -> p_byte 6 st; p_tcref "cnstr op" a st + | TOp.ValFieldSet a -> p_byte 4 st; p_rfref a st + | TOp.ValFieldGet a -> p_byte 5 st; p_rfref a st + | TOp.UnionCaseTagGet a -> p_byte 6 st; p_tcref "cnstr op" a st | TOp.UnionCaseFieldGet (a, b) -> p_byte 7 st; p_tup2 p_ucref p_int (a, b) st | TOp.UnionCaseFieldSet (a, b) -> p_byte 8 st; p_tup2 p_ucref p_int (a, b) st | TOp.ExnFieldGet (a, b) -> p_byte 9 st; p_tup2 (p_tcref "exn op") p_int (a, b) st @@ -2444,15 +2444,15 @@ and p_op x st = p_byte 11 st; p_int a st | TOp.ILAsm (a, b) -> p_byte 12 st; p_tup2 (p_list p_ILInstr) p_tys (a, b) st | TOp.RefAddrGet _ -> p_byte 13 st - | TOp.UnionCaseProof (a) -> p_byte 14 st; p_ucref a st + | TOp.UnionCaseProof a -> p_byte 14 st; p_ucref a st | TOp.Coerce -> p_byte 15 st - | TOp.TraitCall (b) -> p_byte 16 st; p_trait b st + | TOp.TraitCall b -> p_byte 16 st; p_trait b st | TOp.LValueOp (a, b) -> p_byte 17 st; p_tup2 p_lval_op_kind (p_vref "lval") (a, b) st | TOp.ILCall (a1, a2, a3, a4, a5, a7, a8, a9, b, c, d) -> p_byte 18 st; p_tup11 p_bool p_bool p_bool p_bool p_vrefFlags p_bool p_bool p_ILMethodRef p_tys p_tys p_tys (a1, a2, a3, a4, a5, a7, a8, a9, b, c, d) st | TOp.Array -> p_byte 19 st | TOp.While _ -> p_byte 20 st - | TOp.For(_, dir) -> p_byte 21 st; p_int (match dir with FSharpForLoopUp -> 0 | CSharpForLoopUp -> 1 | FSharpForLoopDown -> 2) st + | TOp.For (_, dir) -> p_byte 21 st; p_int (match dir with FSharpForLoopUp -> 0 | CSharpForLoopUp -> 1 | FSharpForLoopDown -> 2) st | TOp.Bytes bytes -> p_byte 22 st; p_bytes bytes st | TOp.TryCatch _ -> p_byte 23 st | TOp.TryFinally _ -> p_byte 24 st @@ -2520,8 +2520,8 @@ and u_op st = | 21 -> let dir = match u_int st with 0 -> FSharpForLoopUp | 1 -> CSharpForLoopUp | 2 -> FSharpForLoopDown | _ -> failwith "unknown for loop" TOp.For (NoSequencePointAtForLoop, dir) | 22 -> TOp.Bytes (u_bytes st) - | 23 -> TOp.TryCatch(NoSequencePointAtTry, NoSequencePointAtWith) - | 24 -> TOp.TryFinally(NoSequencePointAtTry, NoSequencePointAtFinally) + | 23 -> TOp.TryCatch (NoSequencePointAtTry, NoSequencePointAtWith) + | 24 -> TOp.TryFinally (NoSequencePointAtTry, NoSequencePointAtFinally) | 25 -> let a = u_rfref st TOp.ValFieldGetAddr (a, false) | 26 -> TOp.UInt16s (u_array u_uint16 st) @@ -2533,7 +2533,7 @@ and u_op st = | 30 -> let a = u_int st TOp.TupleFieldGet (tupInfoStruct, a) | 31 -> let info = u_anonInfo st - TOp.AnonRecd (info) + TOp.AnonRecd info | 32 -> let info = u_anonInfo st let n = u_int st TOp.AnonRecdGet (info, n) @@ -2544,7 +2544,7 @@ and p_expr expr st = | Expr.Link e -> p_expr !e st | Expr.Const (x, m, ty) -> p_byte 0 st; p_tup3 p_const p_dummy_range p_ty (x, m, ty) st | Expr.Val (a, b, m) -> p_byte 1 st; p_tup3 (p_vref "val") p_vrefFlags p_dummy_range (a, b, m) st - | Expr.Op(a, b, c, d) -> p_byte 2 st; p_tup4 p_op p_tys p_Exprs p_dummy_range (a, b, c, d) st + | Expr.Op (a, b, c, d) -> p_byte 2 st; p_tup4 p_op p_tys p_Exprs p_dummy_range (a, b, c, d) st | Expr.Sequential (a, b, c, _, d) -> p_byte 3 st; p_tup4 p_expr p_expr p_int p_dummy_range (a, b, (match c with NormalSeq -> 0 | ThenDoSeq -> 1), d) st | Expr.Lambda (_, a1, b0, b1, c, d, e) -> p_byte 4 st; p_tup6 (p_option p_Val) (p_option p_Val) p_Vals p_expr p_dummy_range p_ty (a1, b0, b1, c, d, e) st | Expr.TyLambda (_, b, c, d, e) -> p_byte 5 st; p_tup4 p_tyar_specs p_expr p_dummy_range p_ty (b, c, d, e) st @@ -2552,10 +2552,10 @@ and p_expr expr st = | Expr.LetRec (a, b, c, _) -> p_byte 7 st; p_tup3 p_binds p_expr p_dummy_range (a, b, c) st | Expr.Let (a, b, c, _) -> p_byte 8 st; p_tup3 p_bind p_expr p_dummy_range (a, b, c) st | Expr.Match (_, a, b, c, d, e) -> p_byte 9 st; p_tup5 p_dummy_range p_dtree p_targets p_dummy_range p_ty (a, b, c, d, e) st - | Expr.Obj(_, b, c, d, e, f, g) -> p_byte 10 st; p_tup6 p_ty (p_option p_Val) p_expr p_methods p_intfs p_dummy_range (b, c, d, e, f, g) st - | Expr.StaticOptimization(a, b, c, d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a, b, c, d) st + | Expr.Obj (_, b, c, d, e, f, g) -> p_byte 10 st; p_tup6 p_ty (p_option p_Val) p_expr p_methods p_intfs p_dummy_range (b, c, d, e, f, g) st + | Expr.StaticOptimization (a, b, c, d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a, b, c, d) st | Expr.TyChoose (a, b, c) -> p_byte 12 st; p_tup3 p_tyar_specs p_expr p_dummy_range (a, b, c) st - | Expr.Quote(ast, _, _, m, ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_ty (ast, m, ty) st + | Expr.Quote (ast, _, _, m, ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_ty (ast, m, ty) st and u_expr st = let tag = u_byte st @@ -2635,7 +2635,7 @@ and u_expr st = and p_static_optimization_constraint x st = match x with | TTyconEqualsTycon (a, b) -> p_byte 0 st; p_tup2 p_ty p_ty (a, b) st - | TTyconIsStruct(a) -> p_byte 1 st; p_ty a st + | TTyconIsStruct a -> p_byte 1 st; p_ty a st and p_slotparam (TSlotParam (a, b, c, d, e, f)) st = p_tup6 (p_option p_string) p_ty p_bool p_bool p_bool p_attribs (a, b, c, d, e, f) st and p_slotsig (TSlotSig (a, b, c, d, e, f)) st = p_tup6 p_string p_ty p_tyar_specs p_tyar_specs (p_list (p_list p_slotparam)) (p_option p_ty) (a, b, c, d, e, f) st diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 1ec99001b..c4aabf6eb 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -625,7 +625,7 @@ let TryStripPrefixPath (g: TcGlobals) (enclosingNamespacePath: Ident list) = | p::rest when g.isInteractive && not (isNil rest) && - p.idText.StartsWithOrdinal(FsiDynamicModulePrefix) && + p.idText.StartsWithOrdinal FsiDynamicModulePrefix && p.idText.[FsiDynamicModulePrefix.Length..] |> String.forall System.Char.IsDigit -> Some(p, rest) | _ -> None @@ -780,9 +780,9 @@ let UnifyFunctionType extraInfo cenv denv mFunExpr ty = let ReportImplicitlyIgnoredBoolExpression denv m ty expr = let checkExpr m expr = match expr with - | Expr.App(Expr.Val(vf, _, _), _, _, exprs, _) when vf.LogicalName = opNameEquals -> + | Expr.App (Expr.Val (vf, _, _), _, _, exprs, _) when vf.LogicalName = opNameEquals -> match exprs with - | Expr.App(Expr.Val(propRef, _, _), _, _, Expr.Val(vf, _, _) :: _, _) :: _ -> + | Expr.App (Expr.Val (propRef, _, _), _, _, Expr.Val (vf, _, _) :: _, _) :: _ -> if propRef.IsPropertyGetterMethod then let propertyName = propRef.PropertyName let hasCorrespondingSetter = @@ -798,19 +798,19 @@ let ReportImplicitlyIgnoredBoolExpression denv m ty expr = UnitTypeExpectedWithEquality (denv, ty, m) else UnitTypeExpectedWithEquality (denv, ty, m) - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methodRef, _, _, _), _, Expr.Val(vf, _, _) :: _, _) :: _ when methodRef.Name.StartsWithOrdinal("get_") -> + | Expr.Op (TOp.ILCall (_, _, _, _, _, _, _, methodRef, _, _, _), _, Expr.Val (vf, _, _) :: _, _) :: _ when methodRef.Name.StartsWithOrdinal("get_") -> UnitTypeExpectedWithPossiblePropertySetter (denv, ty, vf.DisplayName, PrettyNaming.ChopPropertyName(methodRef.Name), m) - | Expr.Val(vf, _, _) :: _ -> + | Expr.Val (vf, _, _) :: _ -> UnitTypeExpectedWithPossibleAssignment (denv, ty, vf.IsMutable, vf.DisplayName, m) | _ -> UnitTypeExpectedWithEquality (denv, ty, m) | _ -> UnitTypeExpected (denv, ty, m) match expr with - | Expr.Let(_, Expr.Sequential(_, inner, _, _, _), _, _) - | Expr.Sequential(_, inner, _, _, _) -> + | Expr.Let (_, Expr.Sequential (_, inner, _, _, _), _, _) + | Expr.Sequential (_, inner, _, _, _) -> let rec extractNext expr = match expr with - | Expr.Sequential(_, inner, _, _, _) -> extractNext inner + | Expr.Sequential (_, inner, _, _, _) -> extractNext inner | _ -> checkExpr expr.Range expr extractNext inner | expr -> checkExpr m expr @@ -1054,12 +1054,12 @@ let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, optIm let name = DecompileOpName id.idText // Check symbolic members. Expect valSynData implied arity to be [[2]]. match SynInfo.AritiesOfArgs valSynData with - | [] | [0] -> warning(Error(FSComp.SR.memberOperatorDefinitionWithNoArguments(name), m)) + | [] | [0] -> warning(Error(FSComp.SR.memberOperatorDefinitionWithNoArguments name, m)) | n :: otherArgs -> let opTakesThreeArgs = PrettyNaming.IsTernaryOperator name if n<>2 && not opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonPairArgument(name, n), m)) if n<>3 && opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonTripleArgument(name, n), m)) - if not (isNil otherArgs) then warning(Error(FSComp.SR.memberOperatorDefinitionWithCurriedArguments(name), m)) + if not (isNil otherArgs) then warning(Error(FSComp.SR.memberOperatorDefinitionWithCurriedArguments name, m)) if isExtrinsic && IsMangledOpName id.idText then warning(Error(FSComp.SR.tcMemberOperatorDefinitionInExtrinsic(), id.idRange)) @@ -1546,7 +1546,7 @@ let MakeAndPublishVals cenv env (altActualParent, inSig, declKind, vrec, valSche 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, false, ValInline.Never, BaseVal, None, false, false, false, false) MakeAndPublishVal cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valscheme, [], XmlDoc.Empty, None, false)) let InstanceMembersNeedSafeInitCheck cenv m thisTy = @@ -1609,8 +1609,8 @@ let AdjustAndForgetUsesOfRecValue cenv (vrefTgt: ValRef) (valScheme: ValScheme) let fixedUpExpr = let vrefFlags, tyargs0 = match fixupPoint.Value with - | Expr.App(Expr.Val (_, vrefFlags, _), _, tyargs0, [], _) -> vrefFlags, tyargs0 - | Expr.Val(_, vrefFlags, _) -> vrefFlags, [] + | Expr.App (Expr.Val (_, vrefFlags, _), _, tyargs0, [], _) -> vrefFlags, tyargs0 + | Expr.Val (_, vrefFlags, _) -> vrefFlags, [] | _ -> errorR(Error(FSComp.SR.tcUnexpectedExprAtRecInfPoint(), m)) NormalValUse, [] @@ -1638,7 +1638,7 @@ let RecordUseOfRecValue cenv vrec (vrefTgt: ValRef) vexp m = | ValInRecScope isComplete -> let fixupPoint = ref vexp cenv.recUses <- cenv.recUses.Add (vrefTgt.Deref, (fixupPoint, m, isComplete)) - Expr.Link (fixupPoint) + Expr.Link fixupPoint | ValNotInRecScope -> vexp @@ -1727,7 +1727,7 @@ let GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars types = let DontGeneralizeVals types = let dontGeneralizeVal (PrelimValScheme1(id, _, ty, partialValReprInfoOpt, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen)) = - PrelimValScheme2(id, NonGenericTypeScheme(ty), partialValReprInfoOpt, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen, false) + PrelimValScheme2(id, NonGenericTypeScheme ty, partialValReprInfoOpt, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen, false) NameMap.map dontGeneralizeVal types let InferGenericArityFromTyScheme (TypeScheme(generalizedTypars, _)) partialValReprInfo = @@ -1786,7 +1786,7 @@ let CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme = // Don't use any expression information for members, where syntax dictates the arity completely | _ when memberInfoOpt.IsSome -> partialValReprInfoOpt - | Some(partialValReprInfoFromSyntax), true -> + | Some partialValReprInfoFromSyntax, true -> let (PartialValReprInfo(curriedArgInfosFromSyntax, retInfoFromSyntax)) = partialValReprInfoFromSyntax let partialArityInfo = if isMutable then @@ -1815,7 +1815,7 @@ let CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme = let curriedArgInfos = loop curriedArgInfosFromSyntax curriedArgInfosFromExpression PartialValReprInfo (curriedArgInfos, retInfoFromSyntax) - Some(partialArityInfo) + Some partialArityInfo let BuildValScheme declKind partialArityInfoOpt prelimScheme = let (PrelimValScheme2(id, typeScheme, _, memberInfoOpt, isMutable, inlineFlag, baseOrThis, _, vis, compgen, hasDeclaredTypars)) = prelimScheme @@ -1883,7 +1883,7 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = let mergedNameEnv, mergedRange = ((env.NameEnv, m1), nameResolutions) ||> Seq.fold (fun (nenv, merged) (_, item, _, _, _, _, _, _, m, _) -> // MakeAndPublishVal creates only Item.Value - let item = match item with Item.Value(item) -> item | _ -> failwith "impossible" + let item = match item with Item.Value item -> item | _ -> failwith "impossible" (AddFakeNamedValRefToNameEnv item.DisplayName nenv item), (unionRanges m merged) ) // send notification about mergedNameEnv @@ -2105,7 +2105,7 @@ module GeneralizationHelpers = let ftps = item.GetFreeTyvars().FreeTypars if not ftps.IsEmpty then for ftp in ftps do - acc.Add(ftp) + acc.Add ftp Zset.Create(typarOrder, acc) @@ -2138,42 +2138,42 @@ module GeneralizationHelpers = | Expr.Val (vref, _, m) -> not (isByrefLikeTy g m vref.Type) // Look through coercion nodes corresponding to introduction of subsumption - | Expr.Op(TOp.Coerce, [inputTy;actualTy], [e1], _) when isFunTy g actualTy && isFunTy g inputTy -> + | Expr.Op (TOp.Coerce, [inputTy;actualTy], [e1], _) when isFunTy g actualTy && isFunTy g inputTy -> IsGeneralizableValue g e1 - | Expr.Op(op, _, args, _) -> + | Expr.Op (op, _, args, _) -> let canGeneralizeOp = match op with | TOp.Tuple _ -> true | TOp.UnionCase uc -> not (isUnionCaseRefDefinitelyMutable uc) - | TOp.Recd(ctorInfo, tcref) -> + | TOp.Recd (ctorInfo, tcref) -> match ctorInfo with | RecdExpr -> not (isRecdOrUnionOrStructTyconRefDefinitelyMutable tcref) | RecdExprIsObjInit -> false | TOp.Array -> isNil args | TOp.ExnConstr ec -> not (isExnDefinitelyMutable ec) - | TOp.ILAsm([], _) -> true + | TOp.ILAsm ([], _) -> true | _ -> false canGeneralizeOp && List.forall (IsGeneralizableValue g) args - | Expr.LetRec(binds, body, _, _) -> + | Expr.LetRec (binds, body, _, _) -> binds |> List.forall (fun b -> not b.Var.IsMutable) && binds |> List.forall (fun b -> IsGeneralizableValue g b.Expr) && IsGeneralizableValue g body - | Expr.Let(bind, body, _, _) -> + | Expr.Let (bind, body, _, _) -> not bind.Var.IsMutable && IsGeneralizableValue g bind.Expr && IsGeneralizableValue g body // Applications of type functions are _not_ normally generalizable unless explicitly marked so - | Expr.App(Expr.Val (vref, _, _), _, _, [], _) when vref.IsTypeFunction -> + | Expr.App (Expr.Val (vref, _, _), _, _, [], _) when vref.IsTypeFunction -> HasFSharpAttribute g g.attrib_GeneralizableValueAttribute vref.Attribs - | Expr.App(e1, _, _, [], _) -> IsGeneralizableValue g e1 - | Expr.TyChoose(_, b, _) -> IsGeneralizableValue g b + | Expr.App (e1, _, _, [], _) -> IsGeneralizableValue g e1 + | Expr.TyChoose (_, b, _) -> IsGeneralizableValue g b | Expr.Obj (_, ty, _, _, _, _, _) -> isInterfaceTy g ty || isDelegateTy g ty | Expr.Link eref -> IsGeneralizableValue g !eref @@ -2600,7 +2600,7 @@ module EventDeclarationNormalization = match argInfos with | [[thisArgInfo];[]] -> [[thisArgInfo];SynInfo.unnamedTopArg] // instance property getter | [[]] -> [SynInfo.unnamedTopArg] // static property getter - | _ -> error(BadEventTransformation(m)) + | _ -> error(BadEventTransformation m) // reconstitute valSynInfo SynValInfo(argInfos, retInfo) @@ -2611,7 +2611,7 @@ module EventDeclarationNormalization = let private ConvertMemberFlagsOpt m memberFlagsOpt = match memberFlagsOpt with | Some memberFlags -> Some (ConvertMemberFlags memberFlags) - | _ -> error(BadEventTransformation(m)) + | _ -> error(BadEventTransformation m) let private ConvertSynData m valSynData = let (SynValData(memberFlagsOpt, valSynInfo, thisIdOpt)) = valSynData @@ -2646,7 +2646,7 @@ module EventDeclarationNormalization = match rhsExpr with // Detect 'fun () -> e' which results from the compilation of a property getter | SynExpr.Lambda (_, _, SynSimplePats.SimplePats([], _), trueRhsExpr, m) -> - let rhsExpr = mkSynApp1 (SynExpr.DotGet(SynExpr.Paren(trueRhsExpr, range0, None, m), range0, LongIdentWithDots([ident(target, m)], []), m)) (SynExpr.Ident(ident(argName, m))) m + let rhsExpr = mkSynApp1 (SynExpr.DotGet (SynExpr.Paren (trueRhsExpr, range0, None, m), range0, LongIdentWithDots([ident(target, m)], []), m)) (SynExpr.Ident (ident(argName, m))) m // reconstitute rhsExpr let bindingRhs = NormalizedBindingRhs([], None, rhsExpr) @@ -2656,7 +2656,7 @@ module EventDeclarationNormalization = bindingRhs, valSynData | _ -> - error(BadEventTransformation(m)) + error(BadEventTransformation m) // reconstitute the binding NormalizedBinding(vis1, bindingKind, isInline, isMutable, [], bindingXmlDoc, noInferredTypars, valSynData, declPattern, bindingRhs, mBinding, spBind) @@ -2765,7 +2765,7 @@ let TcVal checkAttributes cenv env tpenv (vref: ValRef) optInst optAfterResoluti // [] // let Null = null let tpsorig, _, tinst, tau = FreshenPossibleForallTy cenv.g m TyparRigidity.Flexible vty - tpsorig, Expr.Const(c, m, tau), isSpecial, tau, tinst, tpenv + tpsorig, Expr.Const (c, m, tau), isSpecial, tau, tinst, tpenv | None -> // References to 'this' in classes get dereferenced from their implicit reference cell and poked @@ -2855,7 +2855,7 @@ let LightweightTcValForUsingInBuildMethodCall g (vref: ValRef) vrefFlags (vrefTy match v.LiteralValue with | Some c -> let _, _, _, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vty - Expr.Const(c, m, tau), tau + Expr.Const (c, m, tau), tau | None -> // Instantiate the value let tau = @@ -2893,12 +2893,12 @@ type ApplicableExpr = let (ApplicableExpr (cenv, fe, first)) = x let combinedExpr = match fe with - | Expr.App(e1, e1ty, tyargs1, args1, e1m) when + | Expr.App (e1, e1ty, tyargs1, args1, e1m) when (not first || isNil args1) && (not (isForallTy cenv.g e1ty) || isFunTy cenv.g (applyTys cenv.g e1ty (tyargs1, args1))) -> - Expr.App(e1, e1ty, tyargs1, args1@[e2], unionRanges e1m m) + Expr.App (e1, e1ty, tyargs1, args1@[e2], unionRanges e1m m) | _ -> - Expr.App(fe, tyOfExpr cenv.g fe, [], [e2], m) + Expr.App (fe, tyOfExpr cenv.g fe, [], [e2], m) ApplicableExpr(cenv, combinedExpr, false) member x.Expr = @@ -2972,7 +2972,7 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = let TcRuntimeTypeTest isCast isOperator cenv denv m tgtTy srcTy = let g = cenv.g if TypeDefinitelySubsumesTypeNoCoercion 0 g cenv.amap m tgtTy srcTy then - warning(TypeTestUnnecessary(m)) + warning(TypeTestUnnecessary m) if isTyparTy g srcTy && not (destTyparTy g srcTy).IsCompatFlex then error(IndeterminateRuntimeCoercion(denv, srcTy, tgtTy, m)) @@ -3002,13 +3002,13 @@ let TcStaticUpcast cenv denv m tgtTy srcTy = if isTyparTy cenv.g tgtTy then if not (destTyparTy cenv.g tgtTy).IsCompatFlex then error(IndeterminateStaticCoercion(denv, srcTy, tgtTy, m)) - //else warning(UpcastUnnecessary(m)) + //else warning(UpcastUnnecessary m) if isSealedTy cenv.g tgtTy && not (isTyparTy cenv.g tgtTy) then warning(CoercionTargetSealed(denv, tgtTy, m)) if typeEquiv cenv.g srcTy tgtTy then - warning(UpcastUnnecessary(m)) + warning(UpcastUnnecessary m) AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css m NoTrace tgtTy srcTy @@ -3043,7 +3043,7 @@ let BuildPossiblyConditionalMethodCall cenv env isMutable m isProp minfo valUseF let TryFindIntrinsicOrExtensionMethInfo (cenv: cenv) (env: TcEnv) m ad nm ty = - AllMethInfosOfTypeInScope cenv.infoReader env.NameEnv (Some(nm), ad) IgnoreOverrides m ty + AllMethInfosOfTypeInScope cenv.infoReader env.NameEnv (Some nm, ad) IgnoreOverrides m ty /// Build the 'test and dispose' part of a 'use' statement let BuildDisposableCleanup cenv env m (v: Val) = @@ -3097,7 +3097,7 @@ let BuildILFieldGet g amap m objExpr (finfo: ILFieldInfo) = | None -> error (Error(FSComp.SR.tcTPFieldMustBeLiteral(), m)) | Some lit -> - Expr.Const(TcFieldInit m lit, m, fieldType) + Expr.Const (TcFieldInit m lit, m, fieldType) | _ -> #endif let wrap, objExpr, _readonly, _writeonly = mkExprAddrOfExpr g isValueType false NeverMutates objExpr None m @@ -3146,7 +3146,7 @@ let BuildRecdFieldSet g m objExpr (rfinfo: RecdFieldInfo) argExpr = let (|BinOpExpr|_|) e = match e with - | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent opId, a, _), b, _) -> Some (opId, a, b) + | SynExpr.App (_, _, SynExpr.App (_, _, SingleIdent opId, a, _), b, _) -> Some (opId, a, b) | _ -> None let (|SimpleEqualsExpr|_|) e = @@ -3171,12 +3171,12 @@ let (|JoinRelation|_|) cenv env (e: SynExpr) = | BinOpExpr(opId, a, b) when isOpName opNameEqualsNullable cenv.g.equals_nullable_operator_vref opId.idText -> - let a = SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet a.Range [MangledGlobalName;"System"] "Nullable", a, a.Range) + let a = SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet a.Range [MangledGlobalName;"System"] "Nullable", a, a.Range) Some (a, b) | BinOpExpr(opId, a, b) when isOpName opNameNullableEquals cenv.g.nullable_equals_operator_vref opId.idText -> - let b = SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet b.Range [MangledGlobalName;"System"] "Nullable", b, b.Range) + let b = SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet b.Range [MangledGlobalName;"System"] "Nullable", b, b.Range) Some (a, b) | BinOpExpr(opId, a, b) when isOpName opNameNullableEqualsNullable cenv.g.nullable_equals_nullable_operator_vref opId.idText -> @@ -3256,7 +3256,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let err k ty = let txt = NicePrint.minimalStringOfType env.DisplayEnv ty - let msg = if k then FSComp.SR.tcTypeCannotBeEnumerated(txt) else FSComp.SR.tcEnumTypeCannotBeEnumerated(txt) + let msg = if k then FSComp.SR.tcTypeCannotBeEnumerated txt else FSComp.SR.tcEnumTypeCannotBeEnumerated txt Exception(Error(msg, m)) let findMethInfo k m nm ty = @@ -3387,7 +3387,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr match tryType (mkCoerceExpr(expr, ty, expr.Range, exprty), ty) with | Result res -> Some res | Exception e -> - PreserveStackTrace(e) + PreserveStackTrace e raise e else None @@ -3402,7 +3402,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr match probe ienumerable with | Some res -> res | None -> - PreserveStackTrace(e) + PreserveStackTrace e raise e @@ -3479,7 +3479,7 @@ let compileSeqExprMatchClauses cenv env inputExprMark (pat: Pattern, vspecs) inn let elimFastIntegerForLoop (spBind, id, start, dir, finish, innerExpr, m) = let pseudoEnumExpr = if dir then mkSynInfix m start ".." finish - else mkSynTrifix m ".. .." start (SynExpr.Const(SynConst.Int32 -1, start.Range)) finish + else mkSynTrifix m ".. .." start (SynExpr.Const (SynConst.Int32 -1, start.Range)) finish SynExpr.ForEach (spBind, SeqExprOnly false, true, mkSynPatVar None id, pseudoEnumExpr, innerExpr, m) let (|ExprAsPat|_|) (f: SynExpr) = @@ -3539,7 +3539,7 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c = let rec GetSimpleSemicolonSequenceOfComprehension expr acc = match expr with - | SynExpr.Sequential(_, true, e1, e2, _) -> + | SynExpr.Sequential (_, true, e1, e2, _) -> if IsSimpleSemicolonSequenceElement e1 then GetSimpleSemicolonSequenceOfComprehension e2 (e1::acc) else @@ -3722,7 +3722,7 @@ let EliminateInitializationGraphs let rec stripChooseAndExpr e = match stripExpr e with - | Expr.TyChoose(_, b, _) -> stripChooseAndExpr b + | Expr.TyChoose (_, b, _) -> stripChooseAndExpr b | e -> e let availIfInOrder = ValHash<_>.Create() @@ -3769,7 +3769,7 @@ let EliminateInitializationGraphs | Expr.Val (v, _, m) -> CheckValRef st v m // Expressions where subparts may be fixable - | Expr.Op((TOp.Tuple _ | TOp.UnionCase _ | TOp.Recd _), _, args, _) -> + | Expr.Op ((TOp.Tuple _ | TOp.UnionCase _ | TOp.Recd _), _, args, _) -> List.iter (CheckExpr (fixable st)) args // Composite expressions @@ -3783,7 +3783,7 @@ let EliminateInitializationGraphs | Expr.Match (_, _, pt, targets, _, _) -> CheckDecisionTree (strict st) pt Array.iter (CheckDecisionTreeTarget (strict st)) targets - | Expr.App(e1, _, _, args, _) -> + | Expr.App (e1, _, _, args, _) -> CheckExpr (strict st) e1 List.iter (CheckExpr (strict st)) args // Binary expressions @@ -3791,9 +3791,9 @@ let EliminateInitializationGraphs | Expr.StaticOptimization (_, e1, e2, _) -> CheckExpr (strict st) e1; CheckExpr (strict st) e2 // n-ary expressions - | Expr.Op(op, _, args, m) -> CheckExprOp st op m; List.iter (CheckExpr (strict st)) args + | Expr.Op (op, _, args, m) -> CheckExprOp st op m; List.iter (CheckExpr (strict st)) args // misc - | Expr.Link(eref) -> CheckExpr st !eref + | Expr.Link eref -> CheckExpr st !eref | Expr.TyChoose (_, b, _) -> CheckExpr st b | Expr.Quote _ -> () @@ -3859,7 +3859,7 @@ let EliminateInitializationGraphs if requiresLazyBindings then let morphBinding (pgrbind: PreInitializationGraphEliminationBinding) = - let (RecursiveUseFixupPoints(fixupPoints)) = pgrbind.FixupPoints + let (RecursiveUseFixupPoints fixupPoints) = pgrbind.FixupPoints let (TBind(v, e, seqPtOpt)) = pgrbind.Binding match stripChooseAndExpr e with | Expr.Lambda _ | Expr.TyLambda _ -> @@ -3920,7 +3920,7 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr: Expr) = let ty = tyOfExpr g recdExpr let thisExpr = mkGetArg0 m ty let setExpr = mkRefCellSet g m ty (exprForValRef m (mkLocalValRef safeInitVal)) thisExpr - Expr.Sequential(recdExpr, setExpr, ThenDoSeq, SuppressSequencePointOnExprOfSequential, m) + Expr.Sequential (recdExpr, setExpr, ThenDoSeq, SuppressSequencePointOnExprOfSequential, m) let recdExpr = match ctorInfo.safeInitInfo with | NoSafeInitInfo -> recdExpr @@ -3929,7 +3929,7 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr: Expr) = let thisExpr = mkGetArg0 m thisTy let thisTyInst = argsOfAppTy g thisTy let setExpr = mkRecdFieldSetViaExprAddr (thisExpr, rfref, thisTyInst, mkOne g m, m) - Expr.Sequential(recdExpr, setExpr, ThenDoSeq, SuppressSequencePointOnExprOfSequential, m) + Expr.Sequential (recdExpr, setExpr, ThenDoSeq, SuppressSequencePointOnExprOfSequential, m) recdExpr @@ -3937,32 +3937,32 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr: Expr) = match expr with // = { fields } // The constructor ends in an object initialization expression - good - | Expr.Op(TOp.Recd(RecdExprIsObjInit, _), _, _, _) -> rewriteConstruction expr + | Expr.Op (TOp.Recd (RecdExprIsObjInit, _), _, _, _) -> rewriteConstruction expr // = "a; " - | Expr.Sequential(a, body, NormalSeq, spSeq, b) -> Expr.Sequential(a, checkAndRewrite body, NormalSeq, spSeq, b) + | Expr.Sequential (a, body, NormalSeq, spSeq, b) -> Expr.Sequential (a, checkAndRewrite body, NormalSeq, spSeq, b) // = " then " - | Expr.Sequential(body, a, ThenDoSeq, spSeq, b) -> Expr.Sequential(checkAndRewrite body, a, ThenDoSeq, spSeq, b) + | Expr.Sequential (body, a, ThenDoSeq, spSeq, b) -> Expr.Sequential (checkAndRewrite body, a, ThenDoSeq, spSeq, b) // = "let pat = expr in " - | Expr.Let(bind, body, m, _) -> mkLetBind m bind (checkAndRewrite body) + | Expr.Let (bind, body, m, _) -> mkLetBind m bind (checkAndRewrite body) // The constructor is a sequence "let pat = expr in " - | Expr.Match(spBind, a, b, targets, c, d) -> Expr.Match(spBind, a, b, (targets |> Array.map (fun (TTarget(vs, body, spTarget)) -> TTarget(vs, checkAndRewrite body, spTarget))), c, d) + | Expr.Match (spBind, a, b, targets, c, d) -> Expr.Match (spBind, a, b, (targets |> Array.map (fun (TTarget(vs, body, spTarget)) -> TTarget(vs, checkAndRewrite body, spTarget))), c, d) // = "let rec binds in " - | Expr.LetRec(a, body, _, _) -> Expr.LetRec (a, checkAndRewrite body, m, NewFreeVarsCache()) + | Expr.LetRec (a, body, _, _) -> Expr.LetRec (a, checkAndRewrite body, m, NewFreeVarsCache()) // = "new C(...)" - | Expr.App(f, b, c, d, m) -> + | Expr.App (f, b, c, d, m) -> // The application had better be an application of a ctor let f = checkAndRewriteCtorUsage f - let expr = Expr.App(f, b, c, d, m) + let expr = Expr.App (f, b, c, d, m) rewriteConstruction expr | _ -> - error(expr) + error expr and checkAndRewriteCtorUsage expr = match expr with @@ -3974,12 +3974,12 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr: Expr) = // Type applications are ok, e.g. // type C<'a>(x: int) = // new() = C<'a>(3) - | Expr.App(f, fty, tyargs, [], m) -> + | Expr.App (f, fty, tyargs, [], m) -> let f = checkAndRewriteCtorUsage f - Expr.App(f, fty, tyargs, [], m) + Expr.App (f, fty, tyargs, [], m) // Self-calls are OK and get rewritten. - | Expr.Val(vref, NormalValUse, a) -> + | Expr.Val (vref, NormalValUse, a) -> let isCtor = match vref.MemberInfo with | None -> false @@ -3988,9 +3988,9 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr: Expr) = if not isCtor then error expr else - Expr.Val(vref, CtorValUsedAsSelfInit, a) + Expr.Val (vref, CtorValUsedAsSelfInit, a) | _ -> - error(expr) + error expr let body = checkAndRewrite body mkMultiLambdas m tps vsl (body, returnTy) @@ -4004,19 +4004,19 @@ let buildApp cenv expr resultTy arg m = match expr, arg with // Special rule for building applications of the 'x && y' operator - | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [x0], _), _), _ + | ApplicableExpr(_, Expr.App (Expr.Val (vf, _, _), _, _, [x0], _), _), _ when valRefEq g vf g.and_vref || valRefEq g vf g.and2_vref -> MakeApplicableExprNoFlex cenv (mkLazyAnd g m x0 arg), resultTy // Special rule for building applications of the 'x || y' operator - | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [x0], _), _), _ + | ApplicableExpr(_, Expr.App (Expr.Val (vf, _, _), _, _, [x0], _), _), _ when valRefEq g vf g.or_vref || valRefEq g vf g.or2_vref -> MakeApplicableExprNoFlex cenv (mkLazyOr g m x0 arg ), resultTy // Special rule for building applications of the 'reraise' operator - | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [], _), _), _ + | ApplicableExpr(_, Expr.App (Expr.Val (vf, _, _), _, _, [], _), _), _ when valRefEq g vf g.reraise_vref -> // exprty is of type: "unit -> 'a". Break it and store the 'a type here, used later as return type. @@ -4024,21 +4024,21 @@ let buildApp cenv expr resultTy arg m = // Special rules for NativePtr.ofByRef to generalize result. // See RFC FS-1053.md - | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [], _), _), _ + | ApplicableExpr(_, Expr.App (Expr.Val (vf, _, _), _, _, [], _), _), _ when (valRefEq g vf g.nativeptr_tobyref_vref) -> let argty = NewInferenceType() let resultTy = mkByrefTyWithInference g argty (NewByRefKindInferenceType g m) - expr.SupplyArgument(arg, m), resultTy + expr.SupplyArgument (arg, m), resultTy // Special rules for building applications of the '&expr' operator, which gets the // address of an expression. // // See also RFC FS-1053.md - | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [], _), _), _ + | ApplicableExpr(_, Expr.App (Expr.Val (vf, _, _), _, _, [], _), _), _ when valRefEq g vf g.addrof_vref -> - let wrap, e1a', readonly, _writeonly = mkExprAddrOfExpr g true false AddressOfOp arg (Some(vf)) m + let wrap, e1a', readonly, _writeonly = mkExprAddrOfExpr g true false AddressOfOp arg (Some vf) m // Assert the result type to be readonly if we couldn't take the address let resultTy = let argTy = tyOfExpr g arg @@ -4060,23 +4060,23 @@ let buildApp cenv expr resultTy arg m = // Special rules for building applications of the &&expr' operators, which gets the // address of an expression. - | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [], _), _), _ + | ApplicableExpr(_, Expr.App (Expr.Val (vf, _, _), _, _, [], _), _), _ when valRefEq g vf g.addrof2_vref -> - warning(UseOfAddressOfOperator(m)) - let wrap, e1a', _readonly, _writeonly = mkExprAddrOfExpr g true false AddressOfOp arg (Some(vf)) m + warning(UseOfAddressOfOperator m) + let wrap, e1a', _readonly, _writeonly = mkExprAddrOfExpr g true false AddressOfOp arg (Some vf) m MakeApplicableExprNoFlex cenv (wrap(e1a')), resultTy | _ when isByrefTy g resultTy -> // Handle byref returns, byref-typed returns get implicitly dereferenced let v, _ = mkCompGenLocal m "byrefReturn" resultTy - let expr = expr.SupplyArgument(arg, m) + let expr = expr.SupplyArgument (arg, m) let expr = mkCompGenLet m v expr.Expr (mkAddrGet m (mkLocalValRef v)) let resultTy = destByrefTy g resultTy MakeApplicableExprNoFlex cenv expr, resultTy | _ -> - expr.SupplyArgument(arg, m), resultTy + expr.SupplyArgument (arg, m), resultTy //------------------------------------------------------------------------- // Additional data structures used by type checking @@ -4105,7 +4105,7 @@ type DelayedItem = let MakeDelayedSet(e: SynExpr, m) = // We have longId <- e. Wrap 'e' in another pair of parentheses to ensure it's never interpreted as // a named argument, e.g. for "el.Checked <- (el = el2)" - DelayedSet (SynExpr.Paren(e, range0, None, e.Range), m) + DelayedSet (SynExpr.Paren (e, range0, None, e.Range), m) type NewSlotsOK = | NewSlotsOK @@ -4147,7 +4147,7 @@ type ContainerInfo = /// Indicates a declaration is contained in an expression let ExprContainerInfo = ContainerInfo(ParentNone, None) /// Indicates a declaration is contained in the given module -let ModuleOrNamespaceContainerInfo modref = ContainerInfo(Parent(modref), Some(MemberOrValContainerInfo(modref, None, None, NoSafeInitInfo, []))) +let ModuleOrNamespaceContainerInfo modref = ContainerInfo(Parent modref, Some(MemberOrValContainerInfo(modref, None, None, NoSafeInitInfo, []))) /// Indicates a declaration is contained in the given type definition in the given module let TyconContainerInfo (parent, tcref, declaredTyconTypars, safeInitInfo) = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, None, None, safeInitInfo, declaredTyconTypars))) @@ -4339,7 +4339,7 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv memSpfn m = | SynMemberSig.Member (valSpfn, memberFlags, m) -> // REVIEW: Test pseudo constraints cannot refer to polymorphic methods. // REVIEW: Test pseudo constraints cannot be curried. - let members, tpenv = TcValSpec cenv env ModuleOrMemberBinding newOk (ExprContainerInfo) (Some memberFlags) (Some (List.head tys)) tpenv valSpfn [] + let members, tpenv = TcValSpec cenv env ModuleOrMemberBinding newOk ExprContainerInfo (Some memberFlags) (Some (List.head tys)) tpenv valSpfn [] match members with | [ValSpecResult(_, _, id, _, _, memberConstraintTy, partialValReprInfo, _)] -> let memberConstraintTypars, _ = tryDestForallTy cenv.g memberConstraintTy @@ -4371,7 +4371,7 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv // An implemented interface type is in terms of the type's type parameters. // We need a signature in terms of the values' type parameters. // let optIntfSlotTy = Option.map (instType renaming) optIntfSlotTy in - enclosingDeclaredTypars, Some(tcref), Some thisTy, declKind + enclosingDeclaredTypars, Some tcref, Some thisTy, declKind | None -> [], None, thisTyOpt, ModuleOrMemberBinding let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars @@ -4397,7 +4397,7 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv match memFlagsOpt, thisTyOpt with | Some memberFlags, Some thisTy -> - let generateOneMember(memberFlags) = + let generateOneMember memberFlags = // Decode members in the signature let ty', valSynInfo = @@ -4487,7 +4487,7 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv | MemberKind.Member | MemberKind.PropertyGet | MemberKind.PropertySet -> - generateOneMember(memberFlags), tpenv + generateOneMember memberFlags, tpenv | MemberKind.PropertyGetSet -> [ yield! generateOneMember({memberFlags with MemberKind=MemberKind.PropertyGet}) yield! generateOneMember({memberFlags with MemberKind=MemberKind.PropertySet}) ], tpenv @@ -4617,7 +4617,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope TType_measure (NewErrorMeasure ()), tpenv | _, TyparKind.Type -> - if postfix && tcref.Typars(m) |> List.exists (fun tp -> match tp.Kind with TyparKind.Measure -> true | _ -> false) + if postfix && tcref.Typars m |> List.exists (fun tp -> match tp.Kind with TyparKind.Measure -> true | _ -> false) then error(Error(FSComp.SR.tcInvalidUnitsOfMeasurePrefix(), m)) TcTypeApp cenv newOk checkCxs occ env tpenv m tcref [] args | _, TyparKind.Measure -> @@ -4851,7 +4851,7 @@ and TcStaticConstantParameter cenv (env: TcEnv) tpenv kind (v: SynType) idOpt co let v = match stripExpr te with // Check we have a residue constant. We know the type was correct because we checked the expression with this type. - | Expr.Const(c, _, _) -> + | Expr.Const (c, _, _) -> match c with | Const.Byte n -> record(g.byte_ty); box (n: byte) | Const.Int16 n -> record(g.int16_ty); box (n: int16) @@ -4871,9 +4871,9 @@ and TcStaticConstantParameter cenv (env: TcEnv) tpenv kind (v: SynType) idOpt co | _ -> fail() | _ -> error(Error(FSComp.SR.tcInvalidConstantExpression(), v.Range)) v, tpenv' - | SynType.LongIdent(lidwd) -> + | SynType.LongIdent lidwd -> let m = lidwd.Range - TcStaticConstantParameter cenv env tpenv kind (SynType.StaticConstantExpr(SynExpr.LongIdent(false, lidwd, None, m), m)) idOpt container + TcStaticConstantParameter cenv env tpenv kind (SynType.StaticConstantExpr(SynExpr.LongIdent (false, lidwd, None, m), m)) idOpt container | _ -> fail() @@ -4935,7 +4935,7 @@ and TcProvidedTypeAppToStaticConstantArgs cenv env optGeneratedTypePath tpenv (t | TProvidedTypeExtensionPoint info -> info.ProvidedType | _ -> failwith "unreachable" - let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) + let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters provider), range=m) let staticParameters = staticParameters.PApplyArray(id, "GetStaticParameters", m) let argsInStaticParameterOrderIncludingDefaults = CrackStaticConstantArgs cenv env tpenv (staticParameters, args, ArgumentContainer.Type tcref, tcref.DisplayName, m) @@ -5328,22 +5328,22 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p let rec convSynPatToSynExpr x = match x with | SynPat.FromParseError(p, _) -> convSynPatToSynExpr p - | SynPat.Const (c, m) -> SynExpr.Const(c, m) - | SynPat.Named (SynPat.Wild _, id, _, None, _) -> SynExpr.Ident(id) + | SynPat.Const (c, m) -> SynExpr.Const (c, m) + | SynPat.Named (SynPat.Wild _, id, _, None, _) -> SynExpr.Ident id | SynPat.Typed (p, cty, m) -> SynExpr.Typed (convSynPatToSynExpr p, cty, m) | SynPat.LongIdent (LongIdentWithDots(longId, dotms) as lidwd, _, _tyargs, args, None, m) -> let args = match args with SynConstructorArgs.Pats args -> args | _ -> failwith "impossible: active patterns can be used only with SynConstructorArgs.Pats" let e = if dotms.Length = longId.Length then - let e = SynExpr.LongIdent(false, LongIdentWithDots(longId, List.truncate (dotms.Length - 1) dotms), None, m) - SynExpr.DiscardAfterMissingQualificationAfterDot(e, unionRanges e.Range (List.last dotms)) - else SynExpr.LongIdent(false, lidwd, None, m) + let e = SynExpr.LongIdent (false, LongIdentWithDots(longId, List.truncate (dotms.Length - 1) dotms), None, m) + SynExpr.DiscardAfterMissingQualificationAfterDot (e, unionRanges e.Range (List.last dotms)) + else SynExpr.LongIdent (false, lidwd, None, m) List.fold (fun f x -> mkSynApp1 f (convSynPatToSynExpr x) m) e args - | SynPat.Tuple (isStruct, args, m) -> SynExpr.Tuple(isStruct, List.map convSynPatToSynExpr args, [], m) + | SynPat.Tuple (isStruct, args, m) -> SynExpr.Tuple (isStruct, List.map convSynPatToSynExpr args, [], m) | SynPat.Paren (p, _) -> convSynPatToSynExpr p - | SynPat.ArrayOrList (isArray, args, m) -> SynExpr.ArrayOrList(isArray,List.map convSynPatToSynExpr args, m) + | SynPat.ArrayOrList (isArray, args, m) -> SynExpr.ArrayOrList (isArray,List.map convSynPatToSynExpr args, m) | SynPat.QuoteExpr (e,_) -> e - | SynPat.Null m -> SynExpr.Null(m) + | SynPat.Null m -> SynExpr.Null m | _ -> error(Error(FSComp.SR.tcInvalidArgForParameterizedPattern(), x.Range)) let activePatArgsAsSynExprs = List.map convSynPatToSynExpr activePatArgsAsSynPats @@ -5398,8 +5398,8 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p | null -> result.[idx] <- pat let argContainerOpt = match item with - | Item.UnionCase(uci, _) -> Some(ArgumentContainer.UnionCase(uci)) - | Item.ExnCase tref -> Some(ArgumentContainer.Type(tref)) + | Item.UnionCase(uci, _) -> Some(ArgumentContainer.UnionCase uci) + | Item.ExnCase tref -> Some(ArgumentContainer.Type tref) | _ -> None let argItem = Item.ArgName (argNames.[idx], argTys.[idx], argContainerOpt) CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, argItem, argItem, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, ad) @@ -5424,7 +5424,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p | [arg] -> [arg] | _ when numArgTys = 0 -> error(Error(FSComp.SR.tcUnionCaseDoesNotTakeArguments(), m)) | _ when numArgTys = 1 -> error(Error(FSComp.SR.tcUnionCaseRequiresOneArgument(), m)) - | _ -> error(Error(FSComp.SR.tcUnionCaseExpectsTupledArguments(numArgTys), m)) + | _ -> error(Error(FSComp.SR.tcUnionCaseExpectsTupledArguments numArgTys, m)) UnionCaseOrExnCheck env numArgTys args.Length m let args', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) argTys args @@ -5444,7 +5444,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p checkNoArgsForLiteral() UnifyTypes cenv env m ty (finfo.FieldType(cenv.amap, m)) let c' = TcFieldInit m lit - let item = Item.ILField(finfo) + let item = Item.ILField finfo CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, env.AccessRights) (fun _ -> TPat_const (c', m)), (tpenv, names, takenNames) @@ -5458,7 +5458,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p | Some lit -> checkNoArgsForLiteral() UnifyTypes cenv env m ty rfinfo.FieldType - let item = Item.RecdField(rfinfo) + let item = Item.RecdField rfinfo // FUTURE: can we do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, env.AccessRights) @@ -5473,7 +5473,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p CheckFSharpAttributes cenv.g vref.Attribs m |> CommitOperationResult checkNoArgsForLiteral() UnifyTypes cenv env m ty vexpty - let item = Item.Value(vref) + let item = Item.Value vref CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, env.AccessRights) (fun _ -> TPat_const (lit, m)), (tpenv, names, takenNames) @@ -5676,7 +5676,7 @@ and TcExprThen cenv overallTy env tpenv synExpr delayed = if isOpt then errorR(Error(FSComp.SR.tcSyntaxErrorUnexpectedQMark(), mLongId)) // Check to see if pattern translation decided to use an alternative identifier. match altNameRefCellOpt with - | Some {contents = Decided altId} -> TcExprThen cenv overallTy env tpenv (SynExpr.LongIdent(isOpt, LongIdentWithDots([altId], []), None, mLongId)) delayed + | Some {contents = Decided altId} -> TcExprThen cenv overallTy env tpenv (SynExpr.LongIdent (isOpt, LongIdentWithDots([altId], []), None, mLongId)) delayed | _ -> TcLongIdentThen cenv overallTy env tpenv longId delayed // f x @@ -5808,7 +5808,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = // SynExpr.AddressOf is noted in the syntax ast in order to recognize it as concrete type information // during type checking, in particular prior to resolving overloads. This helps distinguish // its use at method calls from the use of the conflicting 'ref' mechanism for passing byref parameters - | SynExpr.AddressOf(byref, synInnerExpr, opm, m) -> + | SynExpr.AddressOf (byref, synInnerExpr, opm, m) -> TcExpr cenv overallTy env tpenv (mkSynPrefixPrim opm m (if byref then "~&" else "~&&") synInnerExpr) | SynExpr.Upcast (synInnerExpr, _, m) | SynExpr.InferredUpcast (synInnerExpr, m) -> @@ -5826,7 +5826,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = let expr = mkCoerceExpr(innerExpr, tgtTy, m, srcTy) expr, tpenv - | SynExpr.Downcast(synInnerExpr, _, m) | SynExpr.InferredDowncast (synInnerExpr, m) -> + | SynExpr.Downcast (synInnerExpr, _, m) | SynExpr.InferredDowncast (synInnerExpr, m) -> let innerExpr, srcTy, tpenv = TcExprOfUnknownType cenv env tpenv synInnerExpr let tgtTy, tpenv, isOperator = match synExpr with @@ -5884,7 +5884,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = let args', tpenv = List.mapFold (fun tpenv (x: SynExpr) -> TcExprFlex cenv flex false argty (getInitEnv x.Range) tpenv x) tpenv args let expr = - if isArray then Expr.Op(TOp.Array, [argty], args', m) + if isArray then Expr.Op (TOp.Array, [argty], args', m) else List.foldBack (mkCons cenv.g argty) args' (mkNil cenv.g m argty) expr, tpenv @@ -5893,7 +5893,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = UnifyTypes cenv env mNewExpr overallTy objTy TcNewExpr cenv env tpenv objTy (Some synObjTy.Range) superInit arg mNewExpr - | SynExpr.ObjExpr(objTy, argopt, binds, extraImpls, mNewExpr, m) -> + | SynExpr.ObjExpr (objTy, argopt, binds, extraImpls, mNewExpr, m) -> CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) TcObjectExpr cenv overallTy env tpenv (objTy, argopt, binds, extraImpls, mNewExpr, m) @@ -5945,7 +5945,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) match comp with - | SynExpr.CompExpr(_, _, (SimpleSemicolonSequence true elems as body), _) -> + | SynExpr.CompExpr (_, _, (SimpleSemicolonSequence true elems as body), _) -> match body with | SimpleSemicolonSequence false _ -> () @@ -5956,15 +5956,15 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = if isArray then // This are to improve parsing/processing speed for parser tables by converting to an array blob ASAP let nelems = elems.Length - if nelems > 0 && List.forall (function SynExpr.Const(SynConst.UInt16 _, _) -> true | _ -> false) elems - then SynExpr.Const (SynConst.UInt16s (Array.ofList (List.map (function SynExpr.Const(SynConst.UInt16 x, _) -> x | _ -> failwith "unreachable") elems)), m) - elif nelems > 0 && List.forall (function SynExpr.Const(SynConst.Byte _, _) -> true | _ -> false) elems - then SynExpr.Const (SynConst.Bytes (Array.ofList (List.map (function SynExpr.Const(SynConst.Byte x, _) -> x | _ -> failwith "unreachable") elems), m), m) - else SynExpr.ArrayOrList(isArray, elems, m) + if nelems > 0 && List.forall (function SynExpr.Const (SynConst.UInt16 _, _) -> true | _ -> false) elems + then SynExpr.Const (SynConst.UInt16s (Array.ofList (List.map (function SynExpr.Const (SynConst.UInt16 x, _) -> x | _ -> failwith "unreachable") elems)), m) + elif nelems > 0 && List.forall (function SynExpr.Const (SynConst.Byte _, _) -> true | _ -> false) elems + then SynExpr.Const (SynConst.Bytes (Array.ofList (List.map (function SynExpr.Const (SynConst.Byte x, _) -> x | _ -> failwith "unreachable") elems), m), m) + else SynExpr.ArrayOrList (isArray, elems, m) else if elems.Length > 500 then error(Error(FSComp.SR.tcListLiteralMaxSize(), m)) - SynExpr.ArrayOrList(isArray, elems, m) + SynExpr.ArrayOrList (isArray, elems, m) TcExprUndelayed cenv overallTy env tpenv replacementExpr | _ -> @@ -6006,7 +6006,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = | SynExpr.TryWith (synBodyExpr, _mTryToWith, synWithClauses, mWithToLast, mTryToLast, spTry, spWith) -> let bodyExpr, tpenv = TcExpr cenv overallTy env tpenv synBodyExpr // Compile the pattern twice, once as a List.filter with all succeeding targets returning "1", and once as a proper catch block. - let filterClauses = synWithClauses |> List.map (function (Clause(pat, optWhenExpr, _, m, _)) -> Clause(pat, optWhenExpr, (SynExpr.Const(SynConst.Int32 1, m)), m, SuppressSequencePointAtTarget)) + let filterClauses = synWithClauses |> List.map (function (Clause(pat, optWhenExpr, _, m, _)) -> Clause(pat, optWhenExpr, (SynExpr.Const (SynConst.Int32 1, m)), m, SuppressSequencePointAtTarget)) let checkedFilterClauses, tpenv = TcMatchClauses cenv cenv.g.exn_ty cenv.g.int_ty env tpenv filterClauses let checkedHandlerClauses, tpenv = TcMatchClauses cenv cenv.g.exn_ty overallTy env tpenv synWithClauses let v1, filterExpr = CompilePatternForMatchClauses cenv env mWithToLast mWithToLast true FailFilter None cenv.g.exn_ty cenv.g.int_ty checkedFilterClauses @@ -6018,13 +6018,13 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = let finallyExpr, tpenv = TcStmt cenv env tpenv synFinallyExpr mkTryFinally cenv.g (bodyExpr, finallyExpr, mTryToLast, overallTy, spTry, spFinally), tpenv - | SynExpr.JoinIn(e1, mInToken, e2, mAll) -> + | SynExpr.JoinIn (e1, mInToken, e2, mAll) -> errorR(Error(FSComp.SR.parsUnfinishedExpression("in"), mInToken)) let _, _, tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv e1) let _, _, tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv e2) mkDefault(mAll, overallTy), tpenv - | SynExpr.ArbitraryAfterError(_debugStr, m) -> + | SynExpr.ArbitraryAfterError (_debugStr, m) -> //solveTypAsError cenv env.DisplayEnv m overallTy mkDefault(m, overallTy), tpenv @@ -6047,7 +6047,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = if (GetCtorShapeCounter env) <> 1 then errorR(Error(FSComp.SR.tcExpressionFormRequiresObjectConstructor(), m)) let expr2, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv synExpr2 - Expr.Sequential(expr1, expr2, ThenDoSeq, sp, m), tpenv + Expr.Sequential (expr1, expr2, ThenDoSeq, sp, m), tpenv | SynExpr.Do (synInnerExpr, m) -> UnifyTypes cenv env m overallTy cenv.g.unit_ty @@ -6063,7 +6063,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = // This means uses of this construct have to be very carefully written let e2', _, tpenv = TcExprOfUnknownType cenv env tpenv e2 let e3', tpenv = TcExpr cenv overallTy env tpenv e3 - Expr.StaticOptimization(constraints', e2', e3', m), tpenv + Expr.StaticOptimization (constraints', e2', e3', m), tpenv /// e1.longId <- e2 | SynExpr.DotSet (e1, (LongIdentWithDots(longId, _) as lidwd), e2, mStmt) -> @@ -6104,7 +6104,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = else TcLongIdentThen cenv overallTy env tpenv lidwd [ DelayedApp(ExprAtomicFlag.Atomic, e1, mStmt); MakeDelayedSet(e2, mStmt) ] - | SynExpr.TraitCall(tps, memSpfn, arg, m) -> + | SynExpr.TraitCall (tps, memSpfn, arg, m) -> let synTypes = tps |> List.map (fun tp -> SynType.Var(tp, m)) let (TTrait(_, logicalCompiledName, _, argTys, returnTy, _) as traitInfo), tpenv = TcPseudoMemberSpec cenv NewTyparsOK env synTypes tpenv memSpfn m if BakedInTraitConstraintNames.Contains logicalCompiledName then @@ -6118,7 +6118,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = let args', tpenv = TcExprs cenv env m tpenv flexes argTys args AddCxMethodConstraint env.DisplayEnv cenv.css m NoTrace traitInfo UnifyTypes cenv env m overallTy returnTy - Expr.Op(TOp.TraitCall(traitInfo), [], args', m), tpenv + Expr.Op (TOp.TraitCall traitInfo, [], args', m), tpenv | SynExpr.LibraryOnlyUnionCaseFieldGet (e1, c, n, m) -> let e1', ty1, tpenv = TcExprOfUnknownType cenv env tpenv e1 @@ -6154,9 +6154,9 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = | [ returnTy ] -> returnTy | _ -> error(InternalError("Only zero or one pushed items are permitted in IL assembly code", m)) UnifyTypes cenv env m overallTy returnTy - mkAsmExpr(Array.toList s, tyargs', args', rtys', m), tpenv + mkAsmExpr (Array.toList s, tyargs', args', rtys', m), tpenv - | SynExpr.Quote(oper, raw, ast, isFromQueryExpression, m) -> + | SynExpr.Quote (oper, raw, ast, isFromQueryExpression, m) -> CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) TcQuotationExpr cenv overallTy env tpenv (oper, raw, ast, isFromQueryExpression, m) @@ -6244,8 +6244,8 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg let MakeIndexParam vopt = match indexArgs with | [] -> failwith "unexpected empty index list" - | [SynIndexerArg.One h] -> SynExpr.Paren(h, range0, None, idxRange) - | _ -> SynExpr.Paren(SynExpr.Tuple(false, GetIndexArgs indexArgs @ Option.toList vopt, [], idxRange), range0, None, idxRange) + | [SynIndexerArg.One h] -> SynExpr.Paren (h, range0, None, idxRange) + | _ -> SynExpr.Paren (SynExpr.Tuple (false, GetIndexArgs indexArgs @ Option.toList vopt, [], idxRange), range0, None, idxRange) let attemptArrayString = if isArray || isString then @@ -6254,28 +6254,28 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg let sliceOpPath = ["Microsoft";"FSharp";"Core";"Operators";"OperatorIntrinsics"] let info = match isString, isArray, wholeExpr with - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_] as idxs), _, _))], _, _) -> Some (indexOpPath, "GetArray2D", idxs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_;_] as idxs), _, _))], _, _) -> Some (indexOpPath, "GetArray3D", idxs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_;_;_] as idxs), _, _))], _, _) -> Some (indexOpPath, "GetArray4D", idxs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One idx], _, _) -> Some (indexOpPath, "GetArray", [idx]) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_] as idxs), _, _))], e3, _, _, _) -> Some (indexOpPath, "SetArray2D", (idxs @ [e3])) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_;_] as idxs), _, _))], e3, _, _, _) -> Some (indexOpPath, "SetArray3D", (idxs @ [e3])) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_;_;_] as idxs), _, _))], e3, _, _, _) -> Some (indexOpPath, "SetArray4D", (idxs @ [e3])) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One _], e3, _, _, _) -> Some (indexOpPath, "SetArray", (GetIndexArgs indexArgs @ [e3])) - | true, false, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetStringSlice", GetIndexArgs indexArgs) - | true, false, SynExpr.DotIndexedGet(_, [SynIndexerArg.One _], _, _) -> Some (indexOpPath, "GetString", GetIndexArgs indexArgs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice", GetIndexArgs indexArgs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice2DFixed1", GetIndexArgs indexArgs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _;SynIndexerArg.One _], _, _) -> Some (sliceOpPath, "GetArraySlice2DFixed2", GetIndexArgs indexArgs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice2D", GetIndexArgs indexArgs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice3D", GetIndexArgs indexArgs) - | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice4D", GetIndexArgs indexArgs) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice", (GetIndexArgs indexArgs @ [e3])) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2D", (GetIndexArgs indexArgs @ [e3])) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2DFixed1", (GetIndexArgs indexArgs @ [e3])) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _;SynIndexerArg.One _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2DFixed2", (GetIndexArgs indexArgs @ [e3])) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice3D", (GetIndexArgs indexArgs @ [e3])) - | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice4D", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_] as idxs), _, _))], _, _) -> Some (indexOpPath, "GetArray2D", idxs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_;_] as idxs), _, _))], _, _) -> Some (indexOpPath, "GetArray3D", idxs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_;_;_] as idxs), _, _))], _, _) -> Some (indexOpPath, "GetArray4D", idxs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.One idx], _, _) -> Some (indexOpPath, "GetArray", [idx]) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_] as idxs), _, _))], e3, _, _, _) -> Some (indexOpPath, "SetArray2D", (idxs @ [e3])) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_;_] as idxs), _, _))], e3, _, _, _) -> Some (indexOpPath, "SetArray3D", (idxs @ [e3])) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.One(SynExpr.Tuple (false, ([_;_;_;_] as idxs), _, _))], e3, _, _, _) -> Some (indexOpPath, "SetArray4D", (idxs @ [e3])) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.One _], e3, _, _, _) -> Some (indexOpPath, "SetArray", (GetIndexArgs indexArgs @ [e3])) + | true, false, SynExpr.DotIndexedGet (_, [SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetStringSlice", GetIndexArgs indexArgs) + | true, false, SynExpr.DotIndexedGet (_, [SynIndexerArg.One _], _, _) -> Some (indexOpPath, "GetString", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.One _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice2DFixed1", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.Two _;SynIndexerArg.One _], _, _) -> Some (sliceOpPath, "GetArraySlice2DFixed2", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice2D", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice3D", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet (_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice4D", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2D", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.One _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2DFixed1", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.Two _;SynIndexerArg.One _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2DFixed2", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice3D", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet (_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice4D", (GetIndexArgs indexArgs @ [e3])) | _ -> None // error(Error(FSComp.SR.tcInvalidIndexerExpression(), mWholeExpr)) match info with | None -> None @@ -6303,7 +6303,7 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg | SynExpr.DotIndexedGet _ -> DelayedDotLookup([ident(nm, mWholeExpr)], mWholeExpr) :: DelayedApp(ExprAtomicFlag.Atomic, MakeIndexParam None, mWholeExpr) :: delayed // e1.[e2] <- e3 - | SynExpr.DotIndexedSet(_, _, e3, mOfLeftOfSet, _, _) -> + | SynExpr.DotIndexedSet (_, _, e3, mOfLeftOfSet, _, _) -> match indexArgs with | [SynIndexerArg.One(_)] -> DelayedDotLookup([ident(nm, mOfLeftOfSet)], mOfLeftOfSet) :: DelayedApp(ExprAtomicFlag.Atomic, MakeIndexParam None, mOfLeftOfSet) :: MakeDelayedSet(e3, mWholeExpr) :: delayed | _ -> DelayedDotLookup([ident("SetSlice", mOfLeftOfSet)], mOfLeftOfSet) :: DelayedApp(ExprAtomicFlag.Atomic, MakeIndexParam (Some e3), mWholeExpr) :: delayed @@ -6535,7 +6535,7 @@ and FreshenObjExprAbstractSlot cenv (env: TcEnv) (implty: TType) virtNameAndArit if containsNonAbstractMemberWithSameName then errorR(ErrorWithSuggestions(FSComp.SR.tcMemberFoundIsNotAbstractOrVirtual(tcref.DisplayName, bindName), mBinding, bindName, suggestVirtualMembers)) else - errorR(ErrorWithSuggestions(FSComp.SR.tcNoAbstractOrVirtualMemberFound(bindName), mBinding, bindName, suggestVirtualMembers)) + errorR(ErrorWithSuggestions(FSComp.SR.tcNoAbstractOrVirtualMemberFound bindName, mBinding, bindName, suggestVirtualMembers)) | [(_, absSlot: MethInfo)] -> errorR(Error(FSComp.SR.tcArgumentArityMismatch(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot), mBinding)) | (_, absSlot: MethInfo) :: _ -> @@ -6611,7 +6611,7 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo, bind) = let freeInEnv = GeneralizationHelpers.ComputeUngeneralizableTypars env - let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv, denv, m, freeInEnv, false, CanGeneralizeConstrainedTypars, inlineFlag, Some(rhsExpr), declaredTypars, [], bindingTy, false) + let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv, denv, m, freeInEnv, false, CanGeneralizeConstrainedTypars, inlineFlag, Some rhsExpr, declaredTypars, [], bindingTy, false) let declaredTypars = ChooseCanonicalDeclaredTyparsAfterInference cenv.g env.DisplayEnv declaredTypars m let generalizedTypars = PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars @@ -6757,7 +6757,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, let expr, tpenv = TcMethodApplicationThen cenv env objTy None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] // The 'base' value is always bound - let baseIdOpt = (match baseIdOpt with None -> Some(ident("base", mObjTy)) | Some id -> Some(id)) + let baseIdOpt = (match baseIdOpt with None -> Some(ident("base", mObjTy)) | Some id -> Some id) expr, baseIdOpt, tpenv | Item.FakeInterfaceCtor intfTy, None -> UnifyTypes cenv env mWholeExpr objTy intfTy @@ -6843,7 +6843,7 @@ and TcConstStringExpr cenv overallTy env m tpenv s = let formatStringCheckContext = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.FormatStringCheckContext let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n")) - let (aty', ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g formatStringCheckContext normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s), m))) + let (aty', ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g formatStringCheckContext normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString s, m))) match cenv.tcSink.CurrentSink with | None -> () @@ -6869,10 +6869,10 @@ and TcConstExpr cenv overallTy env m tpenv c = // NOTE: these aren't "really" constants | SynConst.Bytes (bytes, m) -> UnifyTypes cenv env m overallTy (mkByteArrayTy cenv.g) - Expr.Op(TOp.Bytes bytes, [], [], m), tpenv + Expr.Op (TOp.Bytes bytes, [], [], m), tpenv | SynConst.UInt16s arr -> - UnifyTypes cenv env m overallTy (mkArrayType cenv.g cenv.g.uint16_ty); Expr.Op(TOp.UInt16s arr, [], [], m), tpenv + UnifyTypes cenv env m overallTy (mkArrayType cenv.g cenv.g.uint16_ty); Expr.Op (TOp.UInt16s arr, [], [], m), tpenv | SynConst.UserNum (s, suffix) -> let expr = @@ -6880,27 +6880,27 @@ and TcConstExpr cenv overallTy env m tpenv c = let ad = env.eAccessRights match ResolveLongIndentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AtMostOneResult cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with | Result [] - | Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule(modName), m)) + | Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule modName, m)) | Result ((_, mref, _) :: _) -> let expr = try match int32 s with - | 0 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromZero", SynExpr.Const(SynConst.Unit, m), m) - | 1 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromOne", SynExpr.Const(SynConst.Unit, m), m) - | i32 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromInt32", SynExpr.Const(SynConst.Int32 i32, m), m) + | 0 -> SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromZero", SynExpr.Const (SynConst.Unit, m), m) + | 1 -> SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromOne", SynExpr.Const (SynConst.Unit, m), m) + | i32 -> SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromInt32", SynExpr.Const (SynConst.Int32 i32, m), m) with _ -> try let i64 = int64 s - SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromInt64", SynExpr.Const(SynConst.Int64 i64, m), m) + SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromInt64", SynExpr.Const (SynConst.Int64 i64, m), m) with _ -> - SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromString", SynExpr.Const(SynConst.String (s, m), m), m) + SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromString", SynExpr.Const (SynConst.String (s, m), m), m) if suffix <> "I" then expr else match ccuOfTyconRef mref with | Some ccu when ccuEq ccu cenv.g.fslibCcu -> - SynExpr.Typed(expr, SynType.LongIdent(LongIdentWithDots(pathToSynLid m ["System";"Numerics";"BigInteger"], [])), m) + SynExpr.Typed (expr, SynType.LongIdent(LongIdentWithDots(pathToSynLid m ["System";"Numerics";"BigInteger"], [])), m) | _ -> expr @@ -6915,12 +6915,12 @@ and TcConstExpr cenv overallTy env m tpenv c = // TcAssertExpr //------------------------------------------------------------------------- -// Check an 'assert(x)' expression. +// Check an 'assert x' expression. and TcAssertExpr cenv overallTy env (m: range) tpenv x = let synm = m.MakeSynthetic() // Mark as synthetic so the language service won't pick it up. - let callDiagnosticsExpr = SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet synm ["System";"Diagnostics";"Debug"] "Assert", + let callDiagnosticsExpr = SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet synm ["System";"Diagnostics";"Debug"] "Assert", // wrap an extra parentheses so 'assert(x=1) isn't considered a named argument to a method call - SynExpr.Paren(x, range0, None, synm), synm) + SynExpr.Paren (x, range0, None, synm), synm) TcExpr cenv overallTy env tpenv callDiagnosticsExpr @@ -6989,7 +6989,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr match inherits, GetSuperTypeOfType cenv.g cenv.amap mWholeExpr overallTy with | Some (superTy, arg, m, _, _), Some realSuperTy -> // Constructor expression, with an explicit 'inheritedTys clause. Check the inherits clause. - let e, tpenv = TcExpr cenv realSuperTy env tpenv (SynExpr.New(true, superTy, arg, m)) + let e, tpenv = TcExpr cenv realSuperTy env tpenv (SynExpr.New (true, superTy, arg, m)) Some e, tpenv | None, Some realSuperTy when requiresCtor -> // Constructor expression, No 'inherited' clause, hence look for a default constructor @@ -7116,7 +7116,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol let mPat = pat.Range //let mBodyExpr = bodySynExpr.Range let mEnumExpr = enumSynExpr.Range - let mForLoopStart = match spForLoop with SequencePointAtForLoop(mStart) -> mStart | NoSequencePointAtForLoop -> mEnumExpr + let mForLoopStart = match spForLoop with SequencePointAtForLoop mStart -> mStart | NoSequencePointAtForLoop -> mEnumExpr // Check the expression being enumerated let enumExpr, enumExprTy, tpenv = TcExprOfUnknownType cenv env tpenv enumSynExpr @@ -7126,7 +7126,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol match enumExpr with // optimize 'for i in n .. m do' - | Expr.App(Expr.Val(vf, _, _), _, [tyarg], [startExpr;finishExpr], _) + | Expr.App (Expr.Val (vf, _, _), _, [tyarg], [startExpr;finishExpr], _) when valRefEq cenv.g vf cenv.g.range_op_vref && typeEquiv cenv.g tyarg cenv.g.int_ty -> (cenv.g.int32_ty, (fun _ x -> x), id, Choice1Of3 (startExpr, finishExpr)) @@ -7196,7 +7196,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol // This compiled for must be matched EXACTLY by CompiledForEachExpr in opt.fs and creflect.fs mkCompGenLet mForLoopStart enumerableVar enumExpr (let cleanupE = BuildDisposableCleanup cenv env mWholeExpr enumeratorVar - let spBind = match spForLoop with SequencePointAtForLoop(spStart) -> SequencePointAtBinding(spStart) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding + let spBind = match spForLoop with SequencePointAtForLoop spStart -> SequencePointAtBinding spStart | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding (mkLet spBind mForLoopStart enumeratorVar getEnumExpr (mkTryFinally cenv.g (mkWhile cenv.g @@ -7223,7 +7223,7 @@ and TcQuotationExpr cenv overallTy env tpenv (_oper, raw, ast, isFromQueryExpres let expr, tpenv = TcExpr cenv astTy env tpenv ast // Wrap the expression - let expr = Expr.Quote(expr, ref None, isFromQueryExpression, m, overallTy) + let expr = Expr.Quote (expr, ref None, isFromQueryExpression, m, overallTy) // Coerce it if needed let expr = if raw then mkCoerceExpr(expr, (mkRawQuotedExprTy cenv.g), m, (tyOfExpr cenv.g expr)) else expr @@ -7259,7 +7259,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // Give bespoke error messages for the FSharp.Core "query" builder let isQuery = match interpExpr with - | Expr.Val(vf, _, m) -> + | Expr.Val (vf, _, m) -> let item = Item.CustomBuilder (vf.DisplayName, vf) CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) valRefEq cenv.g vf cenv.g.query_value_vref @@ -7270,12 +7270,12 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let m = m.MakeSynthetic() // Mark as synthetic so the language service won't pick it up. let args = match args with - | [] -> SynExpr.Const(SynConst.Unit, m) - | [arg] -> SynExpr.Paren(SynExpr.Paren(arg, range0, None, m), range0, None, m) - | args -> SynExpr.Paren(SynExpr.Tuple(false, args, [], m), range0, None, m) + | [] -> SynExpr.Const (SynConst.Unit, m) + | [arg] -> SynExpr.Paren (SynExpr.Paren (arg, range0, None, m), range0, None, m) + | args -> SynExpr.Paren (SynExpr.Tuple (false, args, [], m), range0, None, m) let builderVal = mkSynIdGet m builderValName - mkSynApp1 (SynExpr.DotGet(builderVal, range0, LongIdentWithDots([mkSynId m nm], []), m)) args m + mkSynApp1 (SynExpr.DotGet (builderVal, range0, LongIdentWithDots([mkSynId m nm], []), m)) args m let sourceMethInfo = TryFindIntrinsicOrExtensionMethInfo cenv env mBuilderVal ad "Source" builderTy // Optionally wrap sources of "let!", "yield!", "use!" in "query.Source" @@ -7450,7 +7450,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (|ForEachThen|_|) e = match e with - | SynExpr.ForEach (_spBind, SeqExprOnly false, isFromSource, pat1, expr1, SynExpr.Sequential(_, true, clause, rest, _), _) -> Some (isFromSource, pat1, expr1, clause, rest) + | SynExpr.ForEach (_spBind, SeqExprOnly false, isFromSource, pat1, expr1, SynExpr.Sequential (_, true, clause, rest, _), _) -> Some (isFromSource, pat1, expr1, clause, rest) | _ -> None let (|CustomOpId|_|) predicate e = @@ -7461,7 +7461,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // e1 in e2 ('in' is parsed as 'JOIN_IN') let (|InExpr|_|) (e: SynExpr) = match e with - | SynExpr.JoinIn(e1, _, e2, mApp) -> Some (e1, e2, mApp) + | SynExpr.JoinIn (e1, _, e2, mApp) -> Some (e1, e2, mApp) | _ -> None // e1 on e2 (note: 'on' is the 'JoinConditionWord') @@ -7470,7 +7470,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | None -> None | Some _ -> match e with - | SynExpr.App(_, _, SynExpr.App(_, _, e1, SingleIdent opName, _), e2, _) when opName.idText = customOperationJoinConditionWord nm -> + | SynExpr.App (_, _, SynExpr.App (_, _, e1, SingleIdent opName, _), e2, _) when opName.idText = customOperationJoinConditionWord nm -> let item = Item.CustomOperation (opName.idText, (fun () -> None), None) CallNameResolutionSink cenv.tcSink (opName.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) Some (e1, e2) @@ -7479,7 +7479,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // e1 into e2 let (|IntoSuffix|_|) (e: SynExpr) = match e with - | SynExpr.App(_, _, SynExpr.App(_, _, x, SingleIdent nm2, _), ExprAsPat intoPat, _) when nm2.idText = CustomOperations.Into -> + | SynExpr.App (_, _, SynExpr.App (_, _, x, SingleIdent nm2, _), ExprAsPat intoPat, _) when nm2.idText = CustomOperations.Into -> Some (x, nm2.idRange, intoPat) | _ -> None @@ -7510,10 +7510,10 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let JoinOrGroupJoinOp detector e = match e with - | SynExpr.App(_, _, CustomOpId detector nm, ExprAsPat innerSourcePat, mJoinCore) -> + | SynExpr.App (_, _, CustomOpId detector nm, ExprAsPat innerSourcePat, mJoinCore) -> Some(nm, innerSourcePat, mJoinCore, false) // join with bad pattern (gives error on "join" and continues) - | SynExpr.App(_, _, CustomOpId detector nm, _innerSourcePatExpr, mJoinCore) -> + | SynExpr.App (_, _, CustomOpId detector nm, _innerSourcePatExpr, mJoinCore) -> errorR(Error(FSComp.SR.tcBinaryOperatorRequiresVariable(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) Some(nm, arbPat mJoinCore, mJoinCore, true) // join (without anything after - gives error on "join" and continues) @@ -7566,7 +7566,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some(nm, innerSourcePat, innerSource, Some keySelectors, Some intoPat, mGroupJoinCore) // zip intoPat in secondSource - | InExpr (SynExpr.App(_, _, CustomOpId customOperationIsLikeZip nm, ExprAsPat secondSourcePat, _), secondSource, mZipCore) -> + | InExpr (SynExpr.App (_, _, CustomOpId customOperationIsLikeZip nm, ExprAsPat secondSourcePat, _), secondSource, mZipCore) -> Some(nm, secondSourcePat, secondSource, None, None, mZipCore) // zip (without secondSource or in - gives error) @@ -7575,7 +7575,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some(nm, arbPat e.Range, arbExpr("_secondSource", e.Range), None, None, e.Range) // zip secondSource (without in - gives error) - | SynExpr.App(_, _, CustomOpId customOperationIsLikeZip nm, ExprAsPat secondSourcePat, mZipCore) -> + | SynExpr.App (_, _, CustomOpId customOperationIsLikeZip nm, ExprAsPat secondSourcePat, mZipCore) -> errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)), mZipCore)) Some(nm, secondSourcePat, arbExpr("_innerSource", e.Range), None, None, mZipCore) @@ -7604,8 +7604,8 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (|StripApps|) e = let rec strip e = match e with - | SynExpr.FromParseError(SynExpr.App(_, _, f, arg, _), _) - | SynExpr.App(_, _, f, arg, _) -> + | SynExpr.FromParseError (SynExpr.App (_, _, f, arg, _), _) + | SynExpr.App (_, _, f, arg, _) -> let g, acc = strip f g, (arg::acc) | _ -> e, [] @@ -7632,13 +7632,13 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some (nm, Option.get (tryGetDataForCustomOperation nm), core, core.Range, optIntoInfo) | _ -> None - let mkSynLambda p e m = SynExpr.Lambda(false, false, p, e, m) + let mkSynLambda p e m = SynExpr.Lambda (false, false, p, e, m) let mkExprForVarSpace m (patvs: Val list) = match patvs with - | [] -> SynExpr.Const(SynConst.Unit, m) + | [] -> SynExpr.Const (SynConst.Unit, m) | [v] -> SynExpr.Ident v.Id - | vs -> SynExpr.Tuple(false, (vs |> List.map (fun v -> SynExpr.Ident v.Id)), [], m) + | vs -> SynExpr.Tuple (false, (vs |> List.map (fun v -> SynExpr.Ident v.Id)), [], m) let mkSimplePatForVarSpace m (patvs: Val list) = let spats = @@ -7656,7 +7656,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (|OptionalSequential|) e = match e with - | SynExpr.Sequential(_sp, true, dataComp1, dataComp2, _) -> (dataComp1, Some dataComp2) + | SynExpr.Sequential (_sp, true, dataComp1, dataComp2, _) -> (dataComp1, Some dataComp2) | _ -> (e, None) // Check for 'where x > y', 'select x, y' and other mis-applications of infix operators, give a good error message, and return a flag @@ -7669,7 +7669,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let estimatedRangeOfIntendedLeftAndRightArguments = unionRanges (List.last args).Range arg2.Range errorR(Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator(), estimatedRangeOfIntendedLeftAndRightArguments)) true - | SynExpr.Tuple(false, (StripApps(SingleIdent nm2, args) :: _), _, m) when + | SynExpr.Tuple (false, (StripApps(SingleIdent nm2, args) :: _), _, m) when expectedArgCountForCustomOperator nm2 > 0 && not (List.isEmpty args) -> let estimatedRangeOfIntendedLeftAndRightArguments = unionRanges (List.last args).Range m.EndRange @@ -7779,7 +7779,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv (mkSynLambda firstSourceSimplePats (mkSynLambda secondSourceSimplePats e mSynthetic) mSynthetic) ] // wraps given expression into sequence with result produced by arbExpr so result will look like: - // l; SynExpr.ArbitraryAfterError(...) + // l; SynExpr.ArbitraryAfterError (...) // this allows to handle cases like 'on (a > b)' // '>' is not permitted as correct join relation // after wrapping a and b can still be typechecked (so we'll have correct completion inside 'on' part) // but presence of SynExpr.ArbitraryAfterError allows to avoid errors about incompatible types in cases like @@ -7792,7 +7792,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // 2. incompatible types: int and string // with SynExpr.ArbitraryAfterError we have only first one let wrapInArbErrSequence l caption = - SynExpr.Sequential(SequencePointInfoForSeq.SequencePointsAtSeq, true, l, (arbExpr(caption, l.Range.EndRange)), l.Range) + SynExpr.Sequential (SequencePointInfoForSeq.SequencePointsAtSeq, true, l, (arbExpr(caption, l.Range.EndRange)), l.Range) let mkOverallExprGivenVarSpaceExpr, varSpaceInner = let isNullableOp opId = @@ -7864,9 +7864,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | SynExpr.ForEach (spForLoop, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _) -> let wrappedSourceExpr = if isFromSource then mkSourceExpr sourceExpr else sourceExpr - let mFor = match spForLoop with SequencePointAtForLoop(m) -> m | _ -> pat.Range + let mFor = match spForLoop with SequencePointAtForLoop m -> m | _ -> pat.Range let mPat = pat.Range - let spBind = match spForLoop with SequencePointAtForLoop(m) -> SequencePointAtBinding(m) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding + let spBind = match spForLoop with SequencePointAtForLoop m -> SequencePointAtBinding m | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mFor ad "For" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("For"), mFor)) // Add the variables to the query variable space, on demand @@ -7878,7 +7878,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some (trans true q varSpace innerComp (fun holeFill -> - translatedCtxt (mkSynCall "For" mFor [wrappedSourceExpr; SynExpr.MatchLambda(false, sourceExpr.Range, [Clause(pat, None, holeFill, mPat, SequencePointAtTarget)], spBind, mFor) ])) ) + translatedCtxt (mkSynCall "For" mFor [wrappedSourceExpr; SynExpr.MatchLambda (false, sourceExpr.Range, [Clause(pat, None, holeFill, mPat, SequencePointAtTarget)], spBind, mFor) ])) ) | SynExpr.For (spBind, id, start, dir, finish, innerComp, m) -> let mFor = match spBind with SequencePointAtForLoop m -> m | _ -> m @@ -7887,7 +7887,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | SynExpr.While (spWhile, guardExpr, innerComp, _) -> let mGuard = guardExpr.Range - let mWhile = match spWhile with SequencePointAtWhileLoop(m) -> m | _ -> mGuard + let mWhile = match spWhile with SequencePointAtWhileLoop m -> m | _ -> mGuard if isQuery then error(Error(FSComp.SR.tcNoWhileInQuery(), mWhile)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "While" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("While"), mWhile)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mWhile)) @@ -7895,7 +7895,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | SynExpr.TryFinally (innerComp, unwindExpr, mTryToLast, spTry, _spFinally) -> - let mTry = match spTry with SequencePointAtTry(m) -> m | _ -> mTryToLast + let mTry = match spTry with SequencePointAtTry m -> m | _ -> mTryToLast if isQuery then error(Error(FSComp.SR.tcNoTryFinallyInQuery(), mTry)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryFinally" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryFinally"), mTry)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) @@ -7917,7 +7917,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let varSpacePat = mkPatForVarSpace mClause patvs let dataCompPrior = - translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause))) + translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn ((true, false), varSpaceExpr, mClause))) // Rebind using for ... let rebind = @@ -7936,7 +7936,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let dataCompPriorToOp = let isYield = not (customOperationMaintainsVarSpaceUsingBind nm) - translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause))) + translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn ((isYield, false), varSpaceExpr, mClause))) let rec consumeClauses (varSpace: LazyWithContext<_, _>) dataCompPrior compClausesExpr lastUsesBind = @@ -8006,7 +8006,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // Rebind using either for ... or let!.... let rebind = if maintainsVarSpaceUsingBind then - SynExpr.LetOrUseBang(NoSequencePointAtLetBinding, false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) + SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) else SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) @@ -8028,7 +8028,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // Rebind using either for ... or let!.... let rebind = if lastUsesBind then - SynExpr.LetOrUseBang(NoSequencePointAtLetBinding, false, false, varSpacePat, dataCompPrior, compClausesExpr, compClausesExpr.Range) + SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, varSpacePat, dataCompPrior, compClausesExpr, compClausesExpr.Range) else SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, varSpacePat, dataCompPrior, compClausesExpr, compClausesExpr.Range) @@ -8037,7 +8037,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // Now run the consumeClauses Some (consumeClauses varSpace dataCompPriorToOp comp false) - | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m) -> + | SynExpr.Sequential (sp, true, innerComp1, innerComp2, m) -> // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore innerComp1 if isQuery && checkForBinaryApp innerComp1 then @@ -8071,27 +8071,27 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | None -> // "do! expr; cexpr" is treated as { let! () = expr in cexpr } match innerComp1 with - | SynExpr.DoBang(rhsExpr, m) -> + | SynExpr.DoBang (rhsExpr, m) -> let sp = match sp with | SuppressSequencePointOnStmtOfSequential -> SequencePointAtBinding m | SuppressSequencePointOnExprOfSequential -> NoSequencePointAtDoBinding | SequencePointsAtSeq -> SequencePointAtBinding m - Some(trans true q varSpace (SynExpr.LetOrUseBang(sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, innerComp2, m)) translatedCtxt) + Some(trans true q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, innerComp2, m)) translatedCtxt) // "expr; cexpr" is treated as sequential execution | _ -> - Some (trans true q varSpace innerComp2 (fun holeFill -> translatedCtxt (SynExpr.Sequential(sp, true, innerComp1, holeFill, m)))) + Some (trans true q varSpace innerComp2 (fun holeFill -> translatedCtxt (SynExpr.Sequential (sp, true, innerComp1, holeFill, m)))) | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch) -> match elseCompOpt with | Some elseComp -> if isQuery then error(Error(FSComp.SR.tcIfThenElseMayNotBeUsedWithinQueries(), mIfToThen)) - Some (translatedCtxt (SynExpr.IfThenElse(guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch))) + Some (translatedCtxt (SynExpr.IfThenElse (guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch))) | None -> let elseComp = if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mIfToThen ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), mIfToThen)) mkSynCall "Zero" mIfToThen [] - Some (trans true q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse(guardExpr, holeFill, Some elseComp, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch)))) + Some (trans true q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse (guardExpr, holeFill, Some elseComp, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch)))) // 'let binds in expr' | SynExpr.LetOrUse (isRec, false, binds, innerComp, m) -> @@ -8129,14 +8129,14 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let bindRange = match spBind with SequencePointAtBinding m -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcUseMayNotBeUsedInQueries(), bindRange)) let innerCompRange = innerComp.Range - let consumeExpr = SynExpr.MatchLambda(false, innerCompRange, [Clause(pat, None, transNoQueryOps innerComp, innerCompRange, SequencePointAtTarget)], spBind, innerCompRange) + let consumeExpr = SynExpr.MatchLambda (false, innerCompRange, [Clause(pat, None, transNoQueryOps innerComp, innerCompRange, SequencePointAtTarget)], spBind, innerCompRange) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) Some (translatedCtxt (mkSynCall "Using" bindRange [rhsExpr; consumeExpr ])) // 'let! pat = expr in expr' --> build.Bind(e1, (function _argN -> match _argN with pat -> expr)) - | SynExpr.LetOrUseBang(spBind, false, isFromSource, pat, rhsExpr, innerComp, _) -> + | SynExpr.LetOrUseBang (spBind, false, isFromSource, pat, rhsExpr, innerComp, _) -> - let bindRange = match spBind with SequencePointAtBinding(m) -> m | _ -> rhsExpr.Range + let bindRange = match spBind with SequencePointAtBinding m -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), bindRange)) let innerRange = innerComp.Range if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) @@ -8150,32 +8150,32 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let rhsExpr = if isFromSource then mkSourceExpr rhsExpr else rhsExpr Some (trans true q varSpace innerComp (fun holeFill -> - let consumeExpr = SynExpr.MatchLambda(false, pat.Range, [Clause(pat, None, holeFill, innerRange, SequencePointAtTarget)], spBind, innerRange) + let consumeExpr = SynExpr.MatchLambda (false, pat.Range, [Clause(pat, None, holeFill, innerRange, SequencePointAtTarget)], spBind, innerRange) translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr]))) // 'use! pat = e1 in e2' --> build.Bind(e1, (function _argN -> match _argN with pat -> build.Using(x, (fun _argN -> match _argN with pat -> e2)))) - | SynExpr.LetOrUseBang(spBind, true, isFromSource, (SynPat.Named (SynPat.Wild _, id, false, _, _) as pat), rhsExpr, innerComp, _) - | SynExpr.LetOrUseBang(spBind, true, isFromSource, (SynPat.LongIdent (LongIdentWithDots([id], _), _, _, _, _, _) as pat), rhsExpr, innerComp, _) -> + | SynExpr.LetOrUseBang (spBind, true, isFromSource, (SynPat.Named (SynPat.Wild _, id, false, _, _) as pat), rhsExpr, innerComp, _) + | SynExpr.LetOrUseBang (spBind, true, isFromSource, (SynPat.LongIdent (LongIdentWithDots([id], _), _, _, _, _, _) as pat), rhsExpr, innerComp, _) -> - let bindRange = match spBind with SequencePointAtBinding(m) -> m | _ -> rhsExpr.Range + let bindRange = match spBind with SequencePointAtBinding m -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), bindRange)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) - let consumeExpr = SynExpr.MatchLambda(false, bindRange, [Clause(pat, None, transNoQueryOps innerComp, innerComp.Range, SequencePointAtTarget)], spBind, bindRange) - let consumeExpr = mkSynCall "Using" bindRange [SynExpr.Ident(id); consumeExpr ] - let consumeExpr = SynExpr.MatchLambda(false, bindRange, [Clause(pat, None, consumeExpr, id.idRange, SequencePointAtTarget)], spBind, bindRange) + let consumeExpr = SynExpr.MatchLambda (false, bindRange, [Clause(pat, None, transNoQueryOps innerComp, innerComp.Range, SequencePointAtTarget)], spBind, bindRange) + let consumeExpr = mkSynCall "Using" bindRange [SynExpr.Ident id; consumeExpr ] + let consumeExpr = SynExpr.MatchLambda (false, bindRange, [Clause(pat, None, consumeExpr, id.idRange, SequencePointAtTarget)], spBind, bindRange) let rhsExpr = if isFromSource then mkSourceExpr rhsExpr else rhsExpr Some(translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr])) // 'use! pat = e1 in e2' where 'pat' is not a simple name --> error - | SynExpr.LetOrUseBang(_spBind, true, _isFromSource, pat, _rhsExpr, _innerComp, _) -> + | SynExpr.LetOrUseBang (_spBind, true, _isFromSource, pat, _rhsExpr, _innerComp, _) -> error(Error(FSComp.SR.tcInvalidUseBangBinding(), pat.Range)) | SynExpr.Match (spMatch, expr, clauses, m) -> let mMatch = match spMatch with SequencePointAtBinding mMatch -> mMatch | _ -> m if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch)) let clauses = clauses |> List.map (fun (Clause(pat, cond, innerComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps innerComp, patm, sp)) - Some(translatedCtxt (SynExpr.Match(spMatch, expr, clauses, m))) + Some(translatedCtxt (SynExpr.Match (spMatch, expr, clauses, m))) // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...)) | SynExpr.MatchBang (spMatch, expr, clauses, m) -> @@ -8183,20 +8183,20 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mMatch ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), mMatch)) let clauses = clauses |> List.map (fun (Clause(pat, cond, innerComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps innerComp, patm, sp)) - let consumeExpr = SynExpr.MatchLambda(false, mMatch, clauses, spMatch, mMatch) + let consumeExpr = SynExpr.MatchLambda (false, mMatch, clauses, spMatch, mMatch) Some(translatedCtxt (mkSynCall "Bind" mMatch [expr; consumeExpr])) | SynExpr.TryWith (innerComp, _mTryToWith, clauses, _mWithToLast, mTryToLast, spTry, _spWith) -> - let mTry = match spTry with SequencePointAtTry(m) -> m | _ -> mTryToLast + let mTry = match spTry with SequencePointAtTry m -> m | _ -> mTryToLast if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(), mTry)) let clauses = clauses |> List.map (fun (Clause(pat, cond, clauseComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps clauseComp, patm, sp)) - let consumeExpr = SynExpr.MatchLambda(true, mTryToLast, clauses, NoSequencePointAtStickyBinding, mTryToLast) + let consumeExpr = SynExpr.MatchLambda (true, mTryToLast, clauses, NoSequencePointAtStickyBinding, mTryToLast) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryWith" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"), mTry)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) Some(translatedCtxt (mkSynCall "TryWith" mTry [mkSynCall "Delay" mTry [mkSynDelay2 (transNoQueryOps innerComp)]; consumeExpr])) - | SynExpr.YieldOrReturnFrom((isYield, _), yieldExpr, m) -> + | SynExpr.YieldOrReturnFrom ((isYield, _), yieldExpr, m) -> let yieldExpr = mkSourceExpr yieldExpr if isYield then if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "YieldFrom" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"), m)) @@ -8211,10 +8211,10 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some (translatedCtxt (mkSynCall "ReturnFrom" m [yieldExpr])) - | SynExpr.YieldOrReturn((isYield, _), yieldExpr, m) -> + | SynExpr.YieldOrReturn ((isYield, _), yieldExpr, m) -> let methName = (if isYield then "Yield" else "Return") if isQuery && not isYield then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(), m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad methName builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod(methName), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad methName builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod methName, m)) Some(translatedCtxt (mkSynCall methName m [yieldExpr])) | _ -> None @@ -8227,7 +8227,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // This only occurs in final position in a sequence match comp with // "do! expr;" in final position is treated as { let! () = expr in return () } when Return is provided or as { let! () = expr in zero } otherwise - | SynExpr.DoBang(rhsExpr, m) -> + | SynExpr.DoBang (rhsExpr, m) -> let mUnit = rhsExpr.Range let rhsExpr = mkSourceExpr rhsExpr if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), m)) @@ -8235,8 +8235,8 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Return" builderTy) then SynExpr.ImplicitZero m else - SynExpr.YieldOrReturn((false, true), SynExpr.Const(SynConst.Unit, m), m) - trans true q varSpace (SynExpr.LetOrUseBang(NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt + SynExpr.YieldOrReturn ((false, true), SynExpr.Const (SynConst.Unit, m), m) + trans true q varSpace (SynExpr.LetOrUseBang (NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt // "expr;" in final position is treated as { expr; zero } // Suppress the sequence point on the "zero" | _ -> @@ -8248,7 +8248,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv match comp with | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential | _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(), comp.RangeOfFirstPortion)) - trans true q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> translatedCtxt (SynExpr.Sequential(SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range))) + trans true q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> translatedCtxt (SynExpr.Sequential (SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range))) let basicSynExpr = trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([], env)) comp (fun holeFill -> holeFill) @@ -8260,7 +8260,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let quotedSynExpr = if isAutoQuote then - SynExpr.Quote(mkSynIdGet (mBuilderVal.MakeSynthetic()) (CompileOpName "<@ @>"), (*isRaw=*)false, delayedExpr, (*isFromQueryExpression=*)true, mWhole) + SynExpr.Quote (mkSynIdGet (mBuilderVal.MakeSynthetic()) (CompileOpName "<@ @>"), (*isRaw=*)false, delayedExpr, (*isFromQueryExpression=*)true, mWhole) else delayedExpr @@ -8318,7 +8318,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = // peephole optimization: "for x in e1 -> e2" == "e1 |> List.map (fun x -> e2)" *) | (TPat_as (TPat_wild _, PBind (v, _), _), vs, - Expr.App(Expr.Val(vf, _, _), _, [genEnumElemTy], [yexpr], _)) + Expr.App (Expr.Val (vf, _, _), _, [genEnumElemTy], [yexpr], _)) when vs.Length = 1 && valRefEq cenv.g vf cenv.g.seq_singleton_vref -> let enumExprMark = enumExpr.Range @@ -8365,10 +8365,10 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = | SynExpr.ImplicitZero m -> Some(mkSeqEmpty cenv env m genOuterTy, tpenv ) - | SynExpr.DoBang(_rhsExpr, m) -> + | SynExpr.DoBang (_rhsExpr, m) -> error(Error(FSComp.SR.tcDoBangIllegalInSequenceExpression(), m)) - | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m) -> + | SynExpr.Sequential (sp, true, innerComp1, innerComp2, m) -> // "expr; cexpr" is treated as sequential execution // "cexpr; cexpr" is treated as append match tryTcSequenceExprBody env genOuterTy tpenv innerComp1 with @@ -8376,7 +8376,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = let innerExpr1, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv innerComp1 let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 - Some(Expr.Sequential(innerExpr1, innerExpr2, NormalSeq, sp, m), tpenv) + Some(Expr.Sequential (innerExpr1, innerExpr2, NormalSeq, sp, m), tpenv) | Some (innerExpr1, tpenv) -> let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 @@ -8415,7 +8415,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = //SEQPOINT NEEDED - we must consume spBind on this path Some(mkSeqUsing cenv env wholeExprMark bindPatTy genOuterTy inputExpr consumeExpr, tpenv) - | SynExpr.LetOrUseBang(_, _, _, _, _, _, m) -> + | SynExpr.LetOrUseBang (_, _, _, _, _, _, m) -> error(Error(FSComp.SR.tcUseForInSequenceExpression(), m)) | SynExpr.Match (spMatch, expr, clauses, _) -> @@ -8436,7 +8436,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = | SynExpr.TryWith (_, mTryToWith, _, _, _, _, _) -> error(Error(FSComp.SR.tcTryIllegalInSequenceExpression(), mTryToWith)) - | SynExpr.YieldOrReturnFrom((isYield, _), yieldExpr, m) -> + | SynExpr.YieldOrReturnFrom ((isYield, _), yieldExpr, m) -> let resultExpr, genExprTy, tpenv = TcExprOfUnknownType cenv env tpenv yieldExpr if not isYield then errorR(Error(FSComp.SR.tcUseYieldBangForMultipleResults(), m)) @@ -8444,7 +8444,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genOuterTy genExprTy Some(mkCoerceExpr(resultExpr, genOuterTy, m, genExprTy), tpenv) - | SynExpr.YieldOrReturn((isYield, _), yieldExpr, m) -> + | SynExpr.YieldOrReturn ((isYield, _), yieldExpr, m) -> let genResultTy = NewInferenceType () if not isYield then errorR(Error(FSComp.SR.tcSeqResultsUseYield(), m)) UnifyTypes cenv env m genOuterTy (mkSeqTy cenv.g genResultTy) @@ -8463,7 +8463,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = let m = comp.Range let env = { env with eContextInfo = ContextInfo.SequenceExpression genOuterTy } let expr, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp - Expr.Sequential(expr, mkSeqEmpty cenv env m genOuterTy, NormalSeq, SuppressSequencePointOnStmtOfSequential, m), tpenv + Expr.Sequential (expr, mkSeqEmpty cenv env m genOuterTy, NormalSeq, SuppressSequencePointOnStmtOfSequential, m), tpenv let coreExpr, tpenv = tcSequenceExprBody env overallTy tpenv comp let delayedExpr = mkDelayedExpr coreExpr @@ -8517,7 +8517,7 @@ and Propagate cenv overallTy env tpenv (expr: ApplicableExpr) exprty delayed = // See RFC FS-1053.md let isAddrOf = match expr with - | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [], _), _) + | ApplicableExpr(_, Expr.App (Expr.Val (vf, _, _), _, _, [], _), _) when (valRefEq cenv.g vf cenv.g.addrof_vref || valRefEq cenv.g vf cenv.g.nativeptr_tobyref_vref) -> true | _ -> false @@ -8565,7 +8565,7 @@ and TcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFlag: ExprAtomic | DelayedDot :: _ -> UnifyTypes cenv env mExpr overallTy exprty expr.Expr, tpenv - // expr.M(args) where x.M is a .NET method or index property + // Expr.M (args) where x.M is a .NET method or index property // expr.M(args) where x.M is a .NET method or index property // expr.M where x.M is a .NET method or index property | DelayedDotLookup (longId, mDotLookup) :: otherDelayed -> @@ -8622,7 +8622,7 @@ and TcFunctionApplicationThen cenv overallTy env tpenv mExprAndArg expr exprty ( !isNotNakedRefCell || (match expr with - | ApplicableExpr(_, Expr.Op(TOp.Coerce, _, [Expr.App(Expr.Val(vf, _, _), _, _, _, _)], _), _) when valRefEq cenv.g vf cenv.g.seq_vref -> true + | ApplicableExpr(_, Expr.Op (TOp.Coerce, _, [Expr.App (Expr.Val (vf, _, _), _, _, _, _)], _), _) when valRefEq cenv.g vf cenv.g.seq_vref -> true | _ -> false) | _ -> () @@ -8698,8 +8698,8 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let (|FittedArgs|_|) arg = match arg with - | SynExprParen(SynExpr.Tuple(false, args, _, _), _, _, _) - | SynExpr.Tuple(false, args, _, _) when numArgTys > 1 -> Some args + | SynExprParen(SynExpr.Tuple (false, args, _, _), _, _, _) + | SynExpr.Tuple (false, args, _, _) when numArgTys > 1 -> Some args | SynExprParen(arg, _, _, _) | arg when numArgTys = 1 -> Some [arg] | _ -> None @@ -8743,8 +8743,8 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del if isNull(box fittedArgs.[i]) then fittedArgs.[i] <- arg let argContainerOpt = match item with - | Item.UnionCase(uci, _) -> Some(ArgumentContainer.UnionCase(uci)) - | Item.ExnCase tref -> Some(ArgumentContainer.Type(tref)) + | Item.UnionCase(uci, _) -> Some(ArgumentContainer.UnionCase uci) + | Item.ExnCase tref -> Some(ArgumentContainer.Type tref) | _ -> None let argItem = Item.ArgName (argNames.[i], argTys.[i], argContainerOpt) CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, argItem, argItem, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, ad) @@ -8970,35 +8970,35 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let logicalCompiledName = ComputeLogicalName id memberFlags let traitInfo = TTrait(argTys, logicalCompiledName, memberFlags, argTys, Some retTy, sln) - let expr = Expr.Op(TOp.TraitCall(traitInfo), [], ves, mItem) + let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) let expr = mkLambdas mItem [] vs (expr, retTy) let rec isSimpleArgument e = match e with - | SynExpr.New(_, _, synExpr, _) - | SynExpr.Paren(synExpr, _, _, _) - | SynExpr.Typed(synExpr, _, _) + | SynExpr.New (_, _, synExpr, _) + | SynExpr.Paren (synExpr, _, _, _) + | SynExpr.Typed (synExpr, _, _) | SynExpr.TypeApp (synExpr, _, _, _, _, _, _) | SynExpr.TypeTest (synExpr, _, _) - | SynExpr.Upcast(synExpr, _, _) - | SynExpr.DotGet(synExpr, _, _, _) - | SynExpr.Downcast(synExpr, _, _) - | SynExpr.InferredUpcast(synExpr, _) - | SynExpr.InferredDowncast(synExpr, _) - | SynExpr.AddressOf(_, synExpr, _, _) - | SynExpr.Quote(_, _, synExpr, _, _) -> isSimpleArgument synExpr + | SynExpr.Upcast (synExpr, _, _) + | SynExpr.DotGet (synExpr, _, _, _) + | SynExpr.Downcast (synExpr, _, _) + | SynExpr.InferredUpcast (synExpr, _) + | SynExpr.InferredDowncast (synExpr, _) + | SynExpr.AddressOf (_, synExpr, _, _) + | SynExpr.Quote (_, _, synExpr, _, _) -> isSimpleArgument synExpr | SynExpr.Null _ | SynExpr.Ident _ | SynExpr.Const _ | SynExpr.LongIdent _ -> true - | SynExpr.Tuple(_, synExprs, _, _) - | SynExpr.ArrayOrList(_, synExprs, _) -> synExprs |> List.forall isSimpleArgument - | SynExpr.Record(_, copyOpt, fields, _) -> copyOpt |> Option.forall (fst >> isSimpleArgument) && fields |> List.forall (p23 >> Option.forall isSimpleArgument) + | SynExpr.Tuple (_, synExprs, _, _) + | SynExpr.ArrayOrList (_, synExprs, _) -> synExprs |> List.forall isSimpleArgument + | SynExpr.Record (_, copyOpt, fields, _) -> copyOpt |> Option.forall (fst >> isSimpleArgument) && fields |> List.forall (p23 >> Option.forall isSimpleArgument) | SynExpr.App (_, _, synExpr, synExpr2, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 - | SynExpr.IfThenElse(synExpr, synExpr2, synExprOpt, _, _, _, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 && Option.forall isSimpleArgument synExprOpt - | SynExpr.DotIndexedGet(synExpr, _, _, _) -> isSimpleArgument synExpr + | SynExpr.IfThenElse (synExpr, synExpr2, synExprOpt, _, _, _, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 && Option.forall isSimpleArgument synExprOpt + | SynExpr.DotIndexedGet (synExpr, _, _, _) -> isSimpleArgument synExpr | SynExpr.ObjExpr _ | SynExpr.AnonRecd _ | SynExpr.While _ @@ -9028,9 +9028,9 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | SynExpr.LibraryOnlyStaticOptimization _ | SynExpr.LibraryOnlyUnionCaseFieldGet _ | SynExpr.LibraryOnlyUnionCaseFieldSet _ - | SynExpr.ArbitraryAfterError(_, _) - | SynExpr.FromParseError(_, _) - | SynExpr.DiscardAfterMissingQualificationAfterDot(_, _) + | SynExpr.ArbitraryAfterError (_, _) + | SynExpr.FromParseError (_, _) + | SynExpr.DiscardAfterMissingQualificationAfterDot (_, _) | SynExpr.ImplicitZero _ | SynExpr.YieldOrReturn _ | SynExpr.YieldOrReturnFrom _ @@ -9132,7 +9132,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del if pinfo.IsIndexer then GetMemberApplicationArgs delayed cenv env tpenv else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv - if not pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsNotStatic(nm), mItem)) + if not pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsNotStatic nm, mItem)) match delayed with | DelayedSet(e2, mStmt) :: otherDelayed -> if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) @@ -9144,7 +9144,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let isByrefMethReturnSetter = meths |> List.exists (function (_,Some pinfo) -> isByrefTy g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false) if isByrefMethReturnSetter then // x.P <- ... byref setter - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm), mItem)) + if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed else error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) @@ -9156,7 +9156,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | _ -> // Static Property Get (possibly indexer) let meths = pinfos |> GettersOfPropInfos - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm), mItem)) + if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) // Note: static calls never mutate a struct object argument TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed @@ -9179,7 +9179,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let expr = match finfo.LiteralValue with | Some lit -> - Expr.Const(TcFieldInit mItem lit, mItem, exprty) + Expr.Const (TcFieldInit mItem lit, mItem, exprty) | None -> let isValueType = finfo.IsValueType let valu = if isValueType then AsValue else AsObject @@ -9217,7 +9217,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let expr = match rfinfo.LiteralValue with // Get literal F# field - | Some lit -> Expr.Const(lit, mItem, exprty) + | Some lit -> Expr.Const (lit, mItem, exprty) // Get static F# field | None -> mkStaticRecdFieldGet (fref, rfinfo.TypeInst, mItem) PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed @@ -9230,7 +9230,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del // 'delayed' is about to be dropped on the floor, first do rudimentary checking to get name resolutions in its body RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects_Delayed cenv env tpenv delayed match usageTextOpt() with - | None -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly(nm), mItem)) + | None -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly nm, mItem)) | Some usageText -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly2(nm, usageText), mItem)) | _ -> error(Error(FSComp.SR.tcLookupMayNotBeUsedHere(), mItem)) @@ -9315,7 +9315,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela if pinfo.IsIndexer then GetMemberApplicationArgs delayed cenv env tpenv else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv - if pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsStatic(nm), mItem)) + if pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsStatic nm, mItem)) match delayed with @@ -9329,7 +9329,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let isByrefMethReturnSetter = meths |> List.exists (function (_,Some pinfo) -> isByrefTy cenv.g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false) if isByrefMethReturnSetter then // x.P <- ... byref setter - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm), mItem)) + if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag delayed else error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) @@ -9340,7 +9340,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela | _ -> // Instance property getter let meths = GettersOfPropInfos pinfos - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm), mItem)) + if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag delayed | Item.RecdField rfinfo -> @@ -9408,8 +9408,8 @@ and TcEventValueThen cenv overallTy env tpenv mItem mExprAndItem objDetails (ein let nm = einfo.EventName let ad = env.eAccessRights match objDetails, einfo.IsStatic with - | Some _, true -> error (Error (FSComp.SR.tcEventIsStatic(nm), mItem)) - | None, false -> error (Error (FSComp.SR.tcEventIsNotStatic(nm), mItem)) + | Some _, true -> error (Error (FSComp.SR.tcEventIsStatic nm, mItem)) + | None, false -> error (Error (FSComp.SR.tcEventIsNotStatic nm, mItem)) | _ -> () let delegateType = einfo.GetDelegateType(cenv.amap, mItem) @@ -9502,9 +9502,9 @@ and TcMethodApplicationThen and GetNewInferenceTypeForMethodArg cenv env tpenv x = match x with | SynExprParen(a, _, _, _) -> GetNewInferenceTypeForMethodArg cenv env tpenv a - | SynExpr.AddressOf(true, a, _, m) -> mkByrefTyWithInference cenv.g (GetNewInferenceTypeForMethodArg cenv env tpenv a) (NewByRefKindInferenceType cenv.g m) - | SynExpr.Lambda(_, _, _, a, _) -> mkFunTy (NewInferenceType ()) (GetNewInferenceTypeForMethodArg cenv env tpenv a) - | SynExpr.Quote(_, raw, a, _, _) -> + | SynExpr.AddressOf (true, a, _, m) -> mkByrefTyWithInference cenv.g (GetNewInferenceTypeForMethodArg cenv env tpenv a) (NewByRefKindInferenceType cenv.g m) + | SynExpr.Lambda (_, _, _, a, _) -> mkFunTy (NewInferenceType ()) (GetNewInferenceTypeForMethodArg cenv env tpenv a) + | SynExpr.Quote (_, raw, a, _, _) -> if raw then mkRawQuotedExprTy cenv.g else mkQuotedExprTy cenv.g (GetNewInferenceTypeForMethodArg cenv env tpenv a) | _ -> NewInferenceType () @@ -9715,7 +9715,7 @@ and TcMethodApplication let minst = FreshenMethInfo mItem minfo let callerTyArgs = match tyargsOpt with - | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs) + | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers tyargs | None -> minst CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt) @@ -9780,7 +9780,7 @@ and TcMethodApplication [| for meth in preArgumentTypeCheckingCalledMethGroup do match ExamineMethodForLambdaPropagation meth with | Some (unnamedInfo, namedInfo) -> - let calledObjArgTys = meth.CalledObjArgTys(mMethExpr) + let calledObjArgTys = meth.CalledObjArgTys mMethExpr if (calledObjArgTys, callerObjArgTys) ||> Seq.forall2 (fun calledTy callerTy -> AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv cenv.css mMethExpr calledTy callerTy) then yield (List.toArraySquared unnamedInfo, List.toArraySquared namedInfo) | None -> () |] @@ -9815,7 +9815,7 @@ and TcMethodApplication preArgumentTypeCheckingCalledMethGroup |> List.map (fun (minfo: MethInfo, minst, pinfoOpt, usesParamArrayConversion) -> let callerTyArgs = match tyargsOpt with - | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs) + | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers tyargs | None -> minst CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt)) @@ -9952,7 +9952,7 @@ and TcMethodApplication let g = cenv.g if isByrefTy g calledArgTy && isRefCellTy g callerArgTy then - None, Expr.Op(TOp.RefAddrGet false, [destRefCellTy g callerArgTy], [callerArgExpr], m) + None, Expr.Op (TOp.RefAddrGet false, [destRefCellTy g callerArgTy], [callerArgExpr], m) #if IMPLICIT_ADDRESS_OF elif isInByrefTy g calledArgTy && not (isByrefTy cenv.g callerArgTy) then @@ -9966,7 +9966,7 @@ and TcMethodApplication elif isLinqExpressionTy cenv.g calledArgTy && isDelegateTy cenv.g (destLinqExpressionTy cenv.g calledArgTy) && isFunTy cenv.g callerArgTy then let delegateTy = destLinqExpressionTy cenv.g calledArgTy let expr = CoerceFromFSharpFuncToDelegate cenv.g cenv.amap cenv.infoReader ad callerArgTy m callerArgExpr delegateTy - None, mkCallQuoteToLinqLambdaExpression cenv.g m delegateTy (Expr.Quote(expr, ref None, false, m, mkQuotedExprTy cenv.g delegateTy)) + None, mkCallQuoteToLinqLambdaExpression cenv.g m delegateTy (Expr.Quote (expr, ref None, false, m, mkQuotedExprTy cenv.g delegateTy)) // auto conversions to quotations (to match auto conversions to LINQ expressions) elif reflArgInfo.AutoQuote && isQuotedExprTy cenv.g calledArgTy && not (isQuotedExprTy cenv.g callerArgTy) then @@ -9974,7 +9974,7 @@ and TcMethodApplication | ReflectedArgInfo.Quote true -> None, mkCallLiftValueWithDefn cenv.g m calledArgTy callerArgExpr | ReflectedArgInfo.Quote false -> - None, Expr.Quote(callerArgExpr, ref None, false, m, calledArgTy) + None, Expr.Quote (callerArgExpr, ref None, false, m, calledArgTy) | ReflectedArgInfo.None -> failwith "unreachable" // unreachable due to reflArgInfo.AutoQuote condition // Note: out args do not need to be coerced @@ -10008,7 +10008,7 @@ and TcMethodApplication let arg = [ { NamedArgIdOpt = None CalledArg=paramArrayCalledArg - CallerArg=CallerArg(paramArrayCalledArg.CalledArgumentType, mMethExpr, false, Expr.Op(TOp.Array, [paramArrayCalledArgElementType], es, mMethExpr)) } ] + CallerArg=CallerArg(paramArrayCalledArg.CalledArgumentType, mMethExpr, false, Expr.Op (TOp.Array, [paramArrayCalledArgElementType], es, mMethExpr)) } ] paramArrayPreBinders, arg // CLEANUP: Move all this code into some isolated file, e.g. "optional.fs" @@ -10052,20 +10052,20 @@ and TcMethodApplication | NullableTy cenv.g inst when fieldInit <> ILFieldInit.Null -> let nullableTy = mkILNonGenericBoxedTy(cenv.g.FindSysILTypeRef "System.Nullable`1") let ctor = mkILCtorMethSpecForTy(nullableTy, [ILType.TypeVar 0us]).MethodRef - let ctorArgs = [Expr.Const(TcFieldInit mMethExpr fieldInit, mMethExpr, inst)] - emptyPreBinder, Expr.Op(TOp.ILCall(false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr) + let ctorArgs = [Expr.Const (TcFieldInit mMethExpr fieldInit, mMethExpr, inst)] + emptyPreBinder, Expr.Op (TOp.ILCall (false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr) | ByrefTy cenv.g inst -> build inst (PassByRef(inst, currDfltVal)) | _ -> match calledArg.CallerInfo, env.eCallerMemberName with | CallerLineNumber, _ when typeEquiv cenv.g currCalledArgTy cenv.g.int_ty -> - emptyPreBinder, Expr.Const(Const.Int32(mMethExpr.StartLine), mMethExpr, currCalledArgTy) + emptyPreBinder, Expr.Const (Const.Int32(mMethExpr.StartLine), mMethExpr, currCalledArgTy) | CallerFilePath, _ when typeEquiv cenv.g currCalledArgTy cenv.g.string_ty -> - emptyPreBinder, Expr.Const(Const.String(FileSystem.GetFullPathShim(mMethExpr.FileName)), mMethExpr, currCalledArgTy) - | CallerMemberName, Some(callerName) when (typeEquiv cenv.g currCalledArgTy cenv.g.string_ty) -> - emptyPreBinder, Expr.Const(Const.String(callerName), mMethExpr, currCalledArgTy) + emptyPreBinder, Expr.Const (Const.String(FileSystem.GetFullPathShim(mMethExpr.FileName)), mMethExpr, currCalledArgTy) + | CallerMemberName, Some callerName when (typeEquiv cenv.g currCalledArgTy cenv.g.string_ty) -> + emptyPreBinder, Expr.Const (Const.String callerName, mMethExpr, currCalledArgTy) | _ -> - emptyPreBinder, Expr.Const(TcFieldInit mMethExpr fieldInit, mMethExpr, currCalledArgTy) + emptyPreBinder, Expr.Const (TcFieldInit mMethExpr fieldInit, mMethExpr, currCalledArgTy) | WrapperForIDispatch -> match cenv.g.TryFindSysILTypeRef "System.Runtime.InteropServices.DispatchWrapper" with @@ -10073,7 +10073,7 @@ and TcMethodApplication | Some tref -> let ty = mkILNonGenericBoxedTy tref let mref = mkILCtorMethSpecForTy(ty, [cenv.g.ilg.typ_Object]).MethodRef - let expr = Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [cenv.g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) + let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [cenv.g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) emptyPreBinder, expr | WrapperForIUnknown -> match cenv.g.TryFindSysILTypeRef "System.Runtime.InteropServices.UnknownWrapper" with @@ -10081,7 +10081,7 @@ and TcMethodApplication | Some tref -> let ty = mkILNonGenericBoxedTy tref let mref = mkILCtorMethSpecForTy(ty, [cenv.g.ilg.typ_Object]).MethodRef - let expr = Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [cenv.g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) + let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [cenv.g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) emptyPreBinder, expr | PassByRef (ty, dfltVal2) -> let v, _ = mkCompGenLocal mMethExpr "defaultByrefArg" ty @@ -10097,13 +10097,13 @@ and TcMethodApplication match calledArg.CallerInfo, env.eCallerMemberName with | CallerLineNumber, _ when typeEquiv cenv.g calledNonOptTy cenv.g.int_ty -> - let lineExpr = Expr.Const(Const.Int32(mMethExpr.StartLine), mMethExpr, calledNonOptTy) + let lineExpr = Expr.Const (Const.Int32(mMethExpr.StartLine), mMethExpr, calledNonOptTy) emptyPreBinder, mkUnionCaseExpr(mkSomeCase cenv.g, [calledNonOptTy], [lineExpr], mMethExpr) | CallerFilePath, _ when typeEquiv cenv.g calledNonOptTy cenv.g.string_ty -> - let filePathExpr = Expr.Const(Const.String(FileSystem.GetFullPathShim(mMethExpr.FileName)), mMethExpr, calledNonOptTy) + let filePathExpr = Expr.Const (Const.String(FileSystem.GetFullPathShim(mMethExpr.FileName)), mMethExpr, calledNonOptTy) emptyPreBinder, mkUnionCaseExpr(mkSomeCase cenv.g, [calledNonOptTy], [filePathExpr], mMethExpr) - | CallerMemberName, Some(callerName) when typeEquiv cenv.g calledNonOptTy cenv.g.string_ty -> - let memberNameExpr = Expr.Const(Const.String(callerName), mMethExpr, calledNonOptTy) + | CallerMemberName, Some callerName when typeEquiv cenv.g calledNonOptTy cenv.g.string_ty -> + let memberNameExpr = Expr.Const (Const.String callerName, mMethExpr, calledNonOptTy) emptyPreBinder, mkUnionCaseExpr(mkSomeCase cenv.g, [calledNonOptTy], [memberNameExpr], mMethExpr) | _ -> emptyPreBinder, mkUnionCaseExpr(mkNoneCase cenv.g, [calledNonOptTy], [], mMethExpr) @@ -10185,7 +10185,7 @@ and TcMethodApplication match assignedArg.NamedArgIdOpt with | None -> () | Some id -> - let item = Item.ArgName (defaultArg assignedArg.CalledArg.NameOpt id, assignedArg.CalledArg.CalledArgumentType, Some(ArgumentContainer.Method(finalCalledMethInfo))) + let item = Item.ArgName (defaultArg assignedArg.CalledArg.NameOpt id, assignedArg.CalledArg.CalledArgumentType, Some(ArgumentContainer.Method finalCalledMethInfo)) CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, ad)) let allArgsPreBinders, allArgsCoerced = List.map coerce allArgs |> List.unzip @@ -10424,7 +10424,7 @@ and TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr expr cont = let env = ShrinkContext env m e2.Range // tailcall TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr e2 (fun (e2', tpenv) -> - cont (Expr.Sequential(e1', e2', NormalSeq, sp, m), tpenv)) + cont (Expr.Sequential (e1', e2', NormalSeq, sp, m), tpenv)) | SynExpr.LetOrUse (isRec, isUse, binds, body, m) when not (isUse && isCompExpr) -> if isRec then @@ -10526,7 +10526,7 @@ and mkConvToNativeInt (g: TcGlobals) e m = Expr.Op (TOp.ILAsm ([ AI_conv ILBasic /// Fix up the r.h.s. of a 'use x = fixed expr' and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBinding) = - warning(PossibleUnverifiableCode(mBinding)) + warning(PossibleUnverifiableCode mBinding) match overallExprTy with | ty when isByrefTy cenv.g ty -> let okByRef = @@ -10534,7 +10534,7 @@ and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBindi | Expr.Op (op, tyargs, args, _) -> match op, tyargs, args with | TOp.ValFieldGetAddr (rfref, _), _, [_] -> not rfref.Tycon.IsStructOrEnumTycon - | TOp.ILAsm ([ I_ldflda (fspec)], _), _, _ -> fspec.DeclaringType.Boxity = ILBoxity.AsObject + | TOp.ILAsm ([ I_ldflda fspec], _), _, _ -> fspec.DeclaringType.Boxity = ILBoxity.AsObject | TOp.ILAsm ([ I_ldelema _], _), _, _ -> true | TOp.RefAddrGet _, _, _ -> true | _ -> false @@ -10612,15 +10612,15 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt | ExpressionBinding, _, _ -> envinner.eCallerMemberName | _, _, SynPat.Named(_, name, _, _, _) -> match memberFlagsOpt with - | Some(memberFlags) -> + | Some memberFlags -> match memberFlags.MemberKind with - | MemberKind.PropertyGet | MemberKind.PropertySet | MemberKind.PropertyGetSet -> Some(name.idText.Substring(4)) + | MemberKind.PropertyGet | MemberKind.PropertySet | MemberKind.PropertyGetSet -> Some(name.idText.Substring 4) | MemberKind.ClassConstructor -> Some(".ctor") | MemberKind.Constructor -> Some(".ctor") | _ -> Some(name.idText) | _ -> Some(name.idText) - | ClassLetBinding(false), DoBinding, _ -> Some(".ctor") - | ClassLetBinding(true), DoBinding, _ -> Some(".cctor") + | ClassLetBinding false, DoBinding, _ -> Some(".ctor") + | ClassLetBinding true, DoBinding, _ -> Some(".cctor") | ModuleOrMemberBinding, StandaloneExpression, _ -> Some(".cctor") | _, _, _ -> envinner.eCallerMemberName @@ -10658,7 +10658,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) let isThreadStatic = isThreadOrContextStatic cenv.g valAttribs - if isThreadStatic then errorR(DeprecatedThreadStaticBindingWarning(mBinding)) + if isThreadStatic then errorR(DeprecatedThreadStaticBindingWarning mBinding) if isVolatile then match declKind with @@ -10707,7 +10707,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt // Check the pattern of the l.h.s. of the binding let tcPatPhase2, (tpenv, nameToPrelimValSchemeMap, _) = - TcPat AllIdsOK cenv envinner (Some(partialValReprInfo)) (inlineFlag, flex, argAndRetAttribs, isMutable, vis, compgen) (tpenv, NameMap.empty, Set.empty) overallPatTy pat + TcPat AllIdsOK cenv envinner (Some partialValReprInfo) (inlineFlag, flex, argAndRetAttribs, isMutable, vis, compgen) (tpenv, NameMap.empty, Set.empty) overallPatTy pat // Add active pattern result names to the environment @@ -10788,7 +10788,7 @@ and TcLiteral cenv overallTy env tpenv (attrs, synLiteralValExpr) = if hasLiteralAttr then let literalValExpr, _ = TcExpr cenv overallTy env tpenv synLiteralValExpr match EvalLiteralExprOrAttribArg cenv.g literalValExpr with - | Expr.Const(c, _, ty) -> + | Expr.Const (c, _, ty) -> if c = Const.Zero && isStructTy cenv.g ty then warning(Error(FSComp.SR.tcIllegalStructTypeForConstantExpression(), synLiteralValExpr.Range)) false, None @@ -10850,7 +10850,7 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = let tycon = (typath @ [tyid]) let ad = env.eAccessRights match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with - | Exception err -> raze(err) + | Exception err -> raze err | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv (SynType.App(SynType.LongIdent(LongIdentWithDots(tycon, [])), None, [], [], None, false, mAttr)) ) ForceRaise ((try1 (tyid.idText + "Attribute")) |> ResultOrException.otherwise (fun () -> (try1 tyid.idText))) @@ -10887,11 +10887,11 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = (validOnDefault, inheritedDefault) else match (TryFindFSharpAttribute cenv.g cenv.g.attrib_AttributeUsageAttribute tcref.Attribs) with - | Some(Attrib(_, _, [ AttribInt32Arg(validOn) ], _, _, _, _)) -> + | Some(Attrib(_, _, [ AttribInt32Arg validOn ], _, _, _, _)) -> (validOn, inheritedDefault) - | Some(Attrib(_, _, [ AttribInt32Arg(validOn) + | Some(Attrib(_, _, [ AttribInt32Arg validOn AttribBoolArg(_allowMultiple) - AttribBoolArg(inherited)], _, _, _, _)) -> + AttribBoolArg inherited], _, _, _, _)) -> (validOn, inherited) | Some _ -> warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) @@ -10972,15 +10972,15 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = AttribNamedArg(nm, argty, isProp, mkAttribExpr callerArgExpr)) match expr with - | Expr.Op(TOp.ILCall(_, _, valu, _, _, _, _, ilMethRef, [], [], _rtys), [], args, m) -> + | Expr.Op (TOp.ILCall (_, _, valu, _, _, _, _, ilMethRef, [], [], _rtys), [], args, m) -> if valu then error (Error(FSComp.SR.tcCustomAttributeMustBeReferenceType(), m)) if args.Length <> ilMethRef.ArgTypes.Length then error (Error(FSComp.SR.tcCustomAttributeArgumentMismatch(), m)) let args = args |> List.map mkAttribExpr - Attrib(tcref, ILAttrib(ilMethRef), args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTgts, m) + Attrib(tcref, ILAttrib ilMethRef, args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTgts, m) - | Expr.App((InnerExprPat(ExprValWithPossibleTypeInst(vref, _, _, _))), _, _, args, _) -> - let args = args |> List.collect (function Expr.Const(Const.Unit, _, _) -> [] | expr -> tryDestRefTupleExpr expr) |> List.map mkAttribExpr - Attrib(tcref, FSAttrib(vref), args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTgts, mAttr) + | Expr.App ((InnerExprPat(ExprValWithPossibleTypeInst(vref, _, _, _))), _, _, args, _) -> + let args = args |> List.collect (function Expr.Const (Const.Unit, _, _) -> [] | expr -> tryDestRefTupleExpr expr) |> List.map mkAttribExpr + Attrib(tcref, FSAttrib vref, args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTgts, mAttr) | _ -> error (Error(FSComp.SR.tcCustomAttributeMustInvokeConstructor(), mAttr)) @@ -11058,7 +11058,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds [] else let freeInEnv = lazyFreeInEnv.Force() - let canConstrain = GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl(declKind) + let canConstrain = GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl declKind GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv, denv, m, freeInEnv, canInferTypars, canConstrain, inlineFlag, Some rhsExpr, allDeclaredTypars, maxInferredTypars, tauTy, false) @@ -11168,7 +11168,7 @@ and CheckMemberFlags optIntfSlotTy newslotsOK overridesOK memberFlags m = if overridesOK = ErrorOnOverrides && memberFlags.MemberKind = MemberKind.Constructor then errorR(Error(FSComp.SR.tcConstructorsIllegalInAugmentation(), m)) if overridesOK = WarnOnOverrides && memberFlags.IsOverrideOrExplicitImpl && Option.isNone optIntfSlotTy then - warning(OverrideInIntrinsicAugmentation(m)) + warning(OverrideInIntrinsicAugmentation m) if overridesOK = ErrorOnOverrides && memberFlags.IsOverrideOrExplicitImpl then error(Error(FSComp.SR.tcMethodOverridesIllegalHere(), m)) @@ -11216,7 +11216,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn | Some (ty, abstractSlots) -> // The interface type is in terms of the type's type parameters. // We need a signature in terms of the values' type parameters. - ty, Some(abstractSlots) + ty, Some abstractSlots | None -> tcrefObjTy, None @@ -11253,7 +11253,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn |> Seq.map (sprintf "%s %s" System.Environment.NewLine) |> String.concat "" - errorR(Error(FSComp.SR.tcOverrideArityMismatch(details), memberId.idRange)) + errorR(Error(FSComp.SR.tcOverrideArityMismatch details, memberId.idRange)) [] | _ -> [] // check that method to override is sealed is located at CheckOverridesAreAllUsedOnce (typrelns.fs) // We hit this case when it is ambiguous which abstract method is being implemented. @@ -11373,7 +11373,7 @@ and CheckForNonAbstractInterface declKind tcref memberFlags m = error(Error(FSComp.SR.tcConcreteMembersIllegalInInterface(), m)) //------------------------------------------------------------------------- -// TcLetrec - AnalyzeAndMakeAndPublishRecursiveValue(s) +// TcLetrec - AnalyzeAndMakeAndPublishRecursiveValue s //------------------------------------------------------------------------ and AnalyzeRecursiveStaticMemberOrValDecl @@ -11443,7 +11443,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl let isExtrinsic = (declKind = ExtrinsicExtensionBinding) MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, isExtrinsic, bindingAttribs, [], memberFlags, valSynInfo, id, false) - envinner, tpenv, id, None, Some(memberInfo), vis, vis2, safeThisValOpt, enclosingDeclaredTypars, baseValOpt, flex, bindingRhs, declaredTypars + envinner, tpenv, id, None, Some memberInfo, vis, vis2, safeThisValOpt, enclosingDeclaredTypars, baseValOpt, flex, bindingRhs, declaredTypars // non-member bindings. How easy. | _ -> @@ -11501,7 +11501,7 @@ and AnalyzeRecursiveInstanceMemberDecl // each member that may use it. let baseValOpt = match GetSuperTypeOfType cenv.g cenv.amap mBinding objTy with - | Some(superTy) -> MakeAndPublishBaseVal cenv envinner (match baseValOpt with None -> None | Some v -> Some v.Id) superTy + | Some superTy -> MakeAndPublishBaseVal cenv envinner (match baseValOpt with None -> None | Some v -> Some v.Id) superTy | None -> None let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, isExtrinsic, bindingAttribs, optInferredImplSlotTys, memberFlags, valSynInfo, memberId, false) @@ -11628,7 +11628,7 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv List.concat extraBindings, List.concat extraValues, tpenv, recBindIdx // Create the value - let vspec = MakeAndPublishVal cenv envinner (altActualParent, false, declKind, ValInRecScope(isComplete), prelimValScheme, bindingAttribs, bindingXmlDoc, konst, isGeneratedEventVal) + let vspec = MakeAndPublishVal cenv envinner (altActualParent, false, declKind, ValInRecScope isComplete, prelimValScheme, bindingAttribs, bindingXmlDoc, konst, isGeneratedEventVal) // Suppress hover tip for "get" and "set" at property definitions, where toolId <> bindingId match toolIdOpt with @@ -11958,7 +11958,7 @@ and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgr let maxInferredTypars = freeInTypeLeftToRight cenv.g false tau let canGeneralizeConstrained = GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl rbinfo.DeclKind - let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv, denv, m, freeInEnv, canInferTypars, canGeneralizeConstrained, inlineFlag, Some(expr), allDeclaredTypars, maxInferredTypars, tau, isCtor) + let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv, denv, m, freeInEnv, canInferTypars, canGeneralizeConstrained, inlineFlag, Some expr, allDeclaredTypars, maxInferredTypars, tau, isCtor) generalizedTypars /// Compute the type variables which may have member constraints that need to be canonicalized prior to generalization @@ -11983,7 +11983,7 @@ and TcLetrecGeneralizeBinding cenv denv generalizedTypars (pgrbind: PreGeneraliz let _, tau = vspec.TypeScheme - let pvalscheme1 = PrelimValScheme1(vspec.Id, flex, tau, Some(partialValReprInfo), memberInfoOpt, false, inlineFlag, NormalVal, argAttribs, vis, compgen) + let pvalscheme1 = PrelimValScheme1(vspec.Id, flex, tau, Some partialValReprInfo, memberInfoOpt, false, inlineFlag, NormalVal, argAttribs, vis, compgen) let pvalscheme2 = GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTypars pvalscheme1 let valscheme = UseCombinedArity cenv.g declKind expr pvalscheme2 @@ -12202,13 +12202,13 @@ let TcAndPublishValSpec (cenv, env, containerInfo: ContainerInfo, declKind, memF let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv, denv, id.idRange, emptyFreeTypars, canInferTypars, CanGeneralizeConstrainedTypars, inlineFlag, None, allDeclaredTypars, freeInType, ty, false) - let valscheme1 = PrelimValScheme1(id, flex, ty, Some(partialValReprInfo), memberInfoOpt, mutableFlag, inlineFlag, NormalVal, noArgOrRetAttribs, vis, false) + let valscheme1 = PrelimValScheme1(id, flex, ty, Some partialValReprInfo, memberInfoOpt, mutableFlag, inlineFlag, NormalVal, noArgOrRetAttribs, vis, false) let valscheme2 = GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTypars valscheme1 let tpenv = HideUnscopedTypars generalizedTypars tpenv - let valscheme = BuildValScheme declKind (Some(partialValReprInfo)) valscheme2 + let valscheme = BuildValScheme declKind (Some partialValReprInfo) valscheme2 let konst = match literalExprOpt with @@ -12238,7 +12238,7 @@ exception NotUpperCaseConstructor of range let CheckNamespaceModuleOrTypeName (g: TcGlobals) (id: Ident) = // type names '[]' etc. are used in fslib - if not g.compilingFslib && id.idText.IndexOfAny(IllegalCharactersInTypeAndNamespaceNames) <> -1 then + if not g.compilingFslib && id.idText.IndexOfAny IllegalCharactersInTypeAndNamespaceNames <> -1 then errorR(Error(FSComp.SR.tcInvalidNamespaceModuleTypeUnionName(), id.idRange)) let CheckDuplicates (idf: _ -> Ident) k elems = @@ -12305,7 +12305,7 @@ module TcRecdUnionAndEnumDeclarations = begin let TcNamedFieldDecl cenv env parent isIncrClass tpenv (Field(attribs, isStatic, id, ty, isMutable, xmldoc, vis, m)) = match id with | None -> error (Error(FSComp.SR.tcFieldRequiresName(), m)) - | Some(id) -> TcFieldDecl cenv env parent isIncrClass tpenv (isStatic, attribs, id, false, ty, isMutable, xmldoc.ToXmlDoc(), vis, m) + | Some id -> TcFieldDecl cenv env parent isIncrClass tpenv (isStatic, attribs, id, false, ty, isMutable, xmldoc.ToXmlDoc(), vis, m) let TcNamedFieldDecls cenv env parent isIncrClass tpenv fields = fields |> List.map (TcNamedFieldDecl cenv env parent isIncrClass tpenv) @@ -12330,10 +12330,10 @@ module TcRecdUnionAndEnumDeclarations = begin let mutable synField = Unchecked.defaultof<_> if seen.TryGetValue(f.Name, &synField) then match sf, synField with - | Field(_, _, Some(id), _, _, _, _, _), Field(_, _, Some(_), _, _, _, _, _) -> + | Field(_, _, Some id, _, _, _, _, _), Field(_, _, Some(_), _, _, _, _, _) -> error(Error(FSComp.SR.tcFieldNameIsUsedModeThanOnce(id.idText), id.idRange)) - | Field(_, _, Some(id), _, _, _, _, _), Field(_, _, None, _, _, _, _, _) - | Field(_, _, None, _, _, _, _, _), Field(_, _, Some(id), _, _, _, _, _) -> + | Field(_, _, Some id, _, _, _, _, _), Field(_, _, None, _, _, _, _, _) + | Field(_, _, None, _, _, _, _, _), Field(_, _, Some id, _, _, _, _, _) -> error(Error(FSComp.SR.tcFieldNameConflictsWithGeneratedNameForAnonymousField(id.idText), id.idRange)) | _ -> assert false else @@ -12452,7 +12452,7 @@ let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = let p = match p with | [] -> [] - | (h, _):: t -> if h.StartsWithOrdinal(FsiDynamicModulePrefix) then t else p + | (h, _):: t -> if h.StartsWithOrdinal FsiDynamicModulePrefix then t else p // See https://fslang.uservoice.com/forums/245727-f-language/suggestions/6107641-make-microsoft-prefix-optional-when-using-core-f let isFSharpCoreSpecialCase = @@ -12596,8 +12596,8 @@ module IncrClassChecking = let prelimTyschemeG = TypeScheme(copyOfTyconTypars, ctorTy) let isComplete = ComputeIsComplete copyOfTyconTypars [] ctorTy let topValInfo = InferGenericArityFromTyScheme prelimTyschemeG partialValReprInfo - let ctorValScheme = ValScheme(id, prelimTyschemeG, Some(topValInfo), Some(memberInfo), false, ValInline.Never, NormalVal, vis, false, true, false, false) - let ctorVal = MakeAndPublishVal cenv env (Parent(tcref), false, ModuleOrMemberBinding, ValInRecScope(isComplete), ctorValScheme, attribs, XmlDoc.Empty, None, false) + let ctorValScheme = ValScheme(id, prelimTyschemeG, Some topValInfo, Some memberInfo, false, ValInline.Never, NormalVal, vis, false, true, false, false) + let ctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValInRecScope isComplete, ctorValScheme, attribs, XmlDoc.Empty, None, false) ctorValScheme, ctorVal // We only generate the cctor on demand, because we don't need it if there are no cctor actions. @@ -12615,16 +12615,16 @@ module IncrClassChecking = let partialValReprInfo = TranslateTopValSynInfo m (TcAttributes cenv env) valSynData let prelimTyschemeG = TypeScheme(copyOfTyconTypars, cctorTy) let topValInfo = InferGenericArityFromTyScheme prelimTyschemeG partialValReprInfo - let cctorValScheme = ValScheme(id, prelimTyschemeG, Some(topValInfo), Some(memberInfo), false, ValInline.Never, NormalVal, Some SynAccess.Private, false, true, false, false) + let cctorValScheme = ValScheme(id, prelimTyschemeG, Some topValInfo, Some memberInfo, false, ValInline.Never, NormalVal, Some SynAccess.Private, false, true, false, false) - let cctorVal = MakeAndPublishVal cenv env (Parent(tcref), false, ModuleOrMemberBinding, ValNotInRecScope, cctorValScheme, [(* no attributes*)], XmlDoc.Empty, None, false) + let cctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValNotInRecScope, cctorValScheme, [(* no attributes*)], XmlDoc.Empty, None, false) cctorArgs, cctorVal, cctorValScheme) 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 thisVal = MakeAndPublishVal cenv env (ParentNone, false, ClassLetBinding(false), ValNotInRecScope, thisValScheme, [], XmlDoc.Empty, None, false) + let thisValScheme = ValScheme(thisId, NonGenericTypeScheme thisTy, 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 {TyconRef = tcref @@ -12729,7 +12729,7 @@ module IncrClassChecking = ctorInfo.NameGenerator.FreshCompilerGeneratedName (v.LogicalName, v.Range) else v.LogicalName - nm, takenFieldNames.Add(nm) + nm, takenFieldNames.Add nm let reportIfUnused() = if not v.HasBeenReferenced && not v.IsCompiledAsTopLevel && not (v.DisplayName.StartsWithOrdinal("_")) && not v.IsCompilerGenerated then @@ -12784,11 +12784,11 @@ module IncrClassChecking = // Add the enclosing type parameters on to the function let topValInfo = let (ValReprInfo(tpNames, args, ret)) = topValInfo - ValReprInfo(tpNames@ValReprInfo.InferTyparInfo(copyOfTyconTypars), args, ret) + ValReprInfo(tpNames@ValReprInfo.InferTyparInfo copyOfTyconTypars, args, ret) let prelimTyschemeG = TypeScheme(copyOfTyconTypars@tps, memberTauTy) - let memberValScheme = ValScheme(id, prelimTyschemeG, Some(topValInfo), 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) + let memberValScheme = ValScheme(id, prelimTyschemeG, Some topValInfo, 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) reportIfUnused() InMethod(isStatic, methodVal, topValInfo) @@ -12807,7 +12807,7 @@ module IncrClassChecking = {localRep with ValsWithRepresentation = Zset.add v localRep.ValsWithRepresentation} member localRep.IsValWithRepresentation (v: Val) = - localRep.ValsWithRepresentation.Contains(v) + localRep.ValsWithRepresentation.Contains v member localRep.IsValRepresentedAsLocalVar (v: Val) = match localRep.LookupRepr v with @@ -12815,8 +12815,8 @@ module IncrClassChecking = | _ -> false member localRep.IsValRepresentedAsMethod (v: Val) = - localRep.IsValWithRepresentation(v) && - match localRep.LookupRepr(v) with + localRep.IsValWithRepresentation v && + match localRep.LookupRepr v with | InMethod _ -> true | _ -> false @@ -12827,13 +12827,13 @@ module IncrClassChecking = match localRep.LookupRepr v, thisValOpt with | InVar _, _ -> exprForVal m v - | InField(false, _idx, rfref), Some(thisVal) -> + | InField(false, _idx, rfref), Some thisVal -> let thise = exprForVal m thisVal - mkRecdFieldGetViaExprAddr(thise, rfref, tinst, m) + mkRecdFieldGetViaExprAddr (thise, rfref, tinst, m) | InField(false, _idx, _rfref), None -> error(InternalError("Unexpected missing 'this' variable in MakeValueLookup", m)) | InField(true, idx, rfref), _ -> - let expr = mkStaticRecdFieldGet(rfref, tinst, m) + let expr = mkStaticRecdFieldGet (rfref, tinst, m) MakeCheckSafeInit g tinst safeStaticInitInfo (mkInt g m idx) expr | InMethod(isStatic, methodVal, topValInfo), _ -> @@ -12852,7 +12852,7 @@ module IncrClassChecking = member localRep.MakeValueAssign thisValOpt tinst safeStaticInitInfo v expr m = let g = localRep.RepInfoTcGlobals match localRep.LookupRepr v, thisValOpt with - | InField(false, _, rfref), Some(thisVal) -> + | InField(false, _, rfref), Some thisVal -> let thise = exprForVal m thisVal mkRecdFieldSetViaExprAddr(thise, rfref, tinst, expr, m) | InField(false, _, _rfref), None -> @@ -12868,7 +12868,7 @@ module IncrClassChecking = member localRep.MakeValueGetAddress readonly thisValOpt tinst safeStaticInitInfo v m = let g = localRep.RepInfoTcGlobals match localRep.LookupRepr v, thisValOpt with - | InField(false, _, rfref), Some(thisVal) -> + | InField(false, _, rfref), Some thisVal -> let thise = exprForVal m thisVal mkRecdFieldGetAddrViaExprAddr(readonly, thise, rfref, tinst, m) | InField(false, _, _rfref), None -> @@ -12927,10 +12927,10 @@ module IncrClassChecking = // Rewrite references to applied let-bound-functions-compiled-as-methods // Rewrite references to applied recursive let-bound-functions-compiled-as-methods // Rewrite references to applied recursive generic let-bound-functions-compiled-as-methods - | Expr.App(Expr.Val (ValDeref v, _, _), _, tyargs, args, m) - | Expr.App(Expr.Link {contents = Expr.Val (ValDeref v, _, _) }, _, tyargs, args, m) - | Expr.App(Expr.Link {contents = Expr.App(Expr.Val (ValDeref v, _, _), _, tyargs, [], _) }, _, [], args, m) - when localRep.IsValRepresentedAsMethod(v) && not (cenv.recUses.ContainsKey v) -> + | Expr.App (Expr.Val (ValDeref v, _, _), _, tyargs, args, m) + | Expr.App (Expr.Link {contents = Expr.Val (ValDeref v, _, _) }, _, tyargs, args, m) + | Expr.App (Expr.Link {contents = Expr.App (Expr.Val (ValDeref v, _, _), _, tyargs, [], _) }, _, [], args, m) + when localRep.IsValRepresentedAsMethod v && not (cenv.recUses.ContainsKey v) -> let expr = localRep.MakeValueLookup thisValOpt thisTyInst safeStaticInitInfo v tyargs m let args = args |> List.map rw @@ -12938,20 +12938,20 @@ module IncrClassChecking = // Rewrite references to values stored as fields and first class uses of method values | Expr.Val (ValDeref v, _, m) - when localRep.IsValWithRepresentation(v) -> + when localRep.IsValWithRepresentation v -> //dprintfn "Found use of %s" v.LogicalName Some (localRep.MakeValueLookup thisValOpt thisTyInst safeStaticInitInfo v [] m) // Rewrite assignments to mutable values stored as fields - | Expr.Op(TOp.LValueOp (LSet, ValDeref v), [], [arg], m) - when localRep.IsValWithRepresentation(v) -> + | Expr.Op (TOp.LValueOp (LSet, ValDeref v), [], [arg], m) + when localRep.IsValWithRepresentation v -> let arg = rw arg Some (localRep.MakeValueAssign thisValOpt thisTyInst safeStaticInitInfo v arg m) // Rewrite taking the address of mutable values stored as fields - | Expr.Op(TOp.LValueOp (LAddrOf readonly, ValDeref v), [], [], m) - when localRep.IsValWithRepresentation(v) -> + | Expr.Op (TOp.LValueOp (LAddrOf readonly, ValDeref v), [], [], m) + when localRep.IsValWithRepresentation v -> Some (localRep.MakeValueGetAddress readonly thisValOpt thisTyInst safeStaticInitInfo v m) | _ -> None @@ -13072,8 +13072,8 @@ module IncrClassChecking = | InMethod(isStatic, methodVal, _) -> let _, chooseTps, tauExpr, tauTy, m = match rhsExpr with - | Expr.TyChoose(chooseTps, b, _) -> [], chooseTps, b, (tyOfExpr g b), m - | Expr.TyLambda (_, tps, Expr.TyChoose(chooseTps, b, _), m, returnTy) -> tps, chooseTps, b, returnTy, m + | Expr.TyChoose (chooseTps, b, _) -> [], chooseTps, b, (tyOfExpr g b), m + | Expr.TyLambda (_, tps, Expr.TyChoose (chooseTps, b, _), m, returnTy) -> tps, chooseTps, b, returnTy, m | Expr.TyLambda (_, tps, b, m, returnTy) -> tps, [], b, returnTy, m | e -> [], [], e, (tyOfExpr g e), e.Range @@ -13112,7 +13112,7 @@ module IncrClassChecking = match safeStaticInitInfo with | SafeInitField (rfref, _) -> let setExpr = mkStaticRecdFieldSet (rfref, thisTyInst, mkInt g m idx, m) - let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some(thisVal)) NoSafeInitInfo thisTyInst setExpr + let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) NoSafeInitInfo thisTyInst setExpr Some setExpr | NoSafeInitInfo -> None @@ -13148,7 +13148,7 @@ module IncrClassChecking = ([], actions, methodBinds), reps | IncrClassDo (doExpr, isStatic) -> - let doExpr = reps.FixupIncrClassExprPhase2C cenv (Some(thisVal)) safeStaticInitInfo thisTyInst doExpr + let doExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst doExpr let binder = (fun e -> mkSequential SequencePointsAtSeq doExpr.Range doExpr e) let isPriorToSuperInit = false if isStatic then @@ -13168,7 +13168,7 @@ module IncrClassChecking = | None -> () | Some v -> let setExpr = mkRefCellSet g m ctorInfo.InstanceCtorThisVal.Type (exprForVal m v) (exprForVal m ctorInfo.InstanceCtorThisVal) - let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some(thisVal)) safeStaticInitInfo thisTyInst setExpr + let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst setExpr let binder = (fun e -> mkSequential SequencePointsAtSeq setExpr.Range setExpr e) let isPriorToSuperInit = false yield (isPriorToSuperInit, binder) ] @@ -13182,7 +13182,7 @@ module IncrClassChecking = [ match ctorInfo.InstanceCtorSafeInitInfo with | SafeInitField (rfref, _) -> let setExpr = mkRecdFieldSetViaExprAddr (exprForVal m thisVal, rfref, thisTyInst, mkOne g m, m) - let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some(thisVal)) safeStaticInitInfo thisTyInst setExpr + let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst setExpr let binder = (fun e -> mkSequential SequencePointsAtSeq setExpr.Range setExpr e) let isPriorToSuperInit = false yield (isPriorToSuperInit, binder) @@ -13251,7 +13251,7 @@ module IncrClassChecking = // // As a result, the most natural way to implement this would be to simply capture arg0 if needed // and access all variables via that. This would be done by rewriting the inheritsExpr as follows: - // let inheritsExpr = reps.FixupIncrClassExprPhase2C (Some(thisVal)) thisTyInst inheritsExpr + // let inheritsExpr = reps.FixupIncrClassExprPhase2C (Some thisVal) thisTyInst inheritsExpr // However, the rules of IL mean we are not actually allowed to capture arg0 // and store it as a closure field before the base class constructor is called. // @@ -13261,11 +13261,11 @@ module IncrClassChecking = // (c) rely on the fact that there are no 'let' bindings prior to the inherits expr. let inheritsExpr = match ctorInfo.InstanceCtorSafeThisValOpt with - | Some v when not (reps.IsValRepresentedAsLocalVar (v)) -> + | Some v when not (reps.IsValRepresentedAsLocalVar v) -> // Rewrite the expression to convert it to a load of a field if needed. // We are allowed to load fields from our own object even though we haven't called // the super class constructor yet. - let ldexpr = reps.FixupIncrClassExprPhase2C cenv (Some(thisVal)) safeStaticInitInfo thisTyInst (exprForVal m v) + let ldexpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst (exprForVal m v) mkInvisibleLet m v ldexpr inheritsExpr | _ -> inheritsExpr @@ -13277,7 +13277,7 @@ module IncrClassChecking = let ctorBody = List.foldBack (fun (_, binder) acc -> binder acc) ctorInitActionsPre ctorBody // Add the final wrapping to make this into a method - let ctorBody = mkMemberLambdas m [] (Some(thisVal)) ctorInfo.InstanceCtorBaseValOpt [ctorInfo.InstanceCtorArgs] (ctorBody, g.unit_ty) + let ctorBody = mkMemberLambdas m [] (Some thisVal) ctorInfo.InstanceCtorBaseValOpt [ctorInfo.InstanceCtorArgs] (ctorBody, g.unit_ty) ctorBody @@ -13292,7 +13292,7 @@ module IncrClassChecking = // Reconstitute the type of the implicit class constructor with the correct quantified type variables. cctorVal.SetType (mkForallTyIfNeeded ctorDeclaredTypars cctorVal.TauType) let cctorBody = mkMemberLambdas m [] None None [cctorArgs] (cctorInitAction, g.unit_ty) - Some(cctorBody) + Some cctorBody ctorBody, cctorBodyOpt, methodBinds, reps @@ -13500,7 +13500,7 @@ module MutRecBindingChecking = | MemberKind.Constructor -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembersNotConstructors(), m)) | _ -> () let rbind = NormalizedRecBindingDefn(containerInfo, newslotsOK, declKind, bind) - let overridesOK = DeclKind.CanOverrideOrImplement(declKind) + let overridesOK = DeclKind.CanOverrideOrImplement declKind let (binds, _values), (tpenv, recBindIdx) = AnalyzeAndMakeAndPublishRecursiveValue overridesOK false cenv envForTycon (tpenv, recBindIdx) rbind let cbinds = [ for rbind in binds -> Phase2AMember rbind ] @@ -13669,14 +13669,14 @@ module MutRecBindingChecking = if isRec then // Type check local recursive binding - let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(ExprContainerInfo, NoNewSlots, ClassLetBinding(isStatic), bind)) + let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(ExprContainerInfo, NoNewSlots, ClassLetBinding isStatic, bind)) let binds, env, tpenv = TcLetrec ErrorOnOverrides cenv envForBinding tpenv (binds, scopem(*bindsm*), scopem) let bindRs = [IncrClassBindingGroup(binds, isStatic, true)] binds, bindRs, env, tpenv else // Type check local binding - let binds, env, tpenv = TcLetBindings cenv envForBinding ExprContainerInfo (ClassLetBinding(isStatic)) tpenv (binds, bindsm, scopem) + let binds, env, tpenv = TcLetBindings cenv envForBinding ExprContainerInfo (ClassLetBinding isStatic) tpenv (binds, bindsm, scopem) let binds, bindRs = binds |> List.map (function @@ -13699,7 +13699,7 @@ module MutRecBindingChecking = match TryFindIntrinsicMethInfo cenv.infoReader bind.Var.Range ad nm ty, TryFindPropInfo cenv.infoReader bind.Var.Range ad nm ty with | [], [] -> () - | _ -> errorR (Error(FSComp.SR.tcMemberAndLocalClassBindingHaveSameName(nm), bind.Var.Range)) + | _ -> errorR (Error(FSComp.SR.tcMemberAndLocalClassBindingHaveSameName nm, bind.Var.Range)) // Also add static entries to the envInstance if necessary let envInstance = (if isStatic then (binds, envInstance) ||> List.foldBack (fun b e -> AddLocalVal cenv.tcSink scopem b.Var e) else env) @@ -13881,7 +13881,7 @@ module MutRecBindingChecking = if tcref.IsStructOrEnumTycon then mkUnit g tcref.Range, false, None, defnCs else - let inheritsExpr, _ = TcNewExpr cenv envForDecls tpenv g.obj_ty None true (SynExpr.Const(SynConst.Unit, tcref.Range)) tcref.Range + let inheritsExpr, _ = TcNewExpr cenv envForDecls tpenv g.obj_ty None true (SynExpr.Const (SynConst.Unit, tcref.Range)) tcref.Range inheritsExpr, false, None, defnCs let envForTycon = MakeInnerEnvForTyconRef envForDecls tcref false @@ -13909,7 +13909,7 @@ module MutRecBindingChecking = let localDecs = [ for localDec in localDecs do match localDec with - | Phase2CIncrClassBindings(binds) -> yield Phase2CBindings binds + | Phase2CIncrClassBindings binds -> yield Phase2CBindings binds | Phase2CIncrClassCtorJustAfterSuperInit -> yield Phase2CCtorJustAfterSuperInit | Phase2CIncrClassCtorJustAfterLastLet -> yield Phase2CCtorJustAfterLastLet | _ -> () ] @@ -13925,7 +13925,7 @@ module MutRecBindingChecking = @ ( match cctorBodyLambdaExprOpt with | None -> [] - | Some(cctorBodyLambdaExpr) -> + | Some cctorBodyLambdaExpr -> [ (let _, cctorVal, cctorValScheme = incrClassCtorLhs.StaticCtorValInfo.Force() let cctorValueExprBinding = TBind(cctorVal, cctorBodyLambdaExpr, NoSequencePointAtStickyBinding) let rbind = { ValScheme = cctorValScheme; Binding = cctorValueExprBinding } @@ -14075,7 +14075,7 @@ module MutRecBindingChecking = decls |> MutRecShapes.topTycons |> List.collect (fun (TyconBindingsPhase2A(_, _, _, _, _, _, defnAs)) -> [ for defnB in defnAs do match defnB with - | Phase2AIncrClassCtor (incrClassCtorLhs) -> yield incrClassCtorLhs.InstanceCtorVal + | Phase2AIncrClassCtor incrClassCtorLhs -> yield incrClassCtorLhs.InstanceCtorVal | _ -> () ]) let envForDeclsUpdated = @@ -14177,7 +14177,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: let g = cenv.g let interfacesFromTypeDefn envForTycon tyconMembersData = let (MutRecDefnsPhase2DataForTycon(_, _, declKind, tcref, _, _, declaredTyconTypars, members, _, _, _)) = tyconMembersData - let overridesOK = DeclKind.CanOverrideOrImplement(declKind) + let overridesOK = DeclKind.CanOverrideOrImplement declKind members |> List.collect (function | SynMemberDefn.Interface(ity, defnOpt, _) -> let _, ty = if tcref.Deref.IsExceptionDecl then [], g.exn_ty else generalizeTyconRef tcref @@ -14203,7 +14203,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: if overridesOK = ErrorOnOverrides then errorR(IntfImplInExtrinsicAugmentation(ity.Range)) match defnOpt with - | Some(defn) -> [ (ity', defn, m) ] + | Some defn -> [ (ity', defn, m) ] | _-> [] | _ -> []) @@ -14492,7 +14492,7 @@ module TyconConstraintInference = // If the type was excluded, say why if not res then match TryFindFSharpBoolAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs with - | Some(true) -> + | Some true -> match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsComparison tycon >> not) with | None -> assert false @@ -14502,7 +14502,7 @@ module TyconConstraintInference = errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) else errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) - | Some(false) -> + | Some false -> () | None -> @@ -14634,7 +14634,7 @@ module TyconConstraintInference = errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) else () - | Some(false) -> + | Some false -> () | None -> if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then @@ -14685,7 +14685,7 @@ let CheckForDuplicateConcreteType env nm m = let CheckForDuplicateModule env nm m = let curr = GetCurrAccumulatedModuleOrNamespaceType env - if curr.ModulesAndNamespacesByDemangledName.ContainsKey(nm) then + if curr.ModulesAndNamespacesByDemangledName.ContainsKey nm then errorR (Duplicate(FSComp.SR.tcTypeOrModule(), nm, m)) @@ -14698,7 +14698,7 @@ module TcExceptionDeclarations = let TcExnDefnCore_Phase1A cenv env parent (SynExceptionDefnRepr(synAttrs, UnionCase(_, id, _, _, _, _), _, doc, vis, m)) = let attrs = TcAttributes cenv env AttributeTargets.ExnDecl synAttrs - if not (String.isUpper id.idText) then errorR(NotUpperCaseConstructor(m)) + if not (String.isUpper id.idText) then errorR(NotUpperCaseConstructor m) let vis, cpath = ComputeAccessAndCompPath env None m vis None parent let vis = TcRecdUnionAndEnumDeclarations.CombineReprAccess parent vis CheckForDuplicateConcreteType env (id.idText + "Exception") id.idRange @@ -14872,7 +14872,7 @@ module EstablishTypeDefinitionCores = let private GetStructuralElementsOfTyconDefn cenv env tpenv (MutRecDefnsPhase1DataForTycon(_, synTyconRepr, _, _, _, _)) tycon = let thisTyconRef = mkLocalTyconRef tycon let m = tycon.Range - let env = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars(m)) env + let env = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) env let env = MakeInnerEnvForTyconRef env thisTyconRef false [ match synTyconRepr with | SynTypeDefnSimpleRepr.None _ -> () @@ -15257,7 +15257,7 @@ module EstablishTypeDefinitionCores = Import.ImportProvidedType cenv.amap m, isSuppressRelocate, m=m, cpath=cpath, access = access) - eref.ModuleOrNamespaceType.AddProvidedTypeEntity(nestedTycon) + eref.ModuleOrNamespaceType.AddProvidedTypeEntity nestedTycon let nestedTyRef = eref.NestedTyconRef nestedTycon let ilOrigTypeRef = GetOriginalILTypeRefOfProvidedType (st, m) @@ -15337,7 +15337,7 @@ module EstablishTypeDefinitionCores = let hasMeasureAttr = HasFSharpAttribute cenv.g cenv.g.attrib_MeasureAttribute attrs let hasMeasureableAttr = HasFSharpAttribute cenv.g cenv.g.attrib_MeasureableAttribute attrs - let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars(m)) envinner + let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner let envinner = MakeInnerEnvForTyconRef envinner thisTyconRef false match synTyconRepr with @@ -15373,7 +15373,7 @@ module EstablishTypeDefinitionCores = if not firstPass then let ftyvs = freeInTypeLeftToRight cenv.g false ty - let typars = tycon.Typars(m) + let typars = tycon.Typars m if ftyvs.Length <> typars.Length then errorR(Deprecated(FSComp.SR.tcTypeAbbreviationHasTypeParametersMissingOnType(), tycon.Range)) @@ -15399,7 +15399,7 @@ module EstablishTypeDefinitionCores = let (MutRecDefnsPhase1DataForTycon(_, synTyconRepr, explicitImplements, _, _, _)) = typeDefCore let m = tycon.Range let tcref = mkLocalTyconRef tycon - let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars(m)) envinner + let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner let envinner = MakeInnerEnvForTyconRef envinner tcref false let implementedTys, _ = List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkCxs ItemOccurence.UseInType envinner)) tpenv explicitImplements @@ -15520,7 +15520,7 @@ module EstablishTypeDefinitionCores = let hasCLIMutable = HasFSharpAttribute g g.attrib_CLIMutableAttribute attrs let structLayoutAttr = TryFindFSharpInt32Attribute g g.attrib_StructLayoutAttribute attrs - let hasAllowNullLiteralAttr = TryFindFSharpBoolAttribute g g.attrib_AllowNullLiteralAttribute attrs = Some(true) + let hasAllowNullLiteralAttr = TryFindFSharpBoolAttribute g g.attrib_AllowNullLiteralAttribute attrs = Some true if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true @@ -15539,22 +15539,22 @@ module EstablishTypeDefinitionCores = tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) - let structLayoutAttributeCheck(allowed) = + let structLayoutAttributeCheck allowed = let explicitKind = int32 System.Runtime.InteropServices.LayoutKind.Explicit match structLayoutAttr with | Some kind -> if allowed then if kind = explicitKind then - warning(PossibleUnverifiableCode(m)) + warning(PossibleUnverifiableCode m) elif List.isEmpty (thisTyconRef.Typars m) then errorR (Error(FSComp.SR.tcOnlyStructsCanHaveStructLayout(), m)) else errorR (Error(FSComp.SR.tcGenericTypesCannotHaveStructLayout(), m)) | None -> () - let hiddenReprChecks(hasRepr) = - structLayoutAttributeCheck(false) - if hasSealedAttr = Some(false) || (hasRepr && hasSealedAttr <> Some(true) && not (id.idText = "Unit" && g.compilingFslib) ) then + let hiddenReprChecks hasRepr = + structLayoutAttributeCheck false + if hasSealedAttr = Some false || (hasRepr && hasSealedAttr <> Some true && not (id.idText = "Unit" && g.compilingFslib) ) then errorR(Error(FSComp.SR.tcRepresentationOfTypeHiddenBySignature(), m)) if hasAbstractAttr then errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(), m)) @@ -15565,8 +15565,8 @@ module EstablishTypeDefinitionCores = let noCLIMutableAttributeCheck() = if hasCLIMutable then errorR (Error(FSComp.SR.tcThisTypeMayNotHaveACLIMutableAttribute(), m)) - let noSealedAttributeCheck(k) = - if hasSealedAttr = Some(true) then errorR (Error(k(), m)) + let noSealedAttributeCheck k = + if hasSealedAttr = Some true then errorR (Error(k(), m)) let noFieldsCheck(fields': RecdField list) = match fields' with @@ -15574,7 +15574,7 @@ module EstablishTypeDefinitionCores = | _ -> () - let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars(m)) envinner + let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner let envinner = MakeInnerEnvForTyconRef envinner thisTyconRef false @@ -15614,7 +15614,7 @@ module EstablishTypeDefinitionCores = TNoRepr, None, NoSafeInitInfo | SynTypeDefnSimpleRepr.None _ -> - hiddenReprChecks(false) + hiddenReprChecks false noAllowNullLiteralAttributeCheck() if hasMeasureAttr then let repr = TFSharpObjectRepr { fsobjmodel_kind=TTyconClass @@ -15630,7 +15630,7 @@ module EstablishTypeDefinitionCores = // "type x = | A" can always be used instead. | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) (unionCaseName, _) -> - structLayoutAttributeCheck(false) + structLayoutAttributeCheck false noAllowNullLiteralAttributeCheck() TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName let unionCase = NewUnionCase unionCaseName [] thisTy [] XmlDoc.Empty tycon.Accessibility @@ -15641,7 +15641,7 @@ module EstablishTypeDefinitionCores = TNoRepr, None, NoSafeInitInfo | SynTypeDefnSimpleRepr.TypeAbbrev(ParserDetail.Ok, rhsType, _) -> - if hasSealedAttr = Some(true) then + if hasSealedAttr = Some true then errorR (Error(FSComp.SR.tcAbbreviatedTypesCannotBeSealed(), m)) noAbstractClassAttributeCheck() noAllowNullLiteralAttributeCheck() @@ -15662,7 +15662,7 @@ module EstablishTypeDefinitionCores = noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDU noAbstractClassAttributeCheck() noAllowNullLiteralAttributeCheck() - structLayoutAttributeCheck(false) + structLayoutAttributeCheck false let unionCases = TcRecdUnionAndEnumDeclarations.TcUnionCaseDecls cenv envinner innerParent thisTy tpenv unionCases if tycon.IsStructRecordOrUnionTycon && unionCases.Length > 1 then @@ -15678,7 +15678,7 @@ module EstablishTypeDefinitionCores = noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedRecord noAbstractClassAttributeCheck() noAllowNullLiteralAttributeCheck() - structLayoutAttributeCheck(true) // these are allowed for records + structLayoutAttributeCheck true // these are allowed for records let recdFields = TcRecdUnionAndEnumDeclarations.TcNamedFieldDecls cenv envinner innerParent false tpenv fields recdFields |> CheckDuplicates (fun f -> f.Id) "field" |> ignore writeFakeRecordFieldsToSink recdFields @@ -15689,7 +15689,7 @@ module EstablishTypeDefinitionCores = noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedAssemblyCode noAllowNullLiteralAttributeCheck() - structLayoutAttributeCheck(false) + structLayoutAttributeCheck false noAbstractClassAttributeCheck() TAsmRepr s, None, NoSafeInitInfo @@ -15713,11 +15713,11 @@ module EstablishTypeDefinitionCores = writeFakeRecordFieldsToSink userFields let superTy = tycon.TypeContents.tcaug_super - let containerInfo = TyconContainerInfo(innerParent, thisTyconRef, thisTyconRef.Typars(m), NoSafeInitInfo) + let containerInfo = TyconContainerInfo(innerParent, thisTyconRef, thisTyconRef.Typars m, NoSafeInitInfo) let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) match kind with | TyconHiddenRepr -> - hiddenReprChecks(true) + hiddenReprChecks true noAllowNullLiteralAttributeCheck() TNoRepr, None, NoSafeInitInfo | _ -> @@ -15740,16 +15740,16 @@ module EstablishTypeDefinitionCores = noAllowNullLiteralAttributeCheck() if not (isNil slotsigs) then errorR (Error(FSComp.SR.tcStructTypesCannotContainAbstractMembers(), m)) - structLayoutAttributeCheck(true) + structLayoutAttributeCheck true TTyconStruct | TyconInterface -> - if hasSealedAttr = Some(true) then errorR (Error(FSComp.SR.tcInterfaceTypesCannotBeSealed(), m)) + if hasSealedAttr = Some true then errorR (Error(FSComp.SR.tcInterfaceTypesCannotBeSealed(), m)) noCLIMutableAttributeCheck() - structLayoutAttributeCheck(false) + structLayoutAttributeCheck false noAbstractClassAttributeCheck() allowNullLiteralAttributeCheck() - noFieldsCheck(userFields) + noFieldsCheck userFields TTyconInterface | TyconClass -> noCLIMutableAttributeCheck() @@ -15759,15 +15759,15 @@ module EstablishTypeDefinitionCores = | TyconDelegate (ty, arity) -> noCLIMutableAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDelegate - structLayoutAttributeCheck(false) + structLayoutAttributeCheck false noAllowNullLiteralAttributeCheck() noAbstractClassAttributeCheck() - noFieldsCheck(userFields) + noFieldsCheck userFields let ty', _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv ty let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm g (arity |> TranslateTopValSynInfo m (TcAttributes cenv envinner) |> TranslatePartialArity []) ty' m if curriedArgInfos.Length < 1 then error(Error(FSComp.SR.tcInvalidDelegateSpecification(), m)) if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcDelegatesCannotBeCurried(), m)) - let ttps = thisTyconRef.Typars(m) + let ttps = thisTyconRef.Typars m let fparams = curriedArgInfos.Head |> List.map MakeSlotParam TTyconDelegate (MakeSlotSig("Invoke", thisTy, ttps, [], [fparams], returnTy)) | _ -> @@ -15788,7 +15788,7 @@ module EstablishTypeDefinitionCores = | ((_, m, baseIdOpt) :: _) -> match baseIdOpt with | None -> Some(ident("base", m)) - | Some id -> Some(id) + | Some id -> Some id let abstractSlots = [ for (valSpfn, memberFlags) in slotsigs do @@ -15818,7 +15818,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Enum (decls, m) -> let fieldTy, fields' = TcRecdUnionAndEnumDeclarations.TcEnumDecls cenv envinner innerParent thisTy decls let kind = TTyconEnum - structLayoutAttributeCheck(false) + structLayoutAttributeCheck false noCLIMutableAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedEnum noAllowNullLiteralAttributeCheck() @@ -16055,7 +16055,7 @@ module EstablishTypeDefinitionCores = | (typeDefCore, _, _), Some (tycon: Tycon) -> let (MutRecDefnsPhase1DataForTycon(synTyconInfo, _, _, _, _, _)) = typeDefCore let (ComponentInfo(_, _, synTyconConstraints, _, _, _, _, _)) = synTyconInfo - let envForTycon = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars(m)) envForDecls + let envForTycon = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envForDecls let thisTyconRef = mkLocalTyconRef tycon let envForTycon = MakeInnerEnvForTyconRef envForTycon thisTyconRef false try TcTyparConstraints cenv NoNewTypars checkCxs ItemOccurence.UseInType envForTycon tpenv synTyconConstraints |> ignore @@ -16169,7 +16169,7 @@ module EstablishTypeDefinitionCores = // No inferred constraints allowed on declared typars (envMutRecPrelim, withEnvs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (_, tyconOpt) -> - tyconOpt |> Option.iter (fun tycon -> tycon.Typars(m) |> List.iter (SetTyparRigid g envForDecls.DisplayEnv m))) + tyconOpt |> Option.iter (fun tycon -> tycon.Typars m |> List.iter (SetTyparRigid g envForDecls.DisplayEnv m))) // Phase1E. OK, now recheck the abbreviations, super/interface and explicit constraints types (this time checking constraints) (envMutRecPrelim, withAttrs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo, tyconAndAttrsOpt) -> @@ -16250,7 +16250,7 @@ module TcDeclarations = tcref.Deref.IsFSharpDelegateTycon || tcref.Deref.IsFSharpEnumTycon - let reqTypars = tcref.Typars(m) + let reqTypars = tcref.Typars m // Member definitions are intrinsic (added directly to the type) if: // a) For interfaces, only if it is in the original defn. @@ -16377,13 +16377,13 @@ module TcDeclarations = match trepr with | SynTypeDefnRepr.ObjectModel(kind, cspec, m) -> CheckMembersForm cspec - let fields = cspec |> List.choose (function SynMemberDefn.ValField (f, _) -> Some(f) | _ -> None) + let fields = cspec |> List.choose (function SynMemberDefn.ValField (f, _) -> Some f | _ -> None) let implements2 = cspec |> List.choose (function SynMemberDefn.Interface (ty, _, _) -> Some(ty, ty.Range) | _ -> None) let inherits = cspec |> List.choose (function | SynMemberDefn.Inherit (ty, idOpt, m) -> Some(ty, m, idOpt) | SynMemberDefn.ImplicitInherit (ty, _, idOpt, m) -> Some(ty, m, idOpt) | _ -> None) - //let nestedTycons = cspec |> List.choose (function SynMemberDefn.NestedType (x, _, _) -> Some(x) | _ -> None) + //let nestedTycons = cspec |> List.choose (function SynMemberDefn.NestedType (x, _, _) -> Some x | _ -> None) let slotsigs = cspec |> List.choose (function SynMemberDefn.AbstractSlot (x, y, _) -> Some(x, y) | _ -> None) let members = @@ -16512,7 +16512,7 @@ module TcDeclarations = // members of the type let preEstablishedHasDefaultCtor = members |> List.exists (function - | SynMemberDefn.Member(Binding(_, _, _, _, _, _, SynValData(Some memberFlags, _, _), SynPatForConstructorDecl(SynPatForNullaryArgs), _, _, _, _), _) -> + | SynMemberDefn.Member(Binding(_, _, _, _, _, _, SynValData(Some memberFlags, _, _), SynPatForConstructorDecl SynPatForNullaryArgs, _, _, _, _), _) -> memberFlags.MemberKind=MemberKind.Constructor | SynMemberDefn.ImplicitCtor (_, _, spats, _, _) -> isNil spats | _ -> false) @@ -16528,7 +16528,7 @@ module TcDeclarations = let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, repr, implements1, false, false, isAtOriginalTyconDefn) core, members @ extraMembers - | SynTypeDefnRepr.Exception(r) -> + | SynTypeDefnRepr.Exception r -> let isAtOriginalTyconDefn = true let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, SynTypeDefnSimpleRepr.Exception r, implements1, false, false, isAtOriginalTyconDefn) core, extraMembers @@ -16616,10 +16616,10 @@ module TcDeclarations = match trepr with | SynTypeDefnSigRepr.ObjectModel(kind, cspec, m) -> - let fields = cspec |> List.choose (function SynMemberSig.ValField (f, _) -> Some(f) | _ -> None) + let fields = cspec |> List.choose (function SynMemberSig.ValField (f, _) -> Some f | _ -> None) let implements2 = cspec |> List.choose (function SynMemberSig.Interface (ty, m) -> Some(ty, m) | _ -> None) let inherits = cspec |> List.choose (function SynMemberSig.Inherit (ty, _) -> Some(ty, m, None) | _ -> None) - //let nestedTycons = cspec |> List.choose (function SynMemberSig.NestedType (x, _) -> Some(x) | _ -> None) + //let nestedTycons = cspec |> List.choose (function SynMemberSig.NestedType (x, _) -> Some x | _ -> None) let slotsigs = cspec |> List.choose (function SynMemberSig.Member (v, fl, _) when fl.IsDispatchSlot -> Some(v, fl) | _ -> None) let members = cspec |> List.filter (function | SynMemberSig.Interface _ -> true @@ -16658,7 +16658,7 @@ module TcDeclarations = let tyconCore = MutRecDefnsPhase1DataForTycon (synTyconInfo, r, implements1, false, false, isAtOriginalTyconDefn) tyconCore, (synTyconInfo, extraMembers) - | SynTypeDefnSigRepr.Exception(r) -> + | SynTypeDefnSigRepr.Exception r -> let isAtOriginalTyconDefn = true let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, SynTypeDefnSimpleRepr.Exception r, implements1, false, false, isAtOriginalTyconDefn) core, (synTyconInfo, extraMembers) @@ -16750,7 +16750,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS match parent with | ParentNone -> error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) | Parent p -> p - let containerInfo = ModuleOrNamespaceContainerInfo(parentModule) + let containerInfo = ModuleOrNamespaceContainerInfo parentModule let idvs, _ = TcAndPublishValSpec (cenv, env, containerInfo, ModuleOrMemberBinding, None, emptyUnscopedTyparEnv, vspec) let scopem = unionRanges m endm let env = List.foldBack (AddLocalVal cenv.tcSink scopem) idvs env @@ -16920,7 +16920,7 @@ and TcSignatureElementsMutRec cenv parent typeNames endm mutRecNSInfo envInitial | SynModuleSigDecl.Val (vspec, _) -> if isNamespace then error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) - let decls = [ MutRecShape.Lets(vspec) ] + let decls = [ MutRecShape.Lets vspec ] decls, (false, false) | SynModuleSigDecl.NestedModule(compInfo, isRec, synDefs, _) -> @@ -17049,7 +17049,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem return (id, []), env, env | Parent parentModule -> - let containerInfo = ModuleOrNamespaceContainerInfo(parentModule) + let containerInfo = ModuleOrNamespaceContainerInfo parentModule if letrec then let scopem = unionRanges m scopem let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(containerInfo, NoNewSlots, ModuleOrMemberBinding, bind)) @@ -17510,7 +17510,7 @@ let TypeCheckOneImplFile let envinner, mtypeAcc = MakeInitialEnv env - let defs = [ for x in implFileFrags -> SynModuleDecl.NamespaceFragment(x) ] + let defs = [ for x in implFileFrags -> SynModuleDecl.NamespaceFragment x ] let! mexpr, topAttrs, envAtEnd = TcModuleOrNamespaceElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDocEmpty None defs let implFileTypePriorToSig = !mtypeAcc @@ -17585,7 +17585,7 @@ let TypeCheckOneImplFile // Warn on version attributes. topAttrs.assemblyAttrs |> List.iter (function - | Attrib(tref, _, [ AttribExpr(Expr.Const (Const.String(version), range, _), _) ], _, _, _, _) -> + | Attrib(tref, _, [ AttribExpr(Expr.Const (Const.String version, range, _), _) ], _, _, _, _) -> let attrName = tref.CompiledRepresentationForNamedType.FullName let isValid() = try IL.parseILVersion version |> ignore; true @@ -17610,7 +17610,7 @@ let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, condition let cenv = cenv.Create (g, false, niceNameGen, amap, topCcu, true, false, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring) let envinner, mtypeAcc = MakeInitialEnv tcEnv - let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment(x) ] + let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment x ] let! tcEnv = TcSignatureElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDocEmpty None specs let sigFileType = !mtypeAcc diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index 05c016d3c..2169bf295 100755 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -201,7 +201,7 @@ let IterativelySubstituteTyparSolutions g tps solutions = let ChooseTyparSolutionsForFreeChoiceTypars g amap e = match e with - | Expr.TyChoose(tps, e1, _m) -> + | Expr.TyChoose (tps, e1, _m) -> /// Only make choices for variables that are actually used in the expression let ftvs = (freeInExpr CollectTyparsNoCaching e1).FreeTyvars.FreeTypars diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index 561900cdb..7d2261ad3 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -25,7 +25,6 @@ module FSharpLib = let Core = Root + ".Core" let CorePath = IL.splitNamespace Core - [] module CustomOperations = [] @@ -50,7 +49,7 @@ type XmlDocCollector() = let check() = assert (not savedLinesAsArray.IsValueCreated && "can't add more XmlDoc elements to XmlDocCollector after extracting first XmlDoc from the overall results" <> "") - member x.AddGrabPoint(pos) = + member x.AddGrabPoint pos = check() savedGrabPoints.Add pos @@ -58,7 +57,7 @@ type XmlDocCollector() = check() savedLines.Add(line, pos) - member x.LinesBefore(grabPointPos) = + member x.LinesBefore grabPointPos = try let lines = savedLinesAsArray.Force() let grabPoints = savedGrabPointsAsArray.Force() @@ -107,7 +106,7 @@ type XmlDoc = if lineAT = "" then processLines rest else if lineAT.StartsWithOrdinal("<") then lines else [""] @ - (lines |> List.map (fun line -> Microsoft.FSharp.Core.XmlAdapters.escape(line))) @ + (lines |> List.map (fun line -> Microsoft.FSharp.Core.XmlAdapters.escape line)) @ [""] let lines = processLines (Array.toList lines) @@ -553,7 +552,7 @@ and | SynType.HashConstraint (range=m) | SynType.MeasureDivide (range=m) | SynType.MeasurePower (range=m) -> m - | SynType.LongIdent(lidwd) -> lidwd.Range + | SynType.LongIdent lidwd -> lidwd.Range and [] @@ -589,7 +588,7 @@ and | ArrayOrList of isList: bool * exprs: SynExpr list * range: range /// F# syntax: { f1=e1; ...; fn=en } - /// SynExpr.Record((baseType, baseCtorArgs, mBaseCtor, sepAfterBase, mInherits), (copyExpr, sepAfterCopyExpr), (recordFieldName, fieldValue, sepAfterField), mWholeExpr) + /// SynExpr.Record ((baseType, baseCtorArgs, mBaseCtor, sepAfterBase, mInherits), (copyExpr, sepAfterCopyExpr), (recordFieldName, fieldValue, sepAfterField), mWholeExpr) /// inherit includes location of separator (for tooling) /// copyOpt contains range of the following WITH part (for tooling) /// every field includes range of separator after the field (for tooling) @@ -599,7 +598,7 @@ and /// The flag is true if known to be 'family' ('protected') scope | New of isProtected: bool * typeName: SynType * expr: SynExpr * range: range - /// SynExpr.ObjExpr(objTy, argOpt, binds, extraImpls, mNewExpr, mWholeExpr) + /// SynExpr.ObjExpr (objTy, argOpt, binds, extraImpls, mNewExpr, mWholeExpr) /// /// F# syntax: { new ... with ... } | ObjExpr of objType: SynType * argOptions:(SynExpr * Ident option) option * bindings: SynBinding list * extraImpls: SynInterfaceImpl list * newExprRange: range * range: range @@ -685,7 +684,7 @@ and | IfThenElse of ifExpr: SynExpr * thenExpr: SynExpr * elseExpr: SynExpr option * spIfToThen: SequencePointInfoForBinding * isFromErrorRecovery: bool * ifToThenRange: range * range: range /// F# syntax: ident - /// Optimized representation, = SynExpr.LongIdent(false, [id], id.idRange) + /// Optimized representation, = SynExpr.LongIdent (false, [id], id.idRange) | Ident of Ident /// F# syntax: ident.ident...ident @@ -719,7 +718,7 @@ and /// F# syntax: Type.Items(e1) <- e2, rarely used named-property-setter notation, e.g. Foo.Bar.Chars(3) <- 'a' | NamedIndexedPropertySet of longDotId: LongIdentWithDots * SynExpr * SynExpr * range: range - /// F# syntax: expr.Items(e1) <- e2, rarely used named-property-setter notation, e.g. (stringExpr).Chars(3) <- 'a' + /// F# syntax: Expr.Items (e1) <- e2, rarely used named-property-setter notation, e.g. (stringExpr).Chars(3) <- 'a' | DotNamedIndexedPropertySet of SynExpr * longDotId: LongIdentWithDots * SynExpr * SynExpr * range: range /// F# syntax: expr :? type @@ -764,7 +763,7 @@ and /// Computation expressions only | YieldOrReturnFrom of (bool * bool) * expr: SynExpr * range: range - /// SynExpr.LetOrUseBang(spBind, isUse, isFromSource, pat, rhsExpr, bodyExpr, mWholeExpr). + /// SynExpr.LetOrUseBang (spBind, isUse, isFromSource, pat, rhsExpr, bodyExpr, mWholeExpr). /// /// F# syntax: let! pat = expr in expr /// F# syntax: use! pat = expr in expr @@ -995,7 +994,7 @@ and | SynExpr.MatchBang (range=m) | SynExpr.DoBang (range=m) -> m // these are better than just .Range, and also commonly applicable inside queries - | SynExpr.Paren(_, m, _, _) -> m + | SynExpr.Paren (_, m, _, _) -> m | SynExpr.Sequential (_, _, e1, _, _) | SynExpr.App (_, _, e1, _, _) -> e1.RangeOfFirstPortion @@ -1779,15 +1778,15 @@ type SynArgNameGenerator() = let mkSynId m s = Ident(s, m) let pathToSynLid m p = List.map (mkSynId m) p -let mkSynIdGet m n = SynExpr.Ident(mkSynId m n) +let mkSynIdGet m n = SynExpr.Ident (mkSynId m n) let mkSynLidGet m path n = let lid = pathToSynLid m path @ [mkSynId m n] let dots = List.replicate (lid.Length - 1) m - SynExpr.LongIdent(false, LongIdentWithDots(lid, dots), None, m) + SynExpr.LongIdent (false, LongIdentWithDots(lid, dots), None, m) let mkSynIdGetWithAlt m id altInfo = match altInfo with | None -> SynExpr.Ident id - | _ -> SynExpr.LongIdent(false, LongIdentWithDots([id], []), altInfo, m) + | _ -> SynExpr.LongIdent (false, LongIdentWithDots([id], []), altInfo, m) let mkSynSimplePatVar isOpt id = SynSimplePat.Id (id, None, false, false, isOpt, id.idRange) let mkSynCompGenSimplePatVar id = SynSimplePat.Id (id, None, true, false, false, id.idRange) @@ -1795,13 +1794,13 @@ let mkSynCompGenSimplePatVar id = SynSimplePat.Id (id, None, true, false, false, /// Match a long identifier, including the case for single identifiers which gets a more optimized node in the syntax tree. let (|LongOrSingleIdent|_|) inp = match inp with - | SynExpr.LongIdent(isOpt, lidwd, altId, _m) -> Some (isOpt, lidwd, altId, lidwd.RangeSansAnyExtraDot) + | SynExpr.LongIdent (isOpt, lidwd, altId, _m) -> Some (isOpt, lidwd, altId, lidwd.RangeSansAnyExtraDot) | SynExpr.Ident id -> Some (false, LongIdentWithDots([id], []), None, id.idRange) | _ -> None let (|SingleIdent|_|) inp = match inp with - | SynExpr.LongIdent(false, LongIdentWithDots([id], _), None, _) -> Some id + | SynExpr.LongIdent (false, LongIdentWithDots([id], _), None, _) -> Some id | SynExpr.Ident id -> Some id | _ -> None @@ -1822,7 +1821,7 @@ let rec IsControlFlowExpression e = | SynExpr.For _ | SynExpr.ForEach _ | SynExpr.While _ -> true - | SynExpr.Typed(e, _, _) -> IsControlFlowExpression e + | SynExpr.Typed (e, _, _) -> IsControlFlowExpression e | _ -> false let mkAnonField (ty: SynType) = Field([], false, None, ty, false, PreXmlDoc.Empty, None, ty.Range) @@ -1846,12 +1845,12 @@ let (|SynPatForNullaryArgs|_|) x = let (|SynExprErrorSkip|) (p: SynExpr) = match p with - | SynExpr.FromParseError(p, _) -> p + | SynExpr.FromParseError (p, _) -> p | _ -> p let (|SynExprParen|_|) (e: SynExpr) = match e with - | SynExpr.Paren(SynExprErrorSkip e, a, b, c) -> Some (e, a, b, c) + | SynExpr.Paren (SynExprErrorSkip e, a, b, c) -> Some (e, a, b, c) | _ -> None let (|SynPatErrorSkip|) (p: SynPat) = @@ -1899,7 +1898,7 @@ let rec SimplePatOfPat (synArgNameGenerator: SynArgNameGenerator) p = SynSimplePat.Id (id, altNameRefCell, isCompGen, false, false, id.idRange), Some (fun e -> let clause = Clause(p, None, e, m, SuppressSequencePointAtTarget) - SynExpr.Match(NoSequencePointAtInvisibleBinding, item, [clause], clause.Range)) + SynExpr.Match (NoSequencePointAtInvisibleBinding, item, [clause], clause.Range)) let appFunOpt funOpt x = match funOpt with None -> x | Some f -> f x let composeFunOpt funOpt1 funOpt2 = match funOpt2 with None -> funOpt1 | Some f -> Some (fun x -> appFunOpt funOpt1 (f x)) @@ -2021,23 +2020,23 @@ let mkSynPrefixPrim opm m oper x = let mkSynPrefix opm m oper x = if oper = "~&" then - SynExpr.AddressOf(true, x, opm, m) + SynExpr.AddressOf (true, x, opm, m) elif oper = "~&&" then - SynExpr.AddressOf(false, x, opm, m) + SynExpr.AddressOf (false, x, opm, m) else mkSynPrefixPrim opm m oper x let mkSynCaseName m n = [mkSynId m (CompileOpName n)] -let mkSynApp1 f x1 m = SynExpr.App(ExprAtomicFlag.NonAtomic, false, f, x1, m) +let mkSynApp1 f x1 m = SynExpr.App (ExprAtomicFlag.NonAtomic, false, f, x1, m) let mkSynApp2 f x1 x2 m = mkSynApp1 (mkSynApp1 f x1 m) x2 m let mkSynApp3 f x1 x2 x3 m = mkSynApp1 (mkSynApp2 f x1 x2 m) x3 m let mkSynApp4 f x1 x2 x3 x4 m = mkSynApp1 (mkSynApp3 f x1 x2 x3 m) x4 m let mkSynApp5 f x1 x2 x3 x4 x5 m = mkSynApp1 (mkSynApp4 f x1 x2 x3 x4 m) x5 m let mkSynDotParenSet m a b c = mkSynTrifix m parenSet a b c -let mkSynDotBrackGet m mDot a b = SynExpr.DotIndexedGet(a, [SynIndexerArg.One b], mDot, m) +let mkSynDotBrackGet m mDot a b = SynExpr.DotIndexedGet (a, [SynIndexerArg.One b], mDot, m) let mkSynQMarkSet m a b c = mkSynTrifix m qmarkSet a b c -let mkSynDotBrackSliceGet m mDot arr sliceArg = SynExpr.DotIndexedGet(arr, [sliceArg], mDot, m) +let mkSynDotBrackSliceGet m mDot arr sliceArg = SynExpr.DotIndexedGet (arr, [sliceArg], mDot, m) let mkSynDotBrackSeqSliceGet m mDot arr (argslist: list) = let notsliced=[ for arg in argslist do @@ -2045,58 +2044,58 @@ let mkSynDotBrackSeqSliceGet m mDot arr (argslist: list) = | SynIndexerArg.One x -> yield x | _ -> () ] if notsliced.Length = argslist.Length then - SynExpr.DotIndexedGet(arr, [SynIndexerArg.One (SynExpr.Tuple(false, notsliced, [], unionRanges (List.head notsliced).Range (List.last notsliced).Range))], mDot, m) + SynExpr.DotIndexedGet (arr, [SynIndexerArg.One (SynExpr.Tuple (false, notsliced, [], unionRanges (List.head notsliced).Range (List.last notsliced).Range))], mDot, m) else - SynExpr.DotIndexedGet(arr, argslist, mDot, m) + SynExpr.DotIndexedGet (arr, argslist, mDot, m) let mkSynDotParenGet lhsm dotm a b = match b with - | SynExpr.Tuple (false, [_;_], _, _) -> errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(), lhsm)) ; SynExpr.Const(SynConst.Unit, lhsm) - | SynExpr.Tuple (false, [_;_;_], _, _) -> errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(), lhsm)) ; SynExpr.Const(SynConst.Unit, lhsm) + | SynExpr.Tuple (false, [_;_], _, _) -> errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(), lhsm)) ; SynExpr.Const (SynConst.Unit, lhsm) + | SynExpr.Tuple (false, [_;_;_], _, _) -> errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(), lhsm)) ; SynExpr.Const (SynConst.Unit, lhsm) | _ -> mkSynInfix dotm a parenGet b -let mkSynUnit m = SynExpr.Const(SynConst.Unit, m) +let mkSynUnit m = SynExpr.Const (SynConst.Unit, m) let mkSynUnitPat m = SynPat.Const(SynConst.Unit, m) let mkSynDelay m e = SynExpr.Lambda (false, false, SynSimplePats.SimplePats ([mkSynCompGenSimplePatVar (mkSynId m "unitVar")], m), e, m) let mkSynAssign (l: SynExpr) (r: SynExpr) = let m = unionRanges l.Range r.Range match l with - //| SynExpr.Paren(l2, m2) -> mkSynAssign m l2 r + //| SynExpr.Paren (l2, m2) -> mkSynAssign m l2 r | LongOrSingleIdent(false, v, None, _) -> SynExpr.LongIdentSet (v, r, m) - | SynExpr.DotGet(e, _, v, _) -> SynExpr.DotSet (e, v, r, m) - | SynExpr.DotIndexedGet(e1, e2, mDot, mLeft) -> SynExpr.DotIndexedSet (e1, e2, r, mLeft, mDot, m) + | SynExpr.DotGet (e, _, v, _) -> SynExpr.DotSet (e, v, r, m) + | SynExpr.DotIndexedGet (e1, e2, mDot, mLeft) -> SynExpr.DotIndexedSet (e1, e2, r, mLeft, mDot, m) | SynExpr.LibraryOnlyUnionCaseFieldGet (x, y, z, _) -> SynExpr.LibraryOnlyUnionCaseFieldSet (x, y, z, r, m) - | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent(nm), a, _), b, _) when nm.idText = opNameQMark -> + | SynExpr.App (_, _, SynExpr.App (_, _, SingleIdent nm, a, _), b, _) when nm.idText = opNameQMark -> mkSynQMarkSet m a b r - | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent(nm), a, _), b, _) when nm.idText = opNameParenGet -> + | SynExpr.App (_, _, SynExpr.App (_, _, SingleIdent nm, a, _), b, _) when nm.idText = opNameParenGet -> mkSynDotParenSet m a b r - | SynExpr.App (_, _, SynExpr.LongIdent(false, v, None, _), x, _) -> SynExpr.NamedIndexedPropertySet (v, x, r, m) - | SynExpr.App (_, _, SynExpr.DotGet(e, _, v, _), x, _) -> SynExpr.DotNamedIndexedPropertySet (e, v, x, r, m) + | SynExpr.App (_, _, SynExpr.LongIdent (false, v, None, _), x, _) -> SynExpr.NamedIndexedPropertySet (v, x, r, m) + | SynExpr.App (_, _, SynExpr.DotGet (e, _, v, _), x, _) -> SynExpr.DotNamedIndexedPropertySet (e, v, x, r, m) | l -> SynExpr.Set (l, r, m) //| _ -> errorR(Error(FSComp.SR.astInvalidExprLeftHandOfAssignment(), m)); l // return just the LHS, so the typechecker can see it and capture expression typings that may be useful for dot lookups let rec mkSynDot dotm m l r = match l with - | SynExpr.LongIdent(isOpt, LongIdentWithDots(lid, dots), None, _) -> - SynExpr.LongIdent(isOpt, LongIdentWithDots(lid@[r], dots@[dotm]), None, m) // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here + | SynExpr.LongIdent (isOpt, LongIdentWithDots(lid, dots), None, _) -> + SynExpr.LongIdent (isOpt, LongIdentWithDots(lid@[r], dots@[dotm]), None, m) // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here | SynExpr.Ident id -> - SynExpr.LongIdent(false, LongIdentWithDots([id;r], [dotm]), None, m) - | SynExpr.DotGet(e, dm, LongIdentWithDots(lid, dots), _) -> - SynExpr.DotGet(e, dm, LongIdentWithDots(lid@[r], dots@[dotm]), m)// REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here + SynExpr.LongIdent (false, LongIdentWithDots([id;r], [dotm]), None, m) + | SynExpr.DotGet (e, dm, LongIdentWithDots(lid, dots), _) -> + SynExpr.DotGet (e, dm, LongIdentWithDots(lid@[r], dots@[dotm]), m)// REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here | expr -> - SynExpr.DotGet(expr, dotm, LongIdentWithDots([r], []), m) + SynExpr.DotGet (expr, dotm, LongIdentWithDots([r], []), m) let rec mkSynDotMissing dotm m l = match l with - | SynExpr.LongIdent(isOpt, LongIdentWithDots(lid, dots), None, _) -> - SynExpr.LongIdent(isOpt, LongIdentWithDots(lid, dots@[dotm]), None, m) // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here + | SynExpr.LongIdent (isOpt, LongIdentWithDots(lid, dots), None, _) -> + SynExpr.LongIdent (isOpt, LongIdentWithDots(lid, dots@[dotm]), None, m) // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here | SynExpr.Ident id -> - SynExpr.LongIdent(false, LongIdentWithDots([id], [dotm]), None, m) - | SynExpr.DotGet(e, dm, LongIdentWithDots(lid, dots), _) -> - SynExpr.DotGet(e, dm, LongIdentWithDots(lid, dots@[dotm]), m)// REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here + SynExpr.LongIdent (false, LongIdentWithDots([id], [dotm]), None, m) + | SynExpr.DotGet (e, dm, LongIdentWithDots(lid, dots), _) -> + SynExpr.DotGet (e, dm, LongIdentWithDots(lid, dots@[dotm]), m)// REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here | expr -> - SynExpr.DiscardAfterMissingQualificationAfterDot(expr, m) + SynExpr.DiscardAfterMissingQualificationAfterDot (expr, m) let mkSynFunMatchLambdas synArgNameGenerator isMember wholem ps e = let _, e = PushCurriedPatternsToExpr synArgNameGenerator wholem isMember ps e @@ -2105,7 +2104,7 @@ let mkSynFunMatchLambdas synArgNameGenerator isMember wholem ps e = // error recovery - the contract is that these expressions can only be produced if an error has already been reported // (as a result, future checking may choose not to report errors involving these, to prevent noisy cascade errors) -let arbExpr(debugStr, range: range) = SynExpr.ArbitraryAfterError(debugStr, range.MakeSynthetic()) +let arbExpr(debugStr, range: range) = SynExpr.ArbitraryAfterError (debugStr, range.MakeSynthetic()) type SynExpr with member this.IsArbExprAndThusAlreadyReportedError = match this with @@ -2229,7 +2228,7 @@ module SynInfo = let InferLambdaArgs origRhsExpr = let rec loop e = match e with - | SynExpr.Lambda(false, _, spats, rest, _) -> + | SynExpr.Lambda (false, _, spats, rest, _) -> InferSynArgInfoFromSimplePats spats :: loop rest | _ -> [] loop origRhsExpr @@ -2275,7 +2274,7 @@ module SynInfo = let infosForArgs = AdjustArgsForUnitElimination infosForArgs let argInfos = infosForObjArgs @ infosForArgs - SynValData(Some(memFlags), SynValInfo(argInfos, retInfo), None) + SynValData(Some memFlags, SynValInfo(argInfos, retInfo), None) @@ -2283,7 +2282,7 @@ let mkSynBindingRhs staticOptimizations rhsExpr mRhs retInfo = let rhsExpr = List.foldBack (fun (c, e1) e2 -> SynExpr.LibraryOnlyStaticOptimization (c, e1, e2, mRhs)) staticOptimizations rhsExpr let rhsExpr, retTyOpt = match retInfo with - | Some (SynReturnInfo((ty, SynArgInfo(rattribs, _, _)), tym)) -> SynExpr.Typed(rhsExpr, ty, rhsExpr.Range), Some(SynBindingReturnInfo(ty, tym, rattribs) ) + | Some (SynReturnInfo((ty, SynArgInfo(rattribs, _, _)), tym)) -> SynExpr.Typed (rhsExpr, ty, rhsExpr.Range), Some(SynBindingReturnInfo(ty, tym, rattribs) ) | None -> rhsExpr, None rhsExpr, retTyOpt @@ -2318,7 +2317,7 @@ type LexerEndlineContinuation = | Skip of LexerIfdefStackEntries * int * range: range member x.LexerIfdefStack = match x with - | LexerEndlineContinuation.Token(ifd) + | LexerEndlineContinuation.Token ifd | LexerEndlineContinuation.Skip(ifd, _, _) -> ifd type LexerIfdefExpression = @@ -2414,7 +2413,7 @@ type IParseState with let key = "SynArgNameGenerator" let bls = x.LexBuffer.BufferLocalStore let gen = - match bls.TryGetValue(key) with + match bls.TryGetValue key with | true, gen -> gen | _ -> let gen = box (SynArgNameGenerator()) @@ -2438,7 +2437,7 @@ module LexbufLocalXmlDocStore = /// Called from the lexer to save a single line of XML doc comment. let internal SaveXmlDocLine (lexbuf: Lexbuf, lineText, pos) = let collector = - match lexbuf.BufferLocalStore.TryGetValue(xmlDocKey) with + match lexbuf.BufferLocalStore.TryGetValue xmlDocKey with | true, collector -> collector | _ -> let collector = box (XmlDocCollector()) @@ -2450,7 +2449,7 @@ module LexbufLocalXmlDocStore = /// Called from the parser each time we parse a construct that marks the end of an XML doc comment range, /// e.g. a 'type' declaration. The markerRange is the range of the keyword that delimits the construct. let internal GrabXmlDocBeforeMarker (lexbuf: Lexbuf, markerRange: range) = - match lexbuf.BufferLocalStore.TryGetValue(xmlDocKey) with + match lexbuf.BufferLocalStore.TryGetValue xmlDocKey with | true, collector -> let collector = unbox(collector) PreXmlDoc.CreateFromGrabPoint(collector, markerRange.End) @@ -2475,7 +2474,7 @@ type NiceNameGenerator() = lock lockObj (fun () -> let basicName = GetBasicNameOfPossibleCompilerGeneratedName name let n = - match basicNameCounts.TryGetValue(basicName) with + match basicNameCounts.TryGetValue basicName with | true, count -> count | _ -> 0 let nm = CompilerGeneratedNameSuffix basicName (string m.StartLine + (match n with 0 -> "" | n -> "-" + string n)) @@ -2506,11 +2505,11 @@ type StableNiceNameGenerator() = lock lockObj (fun () -> let basicName = GetBasicNameOfPossibleCompilerGeneratedName name let key = basicName, uniq - match names.TryGetValue(key) with + match names.TryGetValue key with | true, nm -> nm | _ -> let n = - match basicNameCounts.TryGetValue(basicName) with + match basicNameCounts.TryGetValue basicName with | true, c -> c | _ -> 0 let nm = CompilerGeneratedNameSuffix basicName (string m.StartLine + (match n with 0 -> "" | n -> "-" + string n)) @@ -2563,7 +2562,7 @@ let rec synExprContainsError inpExpr = | SynExpr.InferredUpcast (e, _) | SynExpr.InferredDowncast (e, _) | SynExpr.Lazy (e, _) - | SynExpr.TraitCall(_, _, e, _) + | SynExpr.TraitCall (_, _, e, _) | SynExpr.YieldOrReturn (_, e, _) | SynExpr.YieldOrReturnFrom (_, e, _) | SynExpr.DoBang (e, _) @@ -2590,7 +2589,7 @@ let rec synExprContainsError inpExpr = | SynExpr.Record (_, origExpr, fs, _) -> (match origExpr with Some (e, _) -> walkExpr e | None -> false) || let flds = fs |> List.choose (fun (_, v, _) -> v) - walkExprs (flds) + walkExprs flds | SynExpr.ObjExpr (_, _, bs, is, _, _) -> walkBinds bs || walkBinds [ for (InterfaceImpl(_, bs, _)) in is do yield! bs ] @@ -2599,7 +2598,7 @@ let rec synExprContainsError inpExpr = walkExpr e1 || walkExpr e2 | SynExpr.For (_, _, e1, _, e2, e3, _) -> walkExpr e1 || walkExpr e2 || walkExpr e3 - | SynExpr.MatchLambda(_, _, cl, _, _) -> + | SynExpr.MatchLambda (_, _, cl, _, _) -> walkMatchClauses cl | SynExpr.Lambda (_, _, _, e, _) -> walkExpr e diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index dd7615661..a8c273df9 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -48,16 +48,16 @@ let DecideLambda exprF cenv topValInfo expr ety z = let DecideExprOp exprF noInterceptF (z: Zset) (expr: Expr) (op, tyargs, args) = match op, tyargs, args with - | TOp.While _, _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _)] -> + | TOp.While _, _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _)] -> exprF (exprF z e1) e2 - | TOp.TryFinally _, [_], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> + | TOp.TryFinally _, [_], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)] -> exprF (exprF z e1) e2 - | TOp.For(_), _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _);Expr.Lambda(_, _, _, [_], e3, _, _)] -> + | TOp.For (_), _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _);Expr.Lambda (_, _, _, [_], e3, _, _)] -> exprF (exprF (exprF z e1) e2) e3 - | TOp.TryCatch _, [_], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], _e2, _, _); Expr.Lambda(_, _, _, [_], e3, _, _)] -> + | TOp.TryCatch _, [_], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], _e2, _, _); Expr.Lambda (_, _, _, [_], e3, _, _)] -> exprF (exprF (exprF z e1) _e2) e3 // In Check code it said // e2; -- don't check filter body - duplicates logic in 'catch' body @@ -68,12 +68,12 @@ let DecideExprOp exprF noInterceptF (z: Zset) (expr: Expr) (op, tyargs, arg /// Find all the mutable locals that escape a lambda expression or object expression let DecideExpr cenv exprF noInterceptF z expr = match expr with - | Expr.Lambda(_, _ctorThisValOpt, _baseValOpt, argvs, _, m, rty) -> + | Expr.Lambda (_, _ctorThisValOpt, _baseValOpt, argvs, _, m, rty) -> let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty DecideLambda (Some exprF) cenv topValInfo expr ty z - | Expr.TyLambda(_, tps, _, _m, rty) -> + | Expr.TyLambda (_, tps, _, _m, rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) let ty = mkForallTyIfNeeded tps rty DecideLambda (Some exprF) cenv topValInfo expr ty z @@ -139,14 +139,14 @@ let TransformExpr g (nvs: ValMap<_>) exprF expr = Some (mkRefCellGet g m v.Type nve) // Rewrite assignments to mutable values - | Expr.Op(TOp.LValueOp (LSet, ValDeref(v)), [], [arg], m) when nvs.ContainsVal v -> + | Expr.Op (TOp.LValueOp (LSet, ValDeref(v)), [], [arg], m) when nvs.ContainsVal v -> let _nv, nve = nvs.[v] let arg = exprF arg Some (mkRefCellSet g m v.Type nve arg) // Rewrite taking the address of mutable values - | Expr.Op(TOp.LValueOp (LAddrOf readonly, ValDeref(v)), [], [], m) when nvs.ContainsVal v -> + | Expr.Op (TOp.LValueOp (LAddrOf readonly, ValDeref(v)), [], [], m) when nvs.ContainsVal v -> let _nv,nve = nvs.[v] Some (mkRecdFieldGetAddrViaExprAddr (readonly, nve, mkRefCellContentsRef g, [v.Type], m)) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 1babf7978..75dfec72a 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -116,12 +116,12 @@ type DelayAndForwardErrorLogger(exiter: Exiter, errorLoggerProvider: ErrorLogger member x.ForwardDelayedDiagnostics(tcConfigB: TcConfigBuilder) = let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) - x.CommitDelayedDiagnostics(errorLogger) + x.CommitDelayedDiagnostics errorLogger and [] ErrorLoggerProvider() = - member this.CreateDelayAndForwardLogger(exiter) = DelayAndForwardErrorLogger(exiter, this) + member this.CreateDelayAndForwardLogger exiter = DelayAndForwardErrorLogger(exiter, this) abstract CreateErrorLoggerUpToMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> ErrorLogger @@ -140,7 +140,7 @@ type InProcErrorLoggerProvider() = { new ErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerErrorLoggerUpToMaxErrors") with - member this.HandleTooManyErrors(text) = warnings.Add(Diagnostic.Short(false, text)) + member this.HandleTooManyErrors text = warnings.Add(Diagnostic.Short(false, text)) member this.HandleIssue(tcConfigBuilder, err, isError) = let errs = @@ -148,7 +148,7 @@ type InProcErrorLoggerProvider() = (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, tcConfigBuilder.flatErrors, tcConfigBuilder.errorStyle, isError, err) let container = if isError then errors else warnings - container.AddRange(errs) } + container.AddRange errs } :> ErrorLogger } member __.CapturedErrors = errors.ToArray() @@ -176,7 +176,7 @@ type DisposablesTracker() = let items = Stack() - member this.Register(i) = items.Push i + member this.Register i = items.Push i interface IDisposable with @@ -202,10 +202,10 @@ let AdjustForScriptCompile(ctok, tcConfigB: TcConfigBuilder, commandLineSourceFi let combineFilePath file = try - if FileSystem.IsPathRootedShim(file) then file + if FileSystem.IsPathRootedShim file then file else Path.Combine(tcConfigB.implicitIncludeDir, file) with _ -> - error (Error(FSComp.SR.pathIsInvalid(file), rangeStartup)) + error (Error(FSComp.SR.pathIsInvalid file, rangeStartup)) let commandLineSourceFiles = commandLineSourceFiles @@ -219,7 +219,7 @@ let AdjustForScriptCompile(ctok, tcConfigB: TcConfigBuilder, commandLineSourceFi if not(!allSources |> List.contains filename) then allSources := filename::!allSources - let AppendClosureInformation(filename) = + let AppendClosureInformation filename = if IsScript filename then let closure = LoadClosure.ComputeClosureOfScriptFiles @@ -237,7 +237,7 @@ let AdjustForScriptCompile(ctok, tcConfigB: TcConfigBuilder, commandLineSourceFi closure.SourceFiles |> List.map fst |> List.iter AddIfNotPresent closure.AllRootFileDiagnostics |> List.iter diagnosticSink - else AddIfNotPresent(filename) + else AddIfNotPresent filename // Find closure of .fsx files. commandLineSourceFiles |> List.iter AppendClosureInformation @@ -273,13 +273,13 @@ let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder, setProcessThreadLocals, | Some _ -> () | None -> tcConfigB.lcid <- lcidFromCodePage - setProcessThreadLocals(tcConfigB) + setProcessThreadLocals tcConfigB (* step - get dll references *) let dllFiles, sourceFiles = inputFiles |> List.map(fun p -> trimQuotes p) |> List.partition Filename.isDll match dllFiles with | [] -> () - | h::_ -> errorR (Error(FSComp.SR.fscReferenceOnCommandLine(h), rangeStartup)) + | h::_ -> errorR (Error(FSComp.SR.fscReferenceOnCommandLine h, rangeStartup)) dllFiles |> List.iter (fun f->tcConfigB.AddReferencedAssemblyByPath(rangeStartup, f)) sourceFiles @@ -414,7 +414,7 @@ module XmlDocWriter = doModule generatedCcu.Contents - use os = File.CreateText(xmlfile) + use os = File.CreateText xmlfile fprintfn os ("") fprintfn os ("") @@ -434,7 +434,7 @@ let GenerateInterfaceData(tcConfig: TcConfig) = not tcConfig.standalone && not tcConfig.noSignatureData let EncodeInterfaceData(tcConfig: TcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) = - if GenerateInterfaceData(tcConfig) then + if GenerateInterfaceData tcConfig then let resource = WriteSignatureData (tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) // The resource gets written to a file for FSharp.Core let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild @@ -448,8 +448,8 @@ let EncodeInterfaceData(tcConfig: TcConfig, tcGlobals, exportRemapping, generate else [], [] -let GenerateOptimizationData(tcConfig) = - GenerateInterfaceData(tcConfig) +let GenerateOptimizationData tcConfig = + GenerateInterfaceData tcConfig let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemapping, data, isIncrementalBuild) = if GenerateOptimizationData tcConfig then @@ -559,7 +559,7 @@ module VersionResourceFormat = let children = [| for string in strings do - yield String(string) |] + yield String string |] VersionInfoElement(wType, szKey, None, children, false) let StringFileInfo(stringTables: #seq >) = @@ -568,7 +568,7 @@ module VersionResourceFormat = // Contains an array of one or more StringTable structures. let children = [| for stringTable in stringTables do - yield StringTable(stringTable) |] + yield StringTable stringTable |] VersionInfoElement(wType, szKey, None, children, false) let VarFileInfo(vars: #seq) = @@ -680,17 +680,17 @@ module VersionResourceFormat = let szKey = Bytes.stringAsUnicodeNullTerminated "VS_VERSION_INFO" // Contains the Unicode string VS_VERSION_INFO let value = VS_FIXEDFILEINFO (fixedFileInfo) let children = - [| yield StringFileInfo(stringFileInfo) - yield VarFileInfo(varFileInfo) + [| yield StringFileInfo stringFileInfo + yield VarFileInfo varFileInfo |] VersionInfoElement(wType, szKey, Some value, children, false) - let VS_VERSION_INFO_RESOURCE(data) = + let VS_VERSION_INFO_RESOURCE data = let dwTypeID = 0x0010 let dwNameID = 0x0001 let wMemFlags = 0x0030 // REVIEW: HARDWIRED TO ENGLISH let wLangID = 0x0 - ResFileFormat.ResFileNode(dwTypeID, dwNameID, wMemFlags, wLangID, VS_VERSION_INFO(data)) + ResFileFormat.ResFileNode(dwTypeID, dwNameID, wMemFlags, wLangID, VS_VERSION_INFO data) module ManifestResourceFormat = @@ -713,7 +713,7 @@ module AttributeHelpers = | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with - | Some (Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> Some (s) + | Some (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some (s) | _ -> None let TryFindIntAttribute (g: TcGlobals) attrib attribs = @@ -721,7 +721,7 @@ module AttributeHelpers = | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with - | Some (Attrib(_, _, [ AttribInt32Arg(i) ], _, _, _, _)) -> Some (i) + | Some (Attrib(_, _, [ AttribInt32Arg i ], _, _, _, _)) -> Some (i) | _ -> None let TryFindBoolAttribute (g: TcGlobals) attrib attribs = @@ -729,7 +729,7 @@ module AttributeHelpers = | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with - | Some (Attrib(_, _, [ AttribBoolArg(p) ], _, _, _, _)) -> Some (p) + | Some (Attrib(_, _, [ AttribBoolArg p ], _, _, _, _)) -> Some (p) | _ -> None let (|ILVersion|_|) (versionString: string) = @@ -804,7 +804,7 @@ module MainModuleBuilder = let systemNumericsAssemblyRef = ILAssemblyRef.Create(refNumericsDllName, aref.Hash, aref.PublicKey, aref.Retargetable, aref.Version, aref.Locale) typesForwardedToSystemNumerics |> Seq.map (fun t -> - { ScopeRef = ILScopeRef.Assembly(systemNumericsAssemblyRef) + { ScopeRef = ILScopeRef.Assembly systemNumericsAssemblyRef Name = t Attributes = enum(0x00200000) ||| TypeAttributes.Public Nested = mkILNestedExportedTypes [] @@ -817,7 +817,7 @@ module MainModuleBuilder = let attrName = "System.Reflection.AssemblyFileVersionAttribute" match findStringAttr attrName with | None -> assemblyVersion - | Some (AttributeHelpers.ILVersion(v)) -> v + | Some (AttributeHelpers.ILVersion v) -> v | Some _ -> // Warning will be reported by TypeChecker.fs assemblyVersion @@ -827,7 +827,7 @@ module MainModuleBuilder = let toDotted (version: ILVersionInfo) = sprintf "%d.%d.%d.%d" version.Major version.Minor version.Build version.Revision match findStringAttr attrName with | None | Some "" -> fileVersion |> toDotted - | Some (AttributeHelpers.ILVersion(v)) -> v |> toDotted + | Some (AttributeHelpers.ILVersion v) -> v |> toDotted | Some v -> // Warning will be reported by TypeChecker.fs v @@ -990,7 +990,7 @@ module MainModuleBuilder = yield ("FileVersion", (sprintf "%d.%d.%d.%d" fileVersionInfo.Major fileVersionInfo.Minor fileVersionInfo.Build fileVersionInfo.Revision)) yield ("ProductVersion", productVersionString) match tcConfig.outputFile with - | Some f -> yield ("OriginalFilename", Path.GetFileName(f)) + | Some f -> yield ("OriginalFilename", Path.GetFileName f) | None -> () yield! FindAttribute "Comments" "System.Reflection.AssemblyDescriptionAttribute" yield! FindAttribute "FileDescription" "System.Reflection.AssemblyTitleAttribute" @@ -1233,7 +1233,7 @@ module StaticLinker = let fakeModule = mkILSimpleModule "" "" true (4, 0) false (mkILTypeDefs tdefs2) None None 0 (mkILExportedTypes []) "" let fakeModule = fakeModule |> Morphs.morphILTypeRefsInILModuleMemoized ilGlobals (fun tref -> - if MainModuleBuilder.injectedCompatTypes.Contains(tref.Name) || (tref.Enclosing |> List.exists (fun x -> MainModuleBuilder.injectedCompatTypes.Contains(x))) then + if MainModuleBuilder.injectedCompatTypes.Contains(tref.Name) || (tref.Enclosing |> List.exists (fun x -> MainModuleBuilder.injectedCompatTypes.Contains x)) then tref //|> Morphs.morphILScopeRefsInILTypeRef (function ILScopeRef.Local -> ilGlobals.mscorlibScopeRef | x -> x) // The implementations of Tuple use two private methods from System.Environment to get a resource string. Remap it @@ -1373,7 +1373,7 @@ module StaticLinker = for n in tcConfig.extraStaticLinkRoots do match depModuleTable.TryFind n with | Some x -> yield x - | None -> error(Error(FSComp.SR.fscAssemblyNotFoundInDependencySet(n), rangeStartup)) + | None -> error(Error(FSComp.SR.fscAssemblyNotFoundInDependencySet n, rangeStartup)) ] let remaining = ref roots @@ -1489,7 +1489,7 @@ module StaticLinker = let generatedILTypeDefs = let rec buildRelocatedGeneratedType (ProviderGeneratedType(ilOrigTyRef, ilTgtTyRef, ch)) = let isNested = not (isNil ilTgtTyRef.Enclosing) - match allTypeDefsInProviderGeneratedAssemblies.TryGetValue(ilOrigTyRef) with + match allTypeDefsInProviderGeneratedAssemblies.TryGetValue ilOrigTyRef with | true, ilOrigTypeDef -> if debugStaticLinking then printfn "Relocating %s to %s " ilOrigTyRef.QualifiedName ilTgtTyRef.QualifiedName let ilOrigTypeDef = @@ -1659,7 +1659,7 @@ let GetStrongNameSigner signingInfo = Some (ILBinaryWriter.ILStrongNameSigner.OpenKeyPairFile s) with e -> // Note:: don't use errorR here since we really want to fail and not produce a binary - error(Error(FSComp.SR.fscKeyFileCouldNotBeOpened(s), rangeCmdArgs)) + error(Error(FSComp.SR.fscKeyFileCouldNotBeOpened s, rangeCmdArgs)) //---------------------------------------------------------------------------- // CopyFSharpCore @@ -1670,11 +1670,11 @@ let GetStrongNameSigner signingInfo = // 2) If not, but FSharp.Core.dll exists beside the compiler binaries, it will copy it to output directory. // 3) If not, it will produce an error. let CopyFSharpCore(outFile: string, referencedDlls: AssemblyReference list) = - let outDir = Path.GetDirectoryName(outFile) + let outDir = Path.GetDirectoryName outFile let fsharpCoreAssemblyName = GetFSharpCoreLibraryName() + ".dll" let fsharpCoreDestinationPath = Path.Combine(outDir, fsharpCoreAssemblyName) let copyFileIfDifferent src dest = - if not (File.Exists(dest)) || (File.GetCreationTimeUtc(src) <> File.GetCreationTimeUtc(dest)) then + if not (File.Exists dest) || (File.GetCreationTimeUtc src <> File.GetCreationTimeUtc dest) then File.Copy(src, dest, true) match referencedDlls |> Seq.tryFind (fun dll -> String.Equals(Path.GetFileName(dll.Text), fsharpCoreAssemblyName, StringComparison.CurrentCultureIgnoreCase)) with @@ -1682,9 +1682,9 @@ let CopyFSharpCore(outFile: string, referencedDlls: AssemblyReference list) = | None -> let executionLocation = Assembly.GetExecutingAssembly().Location - let compilerLocation = Path.GetDirectoryName(executionLocation) + let compilerLocation = Path.GetDirectoryName executionLocation let compilerFsharpCoreDllPath = Path.Combine(compilerLocation, fsharpCoreAssemblyName) - if File.Exists(compilerFsharpCoreDllPath) then + if File.Exists compilerFsharpCoreDllPath then copyFileIfDifferent compilerFsharpCoreDllPath fsharpCoreDestinationPath else errorR(Error(FSComp.SR.fsharpCoreNotFoundToBeCopied(), rangeCmdArgs)) @@ -1716,9 +1716,9 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, let setProcessThreadLocals tcConfigB = match tcConfigB.preferredUiLang with #if FX_RESHAPED_GLOBALIZATION - | Some s -> System.Globalization.CultureInfo.CurrentUICulture <- new System.Globalization.CultureInfo(s) + | Some s -> CultureInfo.CurrentUICulture <- new CultureInfo(s) #else - | Some s -> Thread.CurrentThread.CurrentUICulture <- new System.Globalization.CultureInfo(s) + | Some s -> Thread.CurrentThread.CurrentUICulture <- new CultureInfo(s) #endif | None -> () if tcConfigB.utf8output then @@ -1744,7 +1744,7 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, SetTailcallSwitch tcConfigB OptionSwitch.On // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) - let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger(exiter) + let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger exiter let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) // Share intern'd strings across all lexing/parsing @@ -1763,7 +1763,7 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, with e -> errorRecovery e rangeStartup - delayForFlagsLogger.ForwardDelayedDiagnostics(tcConfigB) + delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB exiter.Exit 1 tcConfigB.conditionalCompilationDefines <- "COMPILED" :: tcConfigB.conditionalCompilationDefines @@ -1775,12 +1775,12 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, tcConfigB.DecideNames sourceFiles with e -> errorRecovery e rangeStartup - delayForFlagsLogger.ForwardDelayedDiagnostics(tcConfigB) + delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB exiter.Exit 1 // DecideNames may give "no inputs" error. Abort on error at this point. bug://3911 if not tcConfigB.continueAfterParseFailure && delayForFlagsLogger.ErrorCount > 0 then - delayForFlagsLogger.ForwardDelayedDiagnostics(tcConfigB) + delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB exiter.Exit 1 // If there's a problem building TcConfig, abort @@ -1788,7 +1788,7 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, try TcConfig.Create(tcConfigB, validate=false) with e -> - delayForFlagsLogger.ForwardDelayedDiagnostics(tcConfigB) + delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB exiter.Exit 1 let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) @@ -1797,14 +1797,14 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, let _unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) // Forward all errors from flags - delayForFlagsLogger.CommitDelayedDiagnostics(errorLogger) + delayForFlagsLogger.CommitDelayedDiagnostics errorLogger if not tcConfigB.continueAfterParseFailure then AbortOnError(errorLogger, exiter) // Resolve assemblies ReportTime tcConfig "Import mscorlib and FSharp.Core.dll" - let foundationalTcConfigP = TcConfigProvider.Constant(tcConfig) + let foundationalTcConfigP = TcConfigProvider.Constant tcConfig let sysRes, otherRes, knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok, tcConfig) // Import basic assemblies @@ -1822,7 +1822,7 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, isLastCompiland |> List.zip sourceFiles // PERF: consider making this parallel, once uses of global state relevant to parsing are cleaned up |> List.choose (fun (filename: string, isLastCompiland) -> - let pathOfMetaCommandSource = Path.GetDirectoryName(filename) + let pathOfMetaCommandSource = Path.GetDirectoryName filename match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with | Some input -> Some (input, pathOfMetaCommandSource) | None -> None @@ -1843,7 +1843,7 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, inputs |> List.iter (fun (input, _filename) -> printf "AST:\n"; printfn "%+A" input; printf "\n") let tcConfig = (tcConfig, inputs) ||> List.fold (fun z (x, m) -> ApplyMetaCommandsFromInputToTcConfig(z, x, m)) - let tcConfigP = TcConfigProvider.Constant(tcConfig) + let tcConfigP = TcConfigProvider.Constant tcConfig // Import other assemblies ReportTime tcConfig "Import non-system references" @@ -1960,7 +1960,7 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, with e -> exiter.Exit 1 - let foundationalTcConfigP = TcConfigProvider.Constant(tcConfig) + let foundationalTcConfigP = TcConfigProvider.Constant tcConfig let sysRes,otherRes,knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok, tcConfig) let tcGlobals,frameworkTcImports = TcImports.BuildFrameworkTcImports (ctok, foundationalTcConfigP, sysRes, otherRes) |> Cancellable.runWithoutCancellation @@ -1968,7 +1968,7 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, let meta = Directory.GetCurrentDirectory() let tcConfig = (tcConfig,inputs) ||> List.fold (fun tcc inp -> ApplyMetaCommandsFromInputToTcConfig (tcc, inp,meta)) - let tcConfigP = TcConfigProvider.Constant(tcConfig) + let tcConfigP = TcConfigProvider.Constant tcConfig let tcGlobals,tcImports = let tcImports = TcImports.BuildNonFrameworkTcImports(ctok, tcConfigP, tcGlobals, frameworkTcImports, otherRes,knownUnresolved) |> Cancellable.runWithoutCancellation diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 59c39c77b..61602ee77 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -1221,7 +1221,7 @@ type internal FsiDynamicCompiler let bindingA = mkBind (mkSynPatVar None itID) expr (* let it = *) // NOTE: the generalizability of 'expr' must not be damaged, e.g. this can't be an application //let saverPath = ["Microsoft";"FSharp";"Compiler";"Interactive";"RuntimeHelpers";"SaveIt"] //let dots = List.replicate (saverPath.Length - 1) m - //let bindingB = mkBind (SynPat.Wild m) (SynExpr.App(ExprAtomicFlag.NonAtomic, false, SynExpr.LongIdent(false, LongIdentWithDots(List.map (mkSynId m) saverPath,dots),None,m), itExp,m)) (* let _ = saverPath it *) + //let bindingB = mkBind (SynPat.Wild m) (SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.LongIdent (false, LongIdentWithDots(List.map (mkSynId m) saverPath,dots),None,m), itExp,m)) (* let _ = saverPath it *) let defA = SynModuleDecl.Let (false, [bindingA], m) //let defB = SynModuleDecl.Let (false, [bindingB], m) @@ -1231,9 +1231,9 @@ type internal FsiDynamicCompiler member __.CreateDebuggerBreak (m : range) = let breakPath = ["System";"Diagnostics";"Debugger";"Break"] let dots = List.replicate (breakPath.Length - 1) m - let methCall = SynExpr.LongIdent(false, LongIdentWithDots(List.map (mkSynId m) breakPath, dots), None, m) - let args = SynExpr.Const(SynConst.Unit, m) - let breakStatement = SynExpr.App(ExprAtomicFlag.Atomic, false, methCall, args, m) + let methCall = SynExpr.LongIdent (false, LongIdentWithDots(List.map (mkSynId m) breakPath, dots), None, m) + let args = SynExpr.Const (SynConst.Unit, m) + let breakStatement = SynExpr.App (ExprAtomicFlag.Atomic, false, methCall, args, m) SynModuleDecl.DoExpr(SequencePointInfoForBinding.NoSequencePointAtDoBinding, breakStatement, m) member __.EvalRequireReference (ctok, istate, m, path) = @@ -2212,7 +2212,7 @@ type internal FsiInteractionProcessor let expr = parseExpression tokenizer let m = expr.Range // Make this into "(); expr" to suppress generalization and compilation-as-function - let exprWithSeq = SynExpr.Sequential(SequencePointInfoForSeq.SuppressSequencePointOnStmtOfSequential,true,SynExpr.Const(SynConst.Unit,m.StartRange), expr, m) + let exprWithSeq = SynExpr.Sequential (SequencePointInfoForSeq.SuppressSequencePointOnStmtOfSequential,true,SynExpr.Const (SynConst.Unit,m.StartRange), expr, m) mainThreadProcessParsedExpression ctok errorLogger (exprWithSeq, istate)) |> commitResult diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index ae9e1ff49..570a63360 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -240,7 +240,7 @@ let SearchEntireHierarchyOfType f g amap m ty = FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes SkipUnrefInterfaces.Yes (fun ty acc -> match acc with - | None -> if f ty then Some(ty) else None + | None -> if f ty then Some ty else None | Some _ -> acc) g amap m ty None @@ -415,7 +415,7 @@ let GetCompiledReturnTyOfProvidedMethodInfo amap m (mi: Tainted - let parentToMemberInst, _ = mkTyparToTyparRenaming (ovByMethValRef.MemberApparentEntity.Typars(m)) enclosingTypars + let parentToMemberInst, _ = mkTyparToTyparRenaming (ovByMethValRef.MemberApparentEntity.Typars m) enclosingTypars let res = instSlotSig parentToMemberInst slotsig res | None -> @@ -593,7 +593,7 @@ type ILFieldInit with | null -> ILFieldInit.Null | _ -> let objTy = v.GetType() - let v = if objTy.IsEnum then objTy.GetField("value__").GetValue(v) else v + let v = if objTy.IsEnum then objTy.GetField("value__").GetValue v else v match v with | :? single as i -> ILFieldInit.Single i | :? double as i -> ILFieldInit.Double i @@ -924,7 +924,7 @@ type MethInfo = | FSMeth _ -> None #if !NO_EXTENSIONTYPING | ProvidedMeth (_, mb, _, m) -> - let staticParams = mb.PApplyWithProvider((fun (mb, provider) -> mb.GetStaticParametersForMethod(provider)), range=m) + let staticParams = mb.PApplyWithProvider((fun (mb, provider) -> mb.GetStaticParametersForMethod provider), range=m) let staticParams = staticParams.PApplyArray(id, "GetStaticParametersForMethod", m) match staticParams with | [| |] -> None @@ -1031,7 +1031,7 @@ type MethInfo = | DefaultStructCtor _ -> XmlDoc.Empty #if !NO_EXTENSIONTYPING | ProvidedMeth(_, mi, _, m)-> - XmlDoc (mi.PUntaint((fun mix -> (mix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(mi.TypeProvider.PUntaintNoFailure(id))), m)) + XmlDoc (mi.PUntaint((fun mix -> (mix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(mi.TypeProvider.PUntaintNoFailure id)), m)) #endif /// Try to get an arbitrary F# ValRef associated with the member. This is to determine if the member is virtual, amongst other things. @@ -1217,13 +1217,13 @@ type MethInfo = // xs.Map // but is compiled as a generic methods with two type arguments // Map<'T, 'U>(this: List<'T>, f : 'T -> 'U) - member x.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs) = + member x.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers tyargs = (if x.IsFSharpStyleExtensionMember then argsOfAppTy x.TcGlobals x.ApparentEnclosingAppType else []) @ tyargs /// Indicates if this method is a generated method associated with an F# CLIEvent property compiled as a .NET event member x.IsFSharpEventPropertyMethod = match x with - | FSMeth(g, _, vref, _) -> vref.IsFSharpEventProperty(g) + | FSMeth(g, _, vref, _) -> vref.IsFSharpEventProperty g #if !NO_EXTENSIONTYPING | ProvidedMeth _ -> false #endif @@ -1271,7 +1271,7 @@ type MethInfo = | DefaultStructCtor(_, _ty) -> 34892 // "ty" doesn't support hashing. We could use "hash (tcrefOfAppTy g ty).CompiledName" or // something but we don't have a "g" parameter here yet. But this hash need only be very approximate anyway #if !NO_EXTENSIONTYPING - | ProvidedMeth(_, mi, _, _) -> ProvidedMethodInfo.TaintedGetHashCode(mi) + | ProvidedMeth(_, mi, _, _) -> ProvidedMethodInfo.TaintedGetHashCode mi #endif /// Apply a type instantiation to a method info, i.e. apply the instantiation to the enclosing type. @@ -1415,7 +1415,7 @@ type MethInfo = // Emit a warning, and ignore the DefaultParameterValue argument altogether. warning(Error(FSComp.SR.DefaultParameterValueNotAppropriateForArgument(), m)) NotOptional - | Some (Expr.Const((ConstToILFieldInit fi), _, _)) -> + | Some (Expr.Const ((ConstToILFieldInit fi), _, _)) -> // Good case - all is well. CallerSide (Constant fi) | _ -> @@ -1456,10 +1456,10 @@ type MethInfo = | ProvidedMeth(amap, mi, _, _) -> // A single group of tupled arguments [ [for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do - let isParamArrayArg = p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure(id), typeof.FullName).IsSome), m) + let isParamArrayArg = p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure id, typeof.FullName).IsSome), m) let optArgInfo = OptionalArgInfoOfProvidedParameter amap m p let reflArgInfo = - match p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure(id), typeof.FullName)), m) with + match p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure id, typeof.FullName)), m) with | Some ([ Some (:? bool as b) ], _) -> ReflectedArgInfo.Quote b | Some _ -> ReflectedArgInfo.Quote false | None -> ReflectedArgInfo.None @@ -1478,13 +1478,13 @@ type MethInfo = match x with | FSMeth(g, _, vref, _) -> match vref.RecursiveValInfo with - | ValInRecScope(false) -> error(Error((FSComp.SR.InvalidRecursiveReferenceToAbstractSlot()), m)) + | ValInRecScope false -> error(Error((FSComp.SR.InvalidRecursiveReferenceToAbstractSlot()), m)) | _ -> () let allTyparsFromMethod, _, retTy, _ = GetTypeOfMemberInMemberForm g vref // A slot signature is w.r.t. the type variables of the type it is associated with. // So we have to rename from the member type variables to the type variables of the type. - let formalEnclosingTypars = x.ApparentEnclosingTyconRef.Typars(m) + let formalEnclosingTypars = x.ApparentEnclosingTyconRef.Typars m let formalEnclosingTyparsFromMethod, formalMethTypars = List.splitAt formalEnclosingTypars.Length allTyparsFromMethod let methodToParentRenaming, _ = mkTyparToTyparRenaming formalEnclosingTyparsFromMethod formalEnclosingTypars let formalParams = @@ -1502,7 +1502,7 @@ type MethInfo = // then that does not correspond to a slotsig compiled as a 'void' return type. // REVIEW: should we copy down attributes to slot params? let tcref = tcrefOfAppTy g x.ApparentEnclosingAppType - let formalEnclosingTyparsOrig = tcref.Typars(m) + let formalEnclosingTyparsOrig = tcref.Typars m let formalEnclosingTypars = copyTypars formalEnclosingTyparsOrig let _, formalEnclosingTyparTys = FixupNewTypars m [] [] formalEnclosingTyparsOrig formalEnclosingTypars let formalMethTypars = copyTypars x.FormalMethodTypars @@ -1587,14 +1587,14 @@ type MethInfo = let memberParentTypars, _, _, _ = AnalyzeTypeOfMemberVal false g (ty, vref) memberParentTypars | _ -> - x.DeclaringTyconRef.Typars(m) + x.DeclaringTyconRef.Typars m /// Tries to get the object arg type if it's a byref type. member x.TryObjArgByrefType(amap, m, minst) = x.GetObjArgTypes(amap, m, minst) |> List.tryHead |> Option.bind (fun ty -> - if isByrefTy x.TcGlobals ty then Some(ty) + if isByrefTy x.TcGlobals ty then Some ty else None) //------------------------------------------------------------------------- @@ -1798,7 +1798,7 @@ type UnionCaseInfo = member x.Name = x.UnionCase.DisplayName /// Get the instantiation of the type parameters of the declaring type of the union case - member x.GetTyparInst(m) = mkTyparInst (x.TyconRef.Typars(m)) x.TypeInst + member x.GetTyparInst m = mkTyparInst (x.TyconRef.Typars m) x.TypeInst override x.ToString() = x.TyconRef.ToString() + "::" + x.Name @@ -2073,7 +2073,7 @@ type PropInfo = /// Indicates if this is an F# property compiled as a CLI event, e.g. a [] property. member x.IsFSharpEventProperty = match x with - | FSProp(g, _, Some vref, None) -> vref.IsFSharpEventProperty(g) + | FSProp(g, _, Some vref, None) -> vref.IsFSharpEventProperty g #if !NO_EXTENSIONTYPING | ProvidedProp _ -> false #endif @@ -2104,7 +2104,7 @@ type PropInfo = | FSProp(_, _, None, None) -> failwith "unreachable" #if !NO_EXTENSIONTYPING | ProvidedProp(_, pi, m) -> - XmlDoc (pi.PUntaint((fun pix -> (pix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(pi.TypeProvider.PUntaintNoFailure(id))), m)) + XmlDoc (pi.PUntaint((fun pix -> (pix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(pi.TypeProvider.PUntaintNoFailure id)), m)) #endif /// Get the TcGlobals associated with the object @@ -2197,7 +2197,7 @@ type PropInfo = /// Must be compatible with ItemsAreEffectivelyEqual relation. static member PropInfosUseIdenticalDefinitions x1 x2 = let optVrefEq g = function - | Some(v1), Some(v2) -> valRefEq g v1 v2 + | Some v1, Some v2 -> valRefEq g v1 v2 | None, None -> true | _ -> false match x1, x2 with @@ -2218,7 +2218,7 @@ type PropInfo = let vth = (vrefOpt1 |> Option.map (fun vr -> vr.LogicalName), (vrefOpt2 |> Option.map (fun vr -> vr.LogicalName))) hash vth #if !NO_EXTENSIONTYPING - | ProvidedProp(_, pi, _) -> ProvidedPropertyInfo.TaintedGetHashCode(pi) + | ProvidedProp(_, pi, _) -> ProvidedPropertyInfo.TaintedGetHashCode pi #endif //------------------------------------------------------------------------- @@ -2356,7 +2356,7 @@ type EventInfo = | FSEvent (_, p, _, _) -> p.XmlDoc #if !NO_EXTENSIONTYPING | ProvidedEvent (_, ei, m) -> - XmlDoc (ei.PUntaint((fun eix -> (eix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(ei.TypeProvider.PUntaintNoFailure(id))), m)) + XmlDoc (ei.PUntaint((fun eix -> (eix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(ei.TypeProvider.PUntaintNoFailure id)), m)) #endif /// Get the logical name of the event. @@ -2466,7 +2466,7 @@ type EventInfo = | ILEvent ileinfo -> hash ileinfo.RawMetadata.Name | FSEvent(_, pi, vref1, vref2) -> hash ( pi.ComputeHashCode(), vref1.LogicalName, vref2.LogicalName) #if !NO_EXTENSIONTYPING - | ProvidedEvent (_, ei, _) -> ProvidedEventInfo.TaintedGetHashCode(ei) + | ProvidedEvent (_, ei, _) -> ProvidedEventInfo.TaintedGetHashCode ei #endif //------------------------------------------------------------------------- diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 1a7afd753..230c779a4 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -27,14 +27,14 @@ let debugPrint(s) = let debugPrint(s) = ignore s #endif -let exprFromParseError (e:SynExpr) = SynExpr.FromParseError(e,e.Range) +let exprFromParseError (e:SynExpr) = SynExpr.FromParseError (e,e.Range) let patFromParseError (e:SynPat) = SynPat.FromParseError(e, e.Range) let mkSynOptionalExpr (m: range) xopt = let m = m.MakeSynthetic() match xopt with | None -> mkSynLidGet m Ast.FSharpLib.CorePath "None" - | Some x -> SynExpr.App(ExprAtomicFlag.NonAtomic, false, mkSynLidGet m Ast.FSharpLib.CorePath "Some",x,m) + | Some x -> SynExpr.App (ExprAtomicFlag.NonAtomic, false, mkSynLidGet m Ast.FSharpLib.CorePath "Some",x,m) // record bindings returned by the recdExprBindings rule has shape: // (binding, separator-before-this-binding) @@ -2484,10 +2484,10 @@ cPrototype: let mBindLhs = lhs parseState let mWhole = lhs parseState let mRhs = lhs parseState - let rhsExpr = SynExpr.App(ExprAtomicFlag.NonAtomic, + let rhsExpr = SynExpr.App (ExprAtomicFlag.NonAtomic, false, - SynExpr.Ident(ident("failwith",rhs parseState 6)), - SynExpr.Const(SynConst.String("extern was not given a DllImport attribute",rhs parseState 8),rhs parseState 8), + SynExpr.Ident (ident("failwith",rhs parseState 6)), + SynExpr.Const (SynConst.String("extern was not given a DllImport attribute",rhs parseState 8),rhs parseState 8), mRhs) (fun attrs vis -> let bindingId = SynPat.LongIdent (LongIdentWithDots([nm],[]), None, Some noInferredTypars, SynConstructorArgs.Pats [SynPat.Tuple(false,args,argsm)], vis, nmm) @@ -2991,15 +2991,15 @@ typedSeqExprEOF: seqExpr: | declExpr seps seqExpr - { SynExpr.Sequential(SequencePointsAtSeq,true,$1,$3,unionRanges $1.Range $3.Range) } + { SynExpr.Sequential (SequencePointsAtSeq,true,$1,$3,unionRanges $1.Range $3.Range) } | declExpr seps { $1 } | declExpr %prec SEMICOLON { $1 } | declExpr THEN seqExpr %prec prec_then_before - { SynExpr.Sequential(SequencePointsAtSeq,false,$1,$3,unionRanges $1.Range $3.Range ) } + { SynExpr.Sequential (SequencePointsAtSeq,false,$1,$3,unionRanges $1.Range $3.Range ) } | declExpr OTHEN OBLOCKBEGIN typedSeqExpr oblockend %prec prec_then_before - { SynExpr.Sequential(SequencePointsAtSeq,false,$1,$4,unionRanges $1.Range $4.Range) } + { SynExpr.Sequential (SequencePointsAtSeq,false,$1,$4,unionRanges $1.Range $4.Range) } | hardwhiteLetBindings %prec prec_args_error { let hwlb,m = $1 let mLetKwd,isUse = match hwlb with (BindingSetPreAttrs(m,_,isUse,_,_)) -> m,isUse @@ -3047,7 +3047,7 @@ declExpr: | hardwhiteDoBinding %prec expr_let { let e = snd $1 - SynExpr.Do(e,e.Range) } + SynExpr.Do (e,e.Range) } | anonMatchingExpr %prec expr_function { $1 } @@ -3059,7 +3059,7 @@ declExpr: { let mMatch = (rhs parseState 1) let mWith,(clauses,mLast) = $3 let spBind = SequencePointAtBinding(unionRanges mMatch mWith) - SynExpr.Match(spBind, $2,clauses,unionRanges mMatch mLast) } + SynExpr.Match (spBind, $2,clauses,unionRanges mMatch mLast) } | MATCH typedSeqExpr recover %prec expr_match { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileMatch()) @@ -3070,7 +3070,7 @@ declExpr: { let mMatch = (rhs parseState 1) let mWith,(clauses,mLast) = $3 let spBind = SequencePointAtBinding(unionRanges mMatch mWith) - SynExpr.MatchBang(spBind, $2,clauses,unionRanges mMatch mLast) } + SynExpr.MatchBang (spBind, $2,clauses,unionRanges mMatch mLast) } | MATCH_BANG typedSeqExpr recover %prec expr_match { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileMatch()) @@ -3085,7 +3085,7 @@ declExpr: let mTryToWith = unionRanges mTry mWith let mWithToLast = unionRanges mWith mLast let mTryToLast = unionRanges mTry mLast - SynExpr.TryWith($2, mTryToWith, clauses,mWithToLast, mTryToLast,spTry,spWith) } + SynExpr.TryWith ($2, mTryToWith, clauses,mWithToLast, mTryToLast,spTry,spWith) } | TRY typedSeqExprBlockR recover %prec expr_try { // Produce approximate expression during error recovery @@ -3098,7 +3098,7 @@ declExpr: let spTry = SequencePointAtTry(mTry) let spFinally = SequencePointAtFinally(rhs parseState 3) let mTryToLast = unionRanges mTry $4.Range - SynExpr.TryFinally($2, $4,mTryToLast,spTry,spFinally) } + SynExpr.TryFinally ($2, $4,mTryToLast,spTry,spFinally) } | IF declExpr ifExprCases %prec expr_if { let mIf = (rhs parseState 1) @@ -3119,22 +3119,22 @@ declExpr: let m = (rhs parseState 1) let mEnd = m.EndRange let spIfToThen = SequencePointAtBinding mEnd - exprFromParseError (SynExpr.IfThenElse(arbExpr("ifGuard1",mEnd),arbExpr("thenBody1",mEnd),None,spIfToThen,true,m,m)) } + exprFromParseError (SynExpr.IfThenElse (arbExpr("ifGuard1",mEnd),arbExpr("thenBody1",mEnd),None,spIfToThen,true,m,m)) } | LAZY declExpr %prec expr_lazy - { SynExpr.Lazy($2,unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.Lazy ($2,unionRanges (rhs parseState 1) $2.Range) } | ASSERT declExpr %prec expr_assert - { SynExpr.Assert($2, unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.Assert ($2, unionRanges (rhs parseState 1) $2.Range) } | ASSERT %prec expr_assert { raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsAssertIsNotFirstClassValue()) } | OLAZY declExprBlock %prec expr_lazy - { SynExpr.Lazy($2,unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.Lazy ($2,unionRanges (rhs parseState 1) $2.Range) } | OASSERT declExprBlock %prec expr_assert - { SynExpr.Assert($2, unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.Assert ($2, unionRanges (rhs parseState 1) $2.Range) } | OASSERT %prec expr_assert { raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsAssertIsNotFirstClassValue()) } @@ -3143,14 +3143,14 @@ declExpr: { let mWhileHeader = unionRanges (rhs parseState 1) $2.Range let spWhile = SequencePointAtWhileLoop mWhileHeader let mWhileAll = unionRanges (rhs parseState 1) $4.Range - SynExpr.While(spWhile,$2,$4,mWhileAll) } + SynExpr.While (spWhile,$2,$4,mWhileAll) } | WHILE declExpr doToken typedSeqExprBlock recover { if not $5 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWhile()) let mWhileHeader = unionRanges (rhs parseState 1) $2.Range let spWhile = SequencePointAtWhileLoop mWhileHeader let mWhileAll = unionRanges (rhs parseState 1) $4.Range - exprFromParseError (SynExpr.While(spWhile,$2,$4,mWhileAll)) } + exprFromParseError (SynExpr.While (spWhile,$2,$4,mWhileAll)) } | WHILE declExpr doToken error doneDeclEnd { // silent recovery @@ -3158,7 +3158,7 @@ declExpr: let spWhile = SequencePointAtWhileLoop mWhileHeader let mWhileBodyArb = unionRanges (rhs parseState 4) (rhs parseState 5) let mWhileAll = unionRanges (rhs parseState 1) (rhs parseState 5) - SynExpr.While(spWhile,$2,arbExpr("whileBody1",mWhileBodyArb),mWhileAll) } + SynExpr.While (spWhile,$2,arbExpr("whileBody1",mWhileBodyArb),mWhileAll) } | WHILE declExpr recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsWhileDoExpected()) @@ -3166,7 +3166,7 @@ declExpr: let spWhile = SequencePointAtWhileLoop mWhileHeader let mWhileBodyArb = rhs parseState 3 let mWhileAll = unionRanges (rhs parseState 1) (rhs parseState 3) - exprFromParseError (SynExpr.While(spWhile,$2,arbExpr("whileBody2",mWhileBodyArb),mWhileAll)) } + exprFromParseError (SynExpr.While (spWhile,$2,arbExpr("whileBody2",mWhileBodyArb),mWhileAll)) } | WHILE recover { if not $2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWhile()) @@ -3178,19 +3178,19 @@ declExpr: let spWhile = SequencePointAtWhileLoop mWhileHeader let mWhileBodyArb = rhs parseState 3 let mWhileAll = unionRanges (rhs parseState 1) (rhs parseState 3) - exprFromParseError (SynExpr.While(spWhile,arbExpr("whileGuard1",mWhileHeader),arbExpr("whileBody3",mWhileBodyArb),mWhileAll)) } + exprFromParseError (SynExpr.While (spWhile,arbExpr("whileGuard1",mWhileHeader),arbExpr("whileBody3",mWhileBodyArb),mWhileAll)) } | FOR forLoopBinder doToken typedSeqExprBlock doneDeclEnd { let spBind = SequencePointAtForLoop(rhs2 parseState 1 3) let (a,b,_) = $2 - SynExpr.ForEach(spBind,SeqExprOnly false,true,a,b,$4,unionRanges (rhs parseState 1) $4.Range) } + SynExpr.ForEach (spBind,SeqExprOnly false,true,a,b,$4,unionRanges (rhs parseState 1) $4.Range) } | FOR forLoopBinder doToken typedSeqExprBlock ends_coming_soon_or_recover { if not $5 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()) let spBind = SequencePointAtForLoop(rhs2 parseState 1 3) let (a,b,_) = $2 let mForLoopAll = unionRanges (rhs parseState 1) $4.Range - SynExpr.ForEach(spBind,SeqExprOnly false,true,a,b,$4,mForLoopAll) } + SynExpr.ForEach (spBind,SeqExprOnly false,true,a,b,$4,mForLoopAll) } | FOR forLoopBinder doToken error doneDeclEnd { // Silent recovery @@ -3199,7 +3199,7 @@ declExpr: let (a,b,_) = $2 let mForLoopBodyArb = rhs parseState 5 let mForLoopAll = rhs2 parseState 1 5 - SynExpr.ForEach(spBind,SeqExprOnly false,true,a,b,arbExpr("forLoopBody2a",mForLoopBodyArb),mForLoopAll) } + SynExpr.ForEach (spBind,SeqExprOnly false,true,a,b,arbExpr("forLoopBody2a",mForLoopBodyArb),mForLoopAll) } | FOR forLoopBinder doToken ends_coming_soon_or_recover { if not $4 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsExpectedExpressionAfterToken()) @@ -3208,7 +3208,7 @@ declExpr: let (a,b,_) = $2 let mForLoopBodyArb = rhs parseState 3 let mForLoopAll = rhs2 parseState 1 3 - SynExpr.ForEach(spBind,SeqExprOnly false,true,a,b,arbExpr("forLoopBody2",mForLoopBodyArb),mForLoopAll) } + SynExpr.ForEach (spBind,SeqExprOnly false,true,a,b,arbExpr("forLoopBody2",mForLoopBodyArb),mForLoopAll) } | FOR forLoopBinder ends_coming_soon_or_recover { let (a,b,ok) = $2 @@ -3217,14 +3217,14 @@ declExpr: let spBind = SequencePointAtForLoop mForLoopHeader let mForLoopBodyArb = rhs parseState 3 let mForLoopAll = rhs2 parseState 1 3 - SynExpr.ForEach(spBind,SeqExprOnly false,true,a,b,arbExpr("forLoopBody1",mForLoopBodyArb),mForLoopAll) } + SynExpr.ForEach (spBind,SeqExprOnly false,true,a,b,arbExpr("forLoopBody1",mForLoopBodyArb),mForLoopAll) } | FOR forLoopRange doToken typedSeqExprBlock doneDeclEnd { let mForLoopHeader = rhs2 parseState 1 3 let spBind = SequencePointAtForLoop mForLoopHeader let (a,b,c,d) = $2 let mForLoopAll = unionRanges (rhs parseState 1) $4.Range - SynExpr.For(spBind,a,b,c,d,$4,mForLoopAll) } + SynExpr.For (spBind,a,b,c,d,$4,mForLoopAll) } | FOR forLoopRange doToken typedSeqExprBlock recover { if not $5 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()) @@ -3233,7 +3233,7 @@ declExpr: let spBind = SequencePointAtForLoop mForLoopHeader let (a,b,c,d) = $2 let mForLoopAll = unionRanges (rhs parseState 1) $4.Range - exprFromParseError (SynExpr.For(spBind,a,b,c,d,$4,mForLoopAll)) } + exprFromParseError (SynExpr.For (spBind,a,b,c,d,$4,mForLoopAll)) } | FOR forLoopRange doToken error doneDeclEnd { // silent recovery @@ -3242,7 +3242,7 @@ declExpr: let (a,b,c,d) = $2 let mForLoopBodyArb = rhs parseState 5 let mForLoopAll = rhs2 parseState 1 5 - SynExpr.For(spBind,a,b,c,d,arbExpr("declExpr11",mForLoopBodyArb),mForLoopAll) } + SynExpr.For (spBind,a,b,c,d,arbExpr("declExpr11",mForLoopBodyArb),mForLoopAll) } | FOR forLoopRange doToken recover { if not $4 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()) @@ -3251,7 +3251,7 @@ declExpr: let (a,b,c,d) = $2 let mForLoopBodyArb = rhs parseState 3 let mForLoopAll = rhs2 parseState 1 3 - exprFromParseError (SynExpr.For(spBind,a,b,c,d,arbExpr("declExpr11",mForLoopBodyArb),mForLoopAll)) } + exprFromParseError (SynExpr.For (spBind,a,b,c,d,arbExpr("declExpr11",mForLoopBodyArb),mForLoopAll)) } | FOR forLoopRange recover { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()) @@ -3260,7 +3260,7 @@ declExpr: let (a,b,c,d) = $2 let mForLoopBodyArb = (rhs parseState 2).EndRange let mForLoopAll = rhs2 parseState 1 2 - exprFromParseError (SynExpr.For(spBind,a,b,c,d,arbExpr("declExpr11",mForLoopBodyArb),mForLoopAll)) } + exprFromParseError (SynExpr.For (spBind,a,b,c,d,arbExpr("declExpr11",mForLoopBodyArb),mForLoopAll)) } | FOR error doToken typedSeqExprBlock doneDeclEnd @@ -3268,7 +3268,7 @@ declExpr: let mForLoopHeader = rhs2 parseState 1 2 let mForLoopAll = unionRanges (rhs parseState 1) $4.Range let spBind = SequencePointAtForLoop(mForLoopHeader) - SynExpr.For(spBind,mkSynId mForLoopHeader "_loopVar",arbExpr("startLoopRange1",mForLoopHeader),true,arbExpr("endLoopRange1",rhs parseState 3),$4,mForLoopAll) } + SynExpr.For (spBind,mkSynId mForLoopHeader "_loopVar",arbExpr("startLoopRange1",mForLoopHeader),true,arbExpr("endLoopRange1",rhs parseState 3),$4,mForLoopAll) } /* do not include this one - though for fairly bizarre reasons! If the user has simply typed 'for'as the @@ -3292,7 +3292,7 @@ declExpr: let spBind = SequencePointAtForLoop mForLoopHeader let mForLoopBodyArb = rhs parseState 4 let mForLoopAll = rhs2 parseState 1 4 - SynExpr.ForEach(spBind,SeqExprOnly false,true,$2,arbExpr("forLoopCollection",mForLoopHeader),arbExpr("forLoopBody3",mForLoopBodyArb),mForLoopAll) } + SynExpr.ForEach (spBind,SeqExprOnly false,true,$2,arbExpr("forLoopCollection",mForLoopHeader),arbExpr("forLoopBody3",mForLoopBodyArb),mForLoopAll) } | FOR parenPattern recover { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()) @@ -3300,63 +3300,63 @@ declExpr: let spBind = SequencePointAtForLoop mForLoopHeader let mForLoopBodyArb = (rhs parseState 2).EndRange let mForLoopAll = rhs2 parseState 1 2 - exprFromParseError (SynExpr.ForEach(spBind,SeqExprOnly false,true,$2,arbExpr("forLoopCollection",mForLoopHeader),arbExpr("forLoopBody3",mForLoopBodyArb),mForLoopAll)) } + exprFromParseError (SynExpr.ForEach (spBind,SeqExprOnly false,true,$2,arbExpr("forLoopCollection",mForLoopHeader),arbExpr("forLoopBody3",mForLoopBodyArb),mForLoopAll)) } /* START MONADIC SYNTAX ONLY */ | YIELD declExpr - { SynExpr.YieldOrReturn(($1,not $1),$2, unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.YieldOrReturn (($1,not $1),$2, unionRanges (rhs parseState 1) $2.Range) } | YIELD_BANG declExpr - { SynExpr.YieldOrReturnFrom(($1,not $1), $2, unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.YieldOrReturnFrom (($1,not $1), $2, unionRanges (rhs parseState 1) $2.Range) } | BINDER headBindingPattern EQUALS typedSeqExprBlock IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let { let spBind = SequencePointAtBinding(rhs2 parseState 1 5) let m = unionRanges (rhs parseState 1) $7.Range - SynExpr.LetOrUseBang(spBind,($1 = "use"),true,$2,$4,$7,m) } + SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4,$7,m) } | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP typedSeqExprBlock %prec expr_let { $5 (if $1 = "use" then "use!" else "let!") (rhs parseState 1) // report unterminated error let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range) let m = unionRanges (rhs parseState 1) $7.Range - SynExpr.LetOrUseBang(spBind,($1 = "use"),true,$2,$4,$7,m) } + SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4,$7,m) } | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP error %prec expr_let { // error recovery that allows intellisense when writing incomplete computation expressions let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range) let mAll = unionRanges (rhs parseState 1) (rhs parseState 7) let m = $4.Range.EndRange // zero-width range - SynExpr.LetOrUseBang(spBind,($1 = "use"),true,$2,$4, SynExpr.ImplicitZero m, mAll) } + SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4, SynExpr.ImplicitZero m, mAll) } | DO_BANG typedSeqExpr IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let { let spBind = NoSequencePointAtDoBinding - SynExpr.LetOrUseBang(spBind,false,true,SynPat.Const(SynConst.Unit,$2.Range),$2,$5, unionRanges (rhs parseState 1) $5.Range) } + SynExpr.LetOrUseBang (spBind,false,true,SynPat.Const(SynConst.Unit,$2.Range),$2,$5, unionRanges (rhs parseState 1) $5.Range) } | ODO_BANG typedSeqExprBlock hardwhiteDefnBindingsTerminator %prec expr_let - { SynExpr.DoBang($2, unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.DoBang ($2, unionRanges (rhs parseState 1) $2.Range) } | FOR forLoopBinder opt_OBLOCKSEP arrowThenExprR %prec expr_let { let spBind = SequencePointAtForLoop(rhs2 parseState 1 2) - let (a,b,_) = $2 in SynExpr.ForEach(spBind,SeqExprOnly true,true,a,b,$4,unionRanges (rhs parseState 1) $4.Range) } + let (a,b,_) = $2 in SynExpr.ForEach (spBind,SeqExprOnly true,true,a,b,$4,unionRanges (rhs parseState 1) $4.Range) } | FIXED declExpr - { SynExpr.Fixed($2, (unionRanges (rhs parseState 1) $2.Range)) } + { SynExpr.Fixed ($2, (unionRanges (rhs parseState 1) $2.Range)) } | RARROW typedSeqExprBlockR { errorR(Error(FSComp.SR.parsArrowUseIsLimited(),lhs parseState)) - SynExpr.YieldOrReturn((true,true),$2, (unionRanges (rhs parseState 1) $2.Range)) } + SynExpr.YieldOrReturn ((true,true),$2, (unionRanges (rhs parseState 1) $2.Range)) } /* END MONADIC SYNTAX ONLY */ - | declExpr COLON_QMARK typ { SynExpr.TypeTest($1,$3, unionRanges $1.Range $3.Range) } - | declExpr COLON_GREATER typ { SynExpr.Upcast($1,$3, unionRanges $1.Range $3.Range) } - | declExpr COLON_QMARK_GREATER typ { SynExpr.Downcast($1,$3, unionRanges $1.Range $3.Range) } + | declExpr COLON_QMARK typ { SynExpr.TypeTest ($1,$3, unionRanges $1.Range $3.Range) } + | declExpr COLON_GREATER typ { SynExpr.Upcast ($1,$3, unionRanges $1.Range $3.Range) } + | declExpr COLON_QMARK_GREATER typ { SynExpr.Downcast ($1,$3, unionRanges $1.Range $3.Range) } /* NOTE: any change to the "INFIX" tokens (or their definitions) should be reflected in PrettyNaming.IsInfixOperator */ | declExpr COLON_EQUALS declExpr { mkSynInfix (rhs parseState 2) $1 ":=" $3 } | minusExpr LARROW declExprBlock { mkSynAssign $1 $3 } /* | minusExpr LARROW recover { mkSynAssign $1 (arbExpr("assignRhs",rhs parseState 2)) } */ - | tupleExpr %prec expr_tuple { let exprs,commas = $1 in SynExpr.Tuple(false, List.rev exprs, List.rev commas, (commas.Head, exprs) ||> unionRangeWithListBy (fun e -> e.Range) ) } - | declExpr JOIN_IN declExpr { SynExpr.JoinIn($1,rhs parseState 2,$3,unionRanges $1.Range $3.Range) } + | tupleExpr %prec expr_tuple { let exprs,commas = $1 in SynExpr.Tuple (false, List.rev exprs, List.rev commas, (commas.Head, exprs) ||> unionRangeWithListBy (fun e -> e.Range) ) } + | declExpr JOIN_IN declExpr { SynExpr.JoinIn ($1,rhs parseState 2,$3,unionRanges $1.Range $3.Range) } | declExpr BAR_BAR declExpr { mkSynInfix (rhs parseState 2) $1 "||" $3 } | declExpr INFIX_BAR_OP declExpr { mkSynInfix (rhs parseState 2) $1 $2 $3 } | declExpr OR declExpr { mkSynInfix (rhs parseState 2) $1 "or" $3 } @@ -3481,7 +3481,7 @@ patternClauses: { let pat,guard,patm = $1 let mLast = rhs parseState 2 // silent recovery - [Clause(pat,guard,SynExpr.Const(SynConst.Unit,mLast.EndRange),patm,SequencePointAtTarget)], mLast } + [Clause(pat,guard,SynExpr.Const (SynConst.Unit,mLast.EndRange),patm,SequencePointAtTarget)], mLast } patternGuard: | WHEN declExpr @@ -3501,7 +3501,7 @@ ifExprCases: let lastBranch : SynExpr = match $2 with None -> exprThen | Some e -> e let mIfToEndOfLastBranch = unionRanges mIf lastBranch.Range let spIfToThen = SequencePointAtBinding(mIfToThen) - SynExpr.IfThenElse(exprGuard,exprThen,$2,spIfToThen,false,mIfToThen,mIfToEndOfLastBranch)) } + SynExpr.IfThenElse (exprGuard,exprThen,$2,spIfToThen,false,mIfToThen,mIfToEndOfLastBranch)) } ifExprThen: | THEN declExpr %prec prec_then_if @@ -3568,25 +3568,25 @@ minusExpr: mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"^($1)) $2 } | AMP minusExpr - { SynExpr.AddressOf(true,$2,rhs parseState 1,unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.AddressOf (true,$2,rhs parseState 1,unionRanges (rhs parseState 1) $2.Range) } | AMP_AMP minusExpr - { SynExpr.AddressOf(false,$2,rhs parseState 1, unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.AddressOf (false,$2,rhs parseState 1, unionRanges (rhs parseState 1) $2.Range) } | NEW atomTypeNonAtomicDeprecated opt_HIGH_PRECEDENCE_APP atomicExprAfterType - { SynExpr.New(false,$2,$4,unionRanges (rhs parseState 1) $4.Range) } + { SynExpr.New (false,$2,$4,unionRanges (rhs parseState 1) $4.Range) } | NEW atomTypeNonAtomicDeprecated opt_HIGH_PRECEDENCE_APP error - { SynExpr.New(false,$2,arbExpr("minusExpr",(rhs parseState 4)),unionRanges (rhs parseState 1) ($2).Range) } + { SynExpr.New (false,$2,arbExpr("minusExpr",(rhs parseState 4)),unionRanges (rhs parseState 1) ($2).Range) } | NEW error { arbExpr("minusExpr2",(rhs parseState 1)) } | UPCAST minusExpr - { SynExpr.InferredUpcast($2,unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.InferredUpcast ($2,unionRanges (rhs parseState 1) $2.Range) } | DOWNCAST minusExpr - { SynExpr.InferredDowncast($2,unionRanges (rhs parseState 1) $2.Range)} + { SynExpr.InferredDowncast ($2,unionRanges (rhs parseState 1) $2.Range)} | appExpr { $1 } @@ -3626,7 +3626,7 @@ atomicExpr: { let arg1,_ = $1 let mLessThan,mGreaterThan,_,args,commas,mTypeArgs = $3 let mWholeExpr = unionRanges arg1.Range mTypeArgs - SynExpr.TypeApp(arg1, mLessThan, args, commas, mGreaterThan, mTypeArgs, mWholeExpr), false } + SynExpr.TypeApp (arg1, mLessThan, args, commas, mGreaterThan, mTypeArgs, mWholeExpr), false } | PREFIX_OP atomicExpr { let arg2,hpa2 = $2 @@ -3638,7 +3638,7 @@ atomicExpr: $3 arg1 (lhs parseState) (rhs parseState 2),hpa1 } | BASE DOT atomicExprQualification - { let arg1 = SynExpr.Ident(ident("base",rhs parseState 1)) + { let arg1 = SynExpr.Ident (ident("base",rhs parseState 1)) $3 arg1 (lhs parseState) (rhs parseState 2),false } | QMARK nameop @@ -3663,19 +3663,19 @@ atomicExpr: | LBRACK error RBRACK { // silent recovery - SynExpr.ArrayOrList(false,[ ], lhs parseState),false } + SynExpr.ArrayOrList (false,[ ], lhs parseState),false } | LBRACK recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()) // silent recovery - exprFromParseError (SynExpr.ArrayOrList(false,[ ], rhs parseState 1)),false } + exprFromParseError (SynExpr.ArrayOrList (false,[ ], rhs parseState 1)),false } | STRUCT LPAREN tupleExpr rparen - { let exprs,commas = $3 in SynExpr.Tuple(true, List.rev exprs, List.rev commas, (commas.Head, exprs) ||> unionRangeWithListBy (fun e -> e.Range) ), false } + { let exprs,commas = $3 in SynExpr.Tuple (true, List.rev exprs, List.rev commas, (commas.Head, exprs) ||> unionRangeWithListBy (fun e -> e.Range) ), false } | STRUCT LPAREN tupleExpr recover { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnmatchedBracket()); - let exprs,commas = $3 in SynExpr.Tuple(true, List.rev exprs, List.rev commas, (commas.Head, exprs) ||> unionRangeWithListBy (fun e -> e.Range) ), false } + let exprs,commas = $3 in SynExpr.Tuple (true, List.rev exprs, List.rev commas, (commas.Head, exprs) ||> unionRangeWithListBy (fun e -> e.Range) ), false } | atomicExprAfterType { $1,false } @@ -3701,7 +3701,7 @@ atomicExprQualification: reportParseErrorAt dotm (FSComp.SR.parsMissingQualificationAfterDot()) let fixedLhsm = mkRange lhsm.FileName lhsm.Start dotm.End // previous lhsm is wrong after 'recover' // Include 'e' in the returned expression but throw it away - SynExpr.DiscardAfterMissingQualificationAfterDot(e,fixedLhsm)) } + SynExpr.DiscardAfterMissingQualificationAfterDot (e,fixedLhsm)) } | LPAREN COLON_COLON rparen DOT INT32 { (fun e lhsm dotm -> libraryOnlyError(lhs parseState) @@ -3766,11 +3766,11 @@ atomicExprAfterType: | braceBarExpr { $1 } | NULL - { SynExpr.Null(lhs parseState) } + { SynExpr.Null (lhs parseState) } | FALSE - { SynExpr.Const(SynConst.Bool false,lhs parseState) } + { SynExpr.Const (SynConst.Bool false,lhs parseState) } | TRUE - { SynExpr.Const(SynConst.Bool true,lhs parseState) } + { SynExpr.Const (SynConst.Bool true,lhs parseState) } | quoteExpr { $1 } | arrayExpr @@ -3780,7 +3780,7 @@ atomicExprAfterType: beginEndExpr: | BEGIN typedSeqExpr END - { SynExpr.Paren($2, rhs parseState 1, Some(rhs parseState 3), rhs2 parseState 1 3) } + { SynExpr.Paren ($2, rhs parseState 1, Some(rhs parseState 3), rhs2 parseState 1 3) } | BEGIN typedSeqExpr recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBegin()); exprFromParseError $2 } @@ -3794,19 +3794,19 @@ beginEndExpr: quoteExpr: | LQUOTE typedSeqExpr RQUOTE { if $1 <> $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsMismatchedQuote(fst $1)) - (SynExpr.Quote(mkSynIdGet (lhs parseState) (CompileOpName (fst $1)), snd $1, $2, false, lhs parseState)) } + (SynExpr.Quote (mkSynIdGet (lhs parseState) (CompileOpName (fst $1)), snd $1, $2, false, lhs parseState)) } | LQUOTE typedSeqExpr recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatched(fst $1)) let mExpr = rhs2 parseState 1 2 - exprFromParseError (SynExpr.Quote(mkSynIdGet (lhs parseState) (CompileOpName (fst $1)),snd $1, $2, false, mExpr)) } + exprFromParseError (SynExpr.Quote (mkSynIdGet (lhs parseState) (CompileOpName (fst $1)),snd $1, $2, false, mExpr)) } | LQUOTE error RQUOTE - { (* silent recovery *) SynExpr.Quote(mkSynIdGet (lhs parseState) (CompileOpName (fst $1)),snd $1, arbExpr("quoteExpr",(rhs parseState 2)), false, lhs parseState) } + { (* silent recovery *) SynExpr.Quote (mkSynIdGet (lhs parseState) (CompileOpName (fst $1)),snd $1, arbExpr("quoteExpr",(rhs parseState 2)), false, lhs parseState) } | LQUOTE recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatched(fst $1)) - exprFromParseError (SynExpr.Quote(mkSynIdGet (lhs parseState) (CompileOpName (fst $1)),snd $1, arbExpr("quoteExpr2",(rhs parseState 1).EndRange), false, rhs parseState 1)) } + exprFromParseError (SynExpr.Quote (mkSynIdGet (lhs parseState) (CompileOpName (fst $1)),snd $1, arbExpr("quoteExpr2",(rhs parseState 1).EndRange), false, rhs parseState 1)) } arrayExpr: | LBRACK_BAR listExprElements BAR_RBRACK @@ -3817,29 +3817,29 @@ arrayExpr: exprFromParseError ($2 (rhs2 parseState 1 2) true) } | LBRACK_BAR error BAR_RBRACK - { (* silent recovery *) SynExpr.ArrayOrList(true,[ ], lhs parseState) } + { (* silent recovery *) SynExpr.ArrayOrList (true,[ ], lhs parseState) } | LBRACK_BAR recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracketBar()) (* silent recovery *) - exprFromParseError (SynExpr.ArrayOrList(true,[ ], rhs parseState 1)) } + exprFromParseError (SynExpr.ArrayOrList (true,[ ], rhs parseState 1)) } parenExpr: | LPAREN rparen - { SynExpr.Const(SynConst.Unit,(rhs2 parseState 1 2)) } + { SynExpr.Const (SynConst.Unit,(rhs2 parseState 1 2)) } | LPAREN parenExprBody rparen { let m = rhs2 parseState 1 3 - SynExpr.Paren($2 m, rhs parseState 1, Some(rhs parseState 3), m) } + SynExpr.Paren ($2 m, rhs parseState 1, Some(rhs parseState 3), m) } | LPAREN parenExprBody ends_other_than_rparen_coming_soon_or_recover { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()) let lhsm = unionRangeWithPos (rhs parseState 1) (rhs parseState 3).Start - SynExpr.Paren(exprFromParseError ($2 lhsm), rhs parseState 1, None, lhsm) } + SynExpr.Paren (exprFromParseError ($2 lhsm), rhs parseState 1, None, lhsm) } | LPAREN error rparen { // silent recovery - SynExpr.Paren(arbExpr("parenExpr1",(rhs parseState 1).EndRange),(rhs parseState 1),Some(rhs parseState 3),(rhs2 parseState 1 3)) } + SynExpr.Paren (arbExpr("parenExpr1",(rhs parseState 1).EndRange),(rhs parseState 1),Some(rhs parseState 3),(rhs2 parseState 1 3)) } | LPAREN TYPE_COMING_SOON { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()) @@ -3874,7 +3874,7 @@ parenExpr: parenExprBody: | staticallyKnownHeadTypars COLON LPAREN classMemberSpfn rparen typedSeqExpr - { (fun m -> SynExpr.TraitCall($1,$4,$6,m)) } /* disambiguate: x $a.id(x) */ + { (fun m -> SynExpr.TraitCall ($1,$4,$6,m)) } /* disambiguate: x $a.id(x) */ | typedSeqExpr { (fun _m -> $1) } | inlineAssemblyExpr @@ -3911,15 +3911,15 @@ braceExpr: | LBRACE recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBrace()) // Note, we can't use 'exprFromParseError' because the extra syntax node interferes with some syntax-directed transformations for computation expressions - SynExpr.Record(None,None,[],rhs parseState 1) } + SynExpr.Record (None,None,[],rhs parseState 1) } | LBRACE rbrace { let m = rhs2 parseState 1 2 - SynExpr.Record(None,None,[],m) } + SynExpr.Record (None,None,[],m) } braceExprBody: | recdExpr - { (lhs parseState), (fun m -> let a,b,c = $1 in SynExpr.Record(a,b,c,m)) } + { (lhs parseState), (fun m -> let a,b,c = $1 in SynExpr.Record (a,b,c,m)) } | objExpr { $1 } @@ -3929,13 +3929,13 @@ braceExprBody: listExprElements: | monadicExprInitial - { let m,r = $1 in (fun lhsm isArray -> SynExpr.ArrayOrListOfSeqExpr(isArray, r true m, lhsm)) } + { let m,r = $1 in (fun lhsm isArray -> SynExpr.ArrayOrListOfSeqExpr (isArray, r true m, lhsm)) } | - { (fun lhsm isArray -> SynExpr.ArrayOrList(isArray,[ ], lhsm)) } + { (fun lhsm isArray -> SynExpr.ArrayOrList (isArray,[ ], lhsm)) } monadicExprInitial: | seqExpr - { $1.Range, (fun isArrayOrList lhsm -> SynExpr.CompExpr(isArrayOrList,ref(isArrayOrList),$1,lhsm)) } + { $1.Range, (fun isArrayOrList lhsm -> SynExpr.CompExpr (isArrayOrList,ref(isArrayOrList),$1,lhsm)) } | rangeSequenceExpr { $1 } @@ -3947,7 +3947,7 @@ rangeSequenceExpr: // in the case of "{ 1 .. 10 }", we want the range of the expression to include the curlies, that comes from a higher level rule in the grammar, // passed down as 'wholem', so patch up that range here match (mkSynInfix opm $1 ".." $3) with - | SynExpr.App(a,b,c,d,_) -> SynExpr.App(a,b,c,d,wholem) + | SynExpr.App (a,b,c,d,_) -> SynExpr.App (a,b,c,d,wholem) | _ -> failwith "impossible") } | declExpr DOT_DOT declExpr DOT_DOT declExpr { (unionRanges $1.Range $5.Range),(fun _isArray wholem -> mkSynTrifix wholem ".. .." $1 $3 $5) } @@ -3960,13 +3960,13 @@ rangeSequenceExpr: // in the case of "{ 1 .. 10 }", we want the range of the expression to include the curlies, that comes from a higher level rule in the grammar, // passed down as 'wholem', so patch up that range here match (mkSynInfix opm $1 ".." e) with - | SynExpr.App(a,b,c,d,_) -> SynExpr.App(a,b,c,d,wholem) + | SynExpr.App (a,b,c,d,_) -> SynExpr.App (a,b,c,d,wholem) | _ -> failwith "impossible") } arrowThenExprR: | RARROW typedSeqExprBlockR - { SynExpr.YieldOrReturn((true,false), $2, unionRanges (rhs parseState 1) $2.Range) } + { SynExpr.YieldOrReturn ((true,false), $2, unionRanges (rhs parseState 1) $2.Range) } forLoopBinder: @@ -4148,16 +4148,16 @@ objExpr: | objExprBaseCall objExprBindings opt_OBLOCKSEP opt_objExprInterfaces { let mNewExpr = rhs parseState 1 let fullRange = match $4 with [] -> (rhs parseState 1) | _ -> (rhs2 parseState 1 4) - fullRange, (fun m -> let (a,b) = $1 in SynExpr.ObjExpr(a,b,$2,$4, mNewExpr, m)) } + fullRange, (fun m -> let (a,b) = $1 in SynExpr.ObjExpr (a,b,$2,$4, mNewExpr, m)) } | objExprBaseCall opt_OBLOCKSEP objExprInterfaces { let mNewExpr = rhs parseState 1 let fullRange = match $3 with [] -> (rhs parseState 1) | _ -> (rhs2 parseState 1 3) - fullRange, (fun m -> let (a,b) = $1 in SynExpr.ObjExpr(a,b,[],$3, mNewExpr, m)) } + fullRange, (fun m -> let (a,b) = $1 in SynExpr.ObjExpr (a,b,[],$3, mNewExpr, m)) } | NEW atomTypeNonAtomicDeprecated { let mNewExpr = rhs parseState 1 - (rhs2 parseState 1 2), (fun m -> let (a,b) = $2,None in SynExpr.ObjExpr(a,b,[],[], mNewExpr, m)) } + (rhs2 parseState 1 2), (fun m -> let (a,b) = $2,None in SynExpr.ObjExpr (a,b,[],[], mNewExpr, m)) } objExprBaseCall: @@ -4226,7 +4226,7 @@ braceBarExprCore: | ((LongIdentWithDots([id],_),_),None,_) -> Some (id, arbExpr("anonField",id.idRange)) | _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None) let m = rhs2 parseState 1 3 - (fun isStruct -> SynExpr.AnonRecd(isStruct,orig,flds,m)) } + (fun isStruct -> SynExpr.AnonRecd (isStruct,orig,flds,m)) } | LBRACE_BAR recdExprCore recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBraceBar()) @@ -4237,7 +4237,7 @@ braceBarExprCore: | ((LongIdentWithDots([id],_),_),None,_) -> Some (id, arbExpr("anonField",id.idRange)) | _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None) let m = rhs2 parseState 1 2 - (fun isStruct -> SynExpr.AnonRecd(isStruct,orig,flds,m)) } + (fun isStruct -> SynExpr.AnonRecd (isStruct,orig,flds,m)) } | LBRACE_BAR error bar_rbrace { // silent recovery @@ -4247,11 +4247,11 @@ braceBarExprCore: | LBRACE_BAR recover { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBraceBar()) let m = rhs2 parseState 1 1 - (fun isStruct -> SynExpr.AnonRecd(isStruct,None,[],m)) } + (fun isStruct -> SynExpr.AnonRecd (isStruct,None,[],m)) } | LBRACE_BAR bar_rbrace { let m = rhs2 parseState 1 2 - (fun isStruct -> SynExpr.AnonRecd(isStruct,None,[],m)) } + (fun isStruct -> SynExpr.AnonRecd (isStruct,None,[],m)) } anonLambdaExpr: | FUN atomicPatterns RARROW typedSeqExprBlock @@ -4289,12 +4289,12 @@ anonMatchingExpr: | FUNCTION withPatternClauses %prec expr_function { let clauses,mLast = $2 let mAll = unionRanges (rhs parseState 1) mLast - SynExpr.MatchLambda(false,(rhs parseState 1),clauses,NoSequencePointAtInvisibleBinding,mAll) } + SynExpr.MatchLambda (false,(rhs parseState 1),clauses,NoSequencePointAtInvisibleBinding,mAll) } | OFUNCTION withPatternClauses OEND %prec expr_function { let clauses,mLast = $2 let mAll = unionRanges (rhs parseState 1) mLast - SynExpr.MatchLambda(false,(rhs parseState 1),clauses,NoSequencePointAtInvisibleBinding,mAll) } + SynExpr.MatchLambda (false,(rhs parseState 1),clauses,NoSequencePointAtInvisibleBinding,mAll) } /*--------------------------------------------------------------------------*/ /* TYPE ALGEBRA */ diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index c372fa2d8..a01e443c3 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -182,8 +182,8 @@ module internal IncrementalBuild = // Create the rules. let createRules() = - { RuleList = names |> List.map (function NamedVectorOutput(v) -> v.Name, VectorBuildRule(v.Expr) - | NamedScalarOutput(s) -> s.Name, ScalarBuildRule(s.Expr)) } + { RuleList = names |> List.map (function NamedVectorOutput v -> v.Name, VectorBuildRule(v.Expr) + | NamedScalarOutput s -> s.Name, ScalarBuildRule(s.Expr)) } // Ensure that all names are unique. let ensureUniqueNames (expr: BuildRuleExpr) (acc: Map) = @@ -230,17 +230,17 @@ module internal IncrementalBuild = | Available of obj * DateTime * InputSignature /// Get the available result. Throw an exception if not available. - member x.GetAvailable() = match x with Available(o, _, _) ->o | _ -> failwith "No available result" + member x.GetAvailable() = match x with Available (o, _, _) ->o | _ -> failwith "No available result" /// Get the time stamp if available. Otherwise MaxValue. - member x.Timestamp = match x with Available(_, ts, _) -> ts | InProgress(_, ts) -> ts | _ -> DateTime.MaxValue + member x.Timestamp = match x with Available (_, ts, _) -> ts | InProgress(_, ts) -> ts | _ -> DateTime.MaxValue /// Get the time stamp if available. Otherwise MaxValue. - member x.InputSignature = match x with Available(_, _, signature) -> signature | _ -> UnevaluatedInput + member x.InputSignature = match x with Available (_, _, signature) -> signature | _ -> UnevaluatedInput member x.ResultIsInProgress = match x with | InProgress _ -> true | _ -> false member x.GetInProgressContinuation ctok = match x with | InProgress (f, _) -> f ctok | _ -> failwith "not in progress" - member x.TryGetAvailable() = match x with | InProgress _ | NotAvailable -> None | Available(obj, dt, i) -> Some (obj, dt, i) + member x.TryGetAvailable() = match x with | InProgress _ | NotAvailable -> None | Available (obj, dt, i) -> Some (obj, dt, i) /// An immutable sparse vector of results. type ResultVector(size, zeroElementTimestamp, map) = @@ -250,10 +250,10 @@ module internal IncrementalBuild = | None->NotAvailable let asList = lazy List.map (fun i->i, get i) [0..size-1] - static member OfSize(size) = ResultVector(size, DateTime.MinValue, Map.empty) + static member OfSize size = ResultVector(size, DateTime.MinValue, Map.empty) member rv.Size = size member rv.Get slot = get slot - member rv.Resize(newsize) = + member rv.Resize newsize = if size<>newsize then ResultVector(newsize, zeroElementTimestamp, map |> Map.filter(fun s _ -> s < newsize)) else rv @@ -299,7 +299,7 @@ module internal IncrementalBuild = | VectorAction of Id * (*taskname*)string * DateTime * InputSignature * (CompilationThreadToken -> Cancellable) | ResizeResultAction of Id * (*slotcount*) int /// Execute one action and return a corresponding result. - member action.Execute(ctok) = + member action.Execute ctok = cancellable { match action with | IndexedAction(id, _taskname, slot, slotcount, timestamp, func) -> let res = func ctok in return IndexedResult(id, slot, slotcount, res, timestamp) @@ -352,7 +352,7 @@ module internal IncrementalBuild = | VectorInput(id, _) ->if seek=id then Some (VectorBuildRule ve) else None | VectorScanLeft(id, _, a, i, _) -> if seek=id then Some (VectorBuildRule ve) else - let result = scalarExprOfId(a) + let result = scalarExprOfId a match result with Some _ -> result | None->vectorExprOfId i | VectorMap(id, _, i, _) ->if seek=id then Some (VectorBuildRule ve) else vectorExprOfId i | VectorStamp (id, _, i, _) ->if seek=id then Some (VectorBuildRule ve) else vectorExprOfId i @@ -369,7 +369,7 @@ module internal IncrementalBuild = | ScalarBuildRule se ->scalarExprOfId se | VectorBuildRule ve ->vectorExprOfId ve - let exprs = bt.Rules.RuleList |> List.map (fun(_, root) ->exprOfId(root)) |> List.filter Option.isSome + let exprs = bt.Rules.RuleList |> List.map (fun(_, root) ->exprOfId root) |> List.filter Option.isSome match exprs with | Some expr :: _ -> expr | _ -> failwith (sprintf "GetExprById did not find an expression for Id") @@ -418,7 +418,7 @@ module internal IncrementalBuild = match bt.Results.TryFind id with | Some resultset -> match resultset with - | ScalarResult(rs) -> rs.Timestamp + | ScalarResult rs -> rs.Timestamp | VectorResult rv -> rv.MaxTimestamp() | None -> DateTime.MaxValue @@ -426,7 +426,7 @@ module internal IncrementalBuild = match bt.Results.TryFind id with | Some resultset -> match resultset with - | ScalarResult(rs) -> rs.InputSignature + | ScalarResult rs -> rs.InputSignature | VectorResult rv -> rv.Signature() | None -> UnevaluatedInput @@ -459,7 +459,7 @@ module internal IncrementalBuild = let AvailableAllResultsOfExpr bt expr = let msg = "Expected all results to be available" - AllResultsOfExpr (function Available(o, _, _) -> o | _ -> failwith msg) bt expr + AllResultsOfExpr (function Available (o, _, _) -> o | _ -> failwith msg) bt expr /// Bind a set of build rules to a set of input values. let ToBound(buildRules: BuildRules, inputs: BuildInput list) = @@ -472,7 +472,7 @@ module internal IncrementalBuild = match input with | BuildInput.Scalar (node, value) -> if node.Name = n then - yield ScalarResult(Available(value, now, BoundInputScalar)) + yield ScalarResult(Available (value, now, BoundInputScalar)) | _ -> () ] List.foldBack (Map.add id) matches results | ScalarMap(_, _, se, _) ->applyScalarExpr(se, results) @@ -486,7 +486,7 @@ module internal IncrementalBuild = | BuildInput.Scalar _ -> () | BuildInput.Vector (node, values) -> if node.Name = n then - let results = values|>List.mapi(fun i value->i, Available(value, now, BoundInputVector)) + let results = values|>List.mapi(fun i value->i, Available (value, now, BoundInputVector)) yield VectorResult(ResultVector(values.Length, DateTime.MinValue, results|>Map.ofList)) ] List.foldBack (Map.add id) matches results | VectorScanLeft(_, _, a, i, _) ->ApplyVectorExpr(i, applyScalarExpr(a, results)) @@ -555,7 +555,7 @@ module internal IncrementalBuild = let inputResult = GetVectorExprResult (bt, inputExpr, slot) match accumulatorResult, inputResult with - | Available(accumulator, accumulatortimesamp, _accumulatorInputSig), Available(input, inputtimestamp, _inputSig) -> + | Available (accumulator, accumulatortimesamp, _accumulatorInputSig), Available (input, inputtimestamp, _inputSig) -> let inputtimestamp = max inputtimestamp accumulatortimesamp let prevoutput = GetVectorExprResult (bt, ve, slot) let outputtimestamp = prevoutput.Timestamp @@ -572,7 +572,7 @@ module internal IncrementalBuild = | None -> None | _ -> None - match ([0..limit-1]|>List.tryPick Scan) with Some (acc) ->acc | None->acc + match ([0..limit-1]|>List.tryPick Scan) with Some acc ->acc | None->acc | None -> acc // Check each slot for an action that may be performed. @@ -624,7 +624,7 @@ module internal IncrementalBuild = let checkStamp acc slot = let inputresult = GetVectorExprResult (bt, inputExpr, slot) match inputresult with - | Available(ires, _, _) -> + | Available (ires, _, _) -> let oldtimestamp = GetVectorExprResult(bt, ve, slot).Timestamp let newtimestamp = func cache ctok ires if newtimestamp <> oldtimestamp then @@ -642,7 +642,7 @@ module internal IncrementalBuild = | VectorMultiplex(id, taskname, inputExpr, func) -> let acc = match GetScalarExprResult (bt, inputExpr) with - | Available(inp, inputtimestamp, inputsig) -> + | Available (inp, inputtimestamp, inputsig) -> let outputtimestamp = MaxTimestamp(bt, id) if inputtimestamp <> outputtimestamp then let MultiplexOp ctok = func ctok inp |> cancellable.Return @@ -677,7 +677,7 @@ module internal IncrementalBuild = | ScalarMap (id, taskname, inputExpr, func) -> let acc = match GetScalarExprResult (bt, inputExpr) with - | Available(inp, inputtimestamp, inputsig) -> + | Available (inp, inputtimestamp, inputsig) -> let outputtimestamp = MaxTimestamp(bt, id) if inputtimestamp <> outputtimestamp then let MapOp ctok = func ctok inp |> cancellable.Return @@ -708,7 +708,7 @@ module internal IncrementalBuild = | Some cardinality -> let CheckStamp acc slot = match GetVectorExprResult (bt, inputExpr, slot) with - | Available(ires, _, _) -> max acc (func cache ctok ires) + | Available (ires, _, _) -> max acc (func cache ctok ires) | _ -> acc [0..cardinality-1] |> List.fold CheckStamp acc | None -> acc @@ -723,16 +723,16 @@ module internal IncrementalBuild = | Some resultSet -> match resultSet with | VectorResult rv -> - let rv = rv.Resize(slotcount) + let rv = rv.Resize slotcount let results = Map.add id (VectorResult rv) bt.Results PartialBuild(bt.Rules, results) | _ -> failwith "Unexpected" | None -> failwith "Unexpected" | ScalarValuedResult(id, value, timestamp, inputsig) -> - PartialBuild(bt.Rules, Map.add id (ScalarResult(Available(value, timestamp, inputsig))) bt.Results) + PartialBuild(bt.Rules, Map.add id (ScalarResult(Available (value, timestamp, inputsig))) bt.Results) | VectorValuedResult(id, values, timestamp, inputsig) -> let Append acc slot = - Map.add slot (Available(values.[slot], timestamp, inputsig)) acc + Map.add slot (Available (values.[slot], timestamp, inputsig)) acc let results = [0..values.Length-1]|>List.fold Append Map.empty let results = VectorResult(ResultVector(values.Length, timestamp, results)) let bt = PartialBuild(bt.Rules, Map.add id results bt.Results) @@ -750,11 +750,11 @@ module internal IncrementalBuild = let result = match value with | Eventually.Done res -> - Available(res, timestamp, IndexedValueElement timestamp) + Available (res, timestamp, IndexedValueElement timestamp) | Eventually.NotYetDone f -> InProgress (f, timestamp) let results = rv.Resize(slotcount).Set(index, result) - PartialBuild(bt.Rules, Map.add id (VectorResult(results)) bt.Results) + PartialBuild(bt.Rules, Map.add id (VectorResult results) bt.Results) | _ -> failwith "Unexpected" let mutable injectCancellationFault = false @@ -765,7 +765,7 @@ module internal IncrementalBuild = /// Apply the result, and call the 'save' function to update the build. let ExecuteApply (ctok: CompilationThreadToken) save (action: Action) bt = cancellable { - let! actionResult = action.Execute(ctok) + let! actionResult = action.Execute ctok let newBt = ApplyResult(actionResult, bt) save ctok newBt return newBt @@ -836,7 +836,7 @@ module internal IncrementalBuild = match bt.Results.TryFind se.Id with | Some result -> match result with - | ScalarResult(sr) -> + | ScalarResult sr -> match sr.TryGetAvailable() with | Some (r, timestamp, _) -> Some (downcast r, timestamp) | None -> None @@ -870,7 +870,7 @@ module internal IncrementalBuild = | VectorResult rv -> let MatchNames acc (slot, result) = match result with - | Available(o, _, _) -> + | Available (o, _, _) -> let o = o :?> 'T if found o then Some slot else acc | _ -> acc @@ -959,11 +959,11 @@ module internal IncrementalBuild = /// Declare a named scalar output. member b.DeclareScalarOutput(output: Scalar<'T>)= - outputs <- NamedScalarOutput(output) :: outputs + outputs <- NamedScalarOutput output :: outputs /// Declare a named vector output. member b.DeclareVectorOutput(output: Vector<'T>)= - outputs <- NamedVectorOutput(output) :: outputs + outputs <- NamedVectorOutput output :: outputs /// Set the concrete inputs for this build member b.GetInitialPartialBuild(inputs: BuildInput list) = @@ -1011,7 +1011,7 @@ module IncrementalBuilderEventTesting = // ++GLOBAL MUTABLE STATE FOR TESTING++ let MRU = new FixedLengthMRU() - let GetMostRecentIncrementalBuildEvents(n) = MRU.MostRecentList(n) + let GetMostRecentIncrementalBuildEvents n = MRU.MostRecentList n let GetCurrentIncrementalBuildEventNum() = MRU.CurrentEventNum module Tc = FSharp.Compiler.TypeChecker @@ -1061,10 +1061,10 @@ type FrameworkImportsCache(keepStrongly) = let frameworkTcImportsCache = AgedLookup(keepStrongly, areSimilar=(fun (x, y) -> x = y)) /// Reduce the size of the cache in low-memory scenarios - member __.Downsize(ctok) = frameworkTcImportsCache.Resize(ctok, keepStrongly=0) + member __.Downsize ctok = frameworkTcImportsCache.Resize(ctok, keepStrongly=0) /// Clear the cache - member __.Clear(ctok) = frameworkTcImportsCache.Clear(ctok) + member __.Clear ctok = frameworkTcImportsCache.Clear ctok /// This function strips the "System" assemblies from the tcConfig and returns a age-cached TcImports for them. member __.Get(ctok, tcConfig: TcConfig) = @@ -1091,7 +1091,7 @@ type FrameworkImportsCache(keepStrongly) = match frameworkTcImportsCache.TryGet (ctok, key) with | Some res -> return res | None -> - let tcConfigP = TcConfigProvider.Constant(tcConfig) + let tcConfigP = TcConfigProvider.Constant tcConfig let! ((tcGlobals, tcImports) as res) = TcImports.BuildFrameworkTcImports (ctok, tcConfigP, frameworkDLLs, nonFrameworkResolutions) frameworkTcImportsCache.Put(ctok, key, res) return tcGlobals, tcImports @@ -1167,7 +1167,7 @@ type PartialCheckResults = module Utilities = let TryFindFSharpStringAttribute tcGlobals attribSpec attribs = match TryFindFSharpAttribute tcGlobals attribSpec attribs with - | Some (Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> Some s + | Some (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s | _ -> None /// The implementation of the information needed by TcImports in CompileOps.fs for an F# assembly reference. @@ -1210,7 +1210,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput sourceFiles, loadClosureOpt: LoadClosure option, keepAssemblyContents, keepAllBackgroundResolutions, maxTimeShareMilliseconds) = - let tcConfigP = TcConfigProvider.Constant(tcConfig) + let tcConfigP = TcConfigProvider.Constant tcConfig let importsInvalidated = new Event() let fileParsed = new Event() let beforeFileChecked = new Event() @@ -1230,8 +1230,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let basicDependencies = [ for (UnresolvedAssemblyReference(referenceText, _)) in unresolvedReferences do // Exclude things that are definitely not a file name - if not(FileSystem.IsInvalidPathShim(referenceText)) then - let file = if FileSystem.IsPathRootedShim(referenceText) then referenceText else Path.Combine(projectDirectory, referenceText) + if not(FileSystem.IsInvalidPathShim referenceText) then + let file = if FileSystem.IsPathRootedShim referenceText then referenceText else Path.Combine(projectDirectory, referenceText) yield file for r in nonFrameworkResolutions do @@ -1287,7 +1287,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput try IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed filename) let input = ParseOneInputFile(tcConfig, lexResourceManager, [], filename, isLastCompiland, errorLogger, (*retryLocked*)true) - fileParsed.Trigger (filename) + fileParsed.Trigger filename input, sourceRange, filename, errorLogger.GetErrors () with exn -> @@ -1338,7 +1338,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput return tcImports with e -> System.Diagnostics.Debug.Assert(false, sprintf "Could not BuildAllReferencedDllTcImports %A" e) - errorLogger.Warning(e) + errorLogger.Warning e return frameworkTcImports } @@ -1379,10 +1379,10 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput | Some input, _sourceRange, filename, parseErrors-> IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked filename) let capturingErrorLogger = CompilationErrorLogger("TypeCheckTask", tcConfig.errorSeverityOptions) - let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) + let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, capturingErrorLogger) let fullComputation = eventually { - beforeFileChecked.Trigger (filename) + beforeFileChecked.Trigger filename ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName filename) |> ignore let sink = TcResultsSinkImpl(tcAcc.tcGlobals) @@ -1407,7 +1407,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput RequireCompilationThread ctok // Note: events get raised on the CompilationThread - fileChecked.Trigger (filename) + fileChecked.Trigger filename let newErrors = Array.append parseErrors (capturingErrorLogger.GetErrors()) return {tcAcc with tcState=tcState tcEnvAtEndOfFile=tcEnvAtEndOfFile @@ -1558,7 +1558,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput BuildInput.VectorInput (referencedAssembliesNode, nonFrameworkAssemblyInputs) ] // This is the initial representation of progress through the build, i.e. we have made no progress. - let mutable partialBuild = buildDescription.GetInitialPartialBuild (buildInputs) + let mutable partialBuild = buildDescription.GetInitialPartialBuild buildInputs let SavePartialBuild (ctok: CompilationThreadToken) b = RequireCompilationThread ctok // modifying state @@ -1608,7 +1608,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput member __.Step (ctok: CompilationThreadToken) = cancellable { - let cache = TimeStampCache(defaultTimeStamp) // One per step + let cache = TimeStampCache defaultTimeStamp // One per step let! res = IncrementalBuild.Step cache ctok SavePartialBuild (Target(tcStatesNode, None)) partialBuild match res with | None -> @@ -1618,7 +1618,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput return true } - member builder.GetCheckResultsBeforeFileInProjectEvenIfStale (filename): PartialCheckResults option = + member builder.GetCheckResultsBeforeFileInProjectEvenIfStale filename: PartialCheckResults option = let slotOfFile = builder.GetSlotOfFileName filename let result = match slotOfFile with @@ -1630,16 +1630,16 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput | _ -> None - member builder.AreCheckResultsBeforeFileInProjectReady (filename) = + member builder.AreCheckResultsBeforeFileInProjectReady filename = let slotOfFile = builder.GetSlotOfFileName filename - let cache = TimeStampCache(defaultTimeStamp) + let cache = TimeStampCache defaultTimeStamp match slotOfFile with | (*first file*) 0 -> IncrementalBuild.IsReady cache (Target(initialTcAccNode, None)) partialBuild | _ -> IncrementalBuild.IsReady cache (Target(tcStatesNode, Some (slotOfFile-1))) partialBuild member __.GetCheckResultsBeforeSlotInProject (ctok: CompilationThreadToken, slotOfFile) = cancellable { - let cache = TimeStampCache(defaultTimeStamp) + let cache = TimeStampCache defaultTimeStamp let! result = cancellable { match slotOfFile with @@ -1669,7 +1669,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput member __.GetCheckResultsAndImplementationsForProject(ctok: CompilationThreadToken) = cancellable { - let cache = TimeStampCache(defaultTimeStamp) + let cache = TimeStampCache defaultTimeStamp let! build = IncrementalBuild.Eval cache ctok SavePartialBuild finalizedTypeCheckNode partialBuild match GetScalarResult(finalizedTypeCheckNode, build) with | Some ((ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, tcAcc), timestamp) -> @@ -1681,7 +1681,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput ((build.Results :> IDictionary<_, _>).Keys |> Seq.toArray), brname, build.Results.ContainsKey brname, - build.Results.TryFind brname |> Option.map (function ScalarResult(sr) -> Some(sr.TryGetAvailable().IsSome) | _ -> None)) + build.Results.TryFind brname |> Option.map (function ScalarResult sr -> Some(sr.TryGetAvailable().IsSome) | _ -> None)) let msg = sprintf "Build was not evaluated, expected the results to be ready after 'Eval' (GetCheckResultsAndImplementationsForProject, data = %A)." data return! failwith msg } @@ -1696,7 +1696,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let CompareFileNames (_, f2, _) = let result = String.Compare(filename, f2, StringComparison.CurrentCultureIgnoreCase)=0 - || String.Compare(FileSystem.GetFullPathShim(filename), FileSystem.GetFullPathShim(f2), StringComparison.CurrentCultureIgnoreCase)=0 + || String.Compare(FileSystem.GetFullPathShim filename, FileSystem.GetFullPathShim f2, StringComparison.CurrentCultureIgnoreCase)=0 result match TryGetSlotByInput(fileNamesNode, partialBuild, CompareFileNames) with | Some slot -> slot @@ -1716,7 +1716,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput match GetVectorResultBySlot(stampedFileNamesNode, slotOfFile, partialBuild) with | Some (results, _) -> return results | None -> - let cache = TimeStampCache(defaultTimeStamp) + let cache = TimeStampCache defaultTimeStamp let! build = IncrementalBuild.EvalUpTo cache ctok SavePartialBuild (stampedFileNamesNode, slotOfFile) partialBuild match GetVectorResultBySlot(stampedFileNamesNode, slotOfFile, build) with | Some (results, _) -> return results @@ -1762,7 +1762,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let tcConfigB, sourceFilesNew = let getSwitchValue switchstring = - match commandLineArgs |> Seq.tryFindIndex(fun s -> s.StartsWithOrdinal(switchstring)) with + match commandLineArgs |> Seq.tryFindIndex(fun s -> s.StartsWithOrdinal switchstring) with | Some idx -> Some(commandLineArgs.[idx].Substring(switchstring.Length)) | _ -> None @@ -1864,7 +1864,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput | Some builder -> let errorSeverityOptions = builder.TcConfig.errorSeverityOptions let errorLogger = CompilationErrorLogger("IncrementalBuilderCreation", errorSeverityOptions) - delayedLogger.CommitDelayedDiagnostics(errorLogger) + delayedLogger.CommitDelayedDiagnostics errorLogger errorLogger.GetErrors() |> Array.map (fun (d, severity) -> d, severity = FSharpErrorSeverity.Error) | _ -> Array.ofList delayedLogger.Diagnostics diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index 9c131e4bd..69e7a7ff1 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -496,9 +496,9 @@ module ParsedInput = /// An recursive pattern that collect all sequential expressions to avoid StackOverflowException let rec (|Sequentials|_|) = function - | SynExpr.Sequential(_, _, e, Sequentials es, _) -> + | SynExpr.Sequential (_, _, e, Sequentials es, _) -> Some(e::es) - | SynExpr.Sequential(_, _, e1, e2, _) -> + | SynExpr.Sequential (_, _, e1, e2, _) -> Some [e1; e2] | _ -> None @@ -652,7 +652,7 @@ module ParsedInput = addLongIdentWithDots ident e |> Option.iter walkExpr) | SynExpr.Ident ident -> addIdent ident - | SynExpr.ObjExpr(ty, argOpt, bindings, ifaces, _, _) -> + | SynExpr.ObjExpr (ty, argOpt, bindings, ifaces, _, _) -> argOpt |> Option.iter (fun (e, ident) -> walkExpr e ident |> Option.iter addIdent) diff --git a/src/fsharp/service/ServiceInterfaceStubGenerator.fs b/src/fsharp/service/ServiceInterfaceStubGenerator.fs index e4a2bc7e0..ed2afc4d2 100644 --- a/src/fsharp/service/ServiceInterfaceStubGenerator.fs +++ b/src/fsharp/service/ServiceInterfaceStubGenerator.fs @@ -61,9 +61,9 @@ module internal CodeGenerationUtils = /// An recursive pattern that collect all sequential expressions to avoid StackOverflowException let rec (|Sequentials|_|) = function - | SynExpr.Sequential(_, _, e, Sequentials es, _) -> + | SynExpr.Sequential (_, _, e, Sequentials es, _) -> Some(e::es) - | SynExpr.Sequential(_, _, e1, e2, _) -> + | SynExpr.Sequential (_, _, e1, e2, _) -> Some [e1; e2] | _ -> None @@ -753,28 +753,28 @@ module internal InterfaceStubGenerator = None else match expr with - | SynExpr.Quote(synExpr1, _, synExpr2, _, _range) -> + | SynExpr.Quote (synExpr1, _, synExpr2, _, _range) -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.Const(_synConst, _range) -> + | SynExpr.Const (_synConst, _range) -> None - | SynExpr.Paren(synExpr, _, _, _parenRange) -> + | SynExpr.Paren (synExpr, _, _, _parenRange) -> walkExpr synExpr - | SynExpr.Typed(synExpr, _synType, _range) -> + | SynExpr.Typed (synExpr, _synType, _range) -> walkExpr synExpr - | SynExpr.Tuple(_, synExprList, _, _range) - | SynExpr.ArrayOrList(_, synExprList, _range) -> + | SynExpr.Tuple (_, synExprList, _, _range) + | SynExpr.ArrayOrList (_, synExprList, _range) -> List.tryPick walkExpr synExprList - | SynExpr.Record(_inheritOpt, _copyOpt, fields, _range) -> + | SynExpr.Record (_inheritOpt, _copyOpt, fields, _range) -> List.tryPick (fun (_, e, _) -> Option.bind walkExpr e) fields - | SynExpr.New(_, _synType, synExpr, _range) -> + | SynExpr.New (_, _synType, synExpr, _range) -> walkExpr synExpr - | SynExpr.ObjExpr(ty, baseCallOpt, binds, ifaces, _range1, _range2) -> + | SynExpr.ObjExpr (ty, baseCallOpt, binds, ifaces, _range1, _range2) -> match baseCallOpt with | None -> if rangeContainsPos ty.Range pos then @@ -788,116 +788,116 @@ module internal InterfaceStubGenerator = // Ignore object expressions of normal objects None - | SynExpr.While(_sequencePointInfoForWhileLoop, synExpr1, synExpr2, _range) -> + | SynExpr.While (_sequencePointInfoForWhileLoop, synExpr1, synExpr2, _range) -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.ForEach(_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, _synPat, synExpr1, synExpr2, _range) -> + | SynExpr.ForEach (_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, _synPat, synExpr1, synExpr2, _range) -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.For(_sequencePointInfoForForLoop, _ident, synExpr1, _, synExpr2, synExpr3, _range) -> + | SynExpr.For (_sequencePointInfoForForLoop, _ident, synExpr1, _, synExpr2, synExpr3, _range) -> List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] - | SynExpr.ArrayOrListOfSeqExpr(_, synExpr, _range) -> + | SynExpr.ArrayOrListOfSeqExpr (_, synExpr, _range) -> walkExpr synExpr - | SynExpr.CompExpr(_, _, synExpr, _range) -> + | SynExpr.CompExpr (_, _, synExpr, _range) -> walkExpr synExpr - | SynExpr.Lambda(_, _, _synSimplePats, synExpr, _range) -> + | SynExpr.Lambda (_, _, _synSimplePats, synExpr, _range) -> walkExpr synExpr - | SynExpr.MatchLambda(_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) -> + | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) -> synMatchClauseList |> List.tryPick (fun (Clause(_, _, e, _, _)) -> walkExpr e) - | SynExpr.Match(_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> + | SynExpr.Match (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> walkExpr synExpr |> Option.orElse (synMatchClauseList |> List.tryPick (fun (Clause(_, _, e, _, _)) -> walkExpr e)) - | SynExpr.Lazy(synExpr, _range) -> + | SynExpr.Lazy (synExpr, _range) -> walkExpr synExpr - | SynExpr.Do(synExpr, _range) -> + | SynExpr.Do (synExpr, _range) -> walkExpr synExpr - | SynExpr.Assert(synExpr, _range) -> + | SynExpr.Assert (synExpr, _range) -> walkExpr synExpr - | SynExpr.App(_exprAtomicFlag, _isInfix, synExpr1, synExpr2, _range) -> + | SynExpr.App (_exprAtomicFlag, _isInfix, synExpr1, synExpr2, _range) -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.TypeApp(synExpr, _, _synTypeList, _commas, _, _, _range) -> + | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> walkExpr synExpr - | SynExpr.LetOrUse(_, _, synBindingList, synExpr, _range) -> + | SynExpr.LetOrUse (_, _, synBindingList, synExpr, _range) -> Option.orElse (List.tryPick walkBinding synBindingList) (walkExpr synExpr) - | SynExpr.TryWith(synExpr, _range, _synMatchClauseList, _range2, _range3, _sequencePointInfoForTry, _sequencePointInfoForWith) -> + | SynExpr.TryWith (synExpr, _range, _synMatchClauseList, _range2, _range3, _sequencePointInfoForTry, _sequencePointInfoForWith) -> walkExpr synExpr - | SynExpr.TryFinally(synExpr1, synExpr2, _range, _sequencePointInfoForTry, _sequencePointInfoForFinally) -> + | SynExpr.TryFinally (synExpr1, synExpr2, _range, _sequencePointInfoForTry, _sequencePointInfoForFinally) -> List.tryPick walkExpr [synExpr1; synExpr2] | Sequentials exprs -> List.tryPick walkExpr exprs - | SynExpr.IfThenElse(synExpr1, synExpr2, synExprOpt, _sequencePointInfoForBinding, _isRecovery, _range, _range2) -> + | SynExpr.IfThenElse (synExpr1, synExpr2, synExprOpt, _sequencePointInfoForBinding, _isRecovery, _range, _range2) -> match synExprOpt with | Some synExpr3 -> List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] | None -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.Ident(_ident) -> + | SynExpr.Ident (_ident) -> None - | SynExpr.LongIdent(_, _longIdent, _altNameRefCell, _range) -> + | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None - | SynExpr.LongIdentSet(_longIdent, synExpr, _range) -> + | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> walkExpr synExpr - | SynExpr.DotGet(synExpr, _dotm, _longIdent, _range) -> + | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> walkExpr synExpr - | SynExpr.DotSet(synExpr1, _longIdent, synExpr2, _range) -> + | SynExpr.DotSet (synExpr1, _longIdent, synExpr2, _range) -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.Set(synExpr1, synExpr2, _range) -> + | SynExpr.Set (synExpr1, synExpr2, _range) -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.DotIndexedGet(synExpr, IndexerArgList synExprList, _range, _range2) -> + | SynExpr.DotIndexedGet (synExpr, IndexerArgList synExprList, _range, _range2) -> Option.orElse (walkExpr synExpr) (List.tryPick walkExpr synExprList) - | SynExpr.DotIndexedSet(synExpr1, IndexerArgList synExprList, synExpr2, _, _range, _range2) -> + | SynExpr.DotIndexedSet (synExpr1, IndexerArgList synExprList, synExpr2, _, _range, _range2) -> [ yield synExpr1 yield! synExprList yield synExpr2 ] |> List.tryPick walkExpr - | SynExpr.JoinIn(synExpr1, _range, synExpr2, _range2) -> + | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.NamedIndexedPropertySet(_longIdent, synExpr1, synExpr2, _range) -> + | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr1, synExpr2, _range) -> List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.DotNamedIndexedPropertySet(synExpr1, _longIdent, synExpr2, synExpr3, _range) -> + | SynExpr.DotNamedIndexedPropertySet (synExpr1, _longIdent, synExpr2, synExpr3, _range) -> List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] - | SynExpr.TypeTest(synExpr, _synType, _range) - | SynExpr.Upcast(synExpr, _synType, _range) - | SynExpr.Downcast(synExpr, _synType, _range) -> + | SynExpr.TypeTest (synExpr, _synType, _range) + | SynExpr.Upcast (synExpr, _synType, _range) + | SynExpr.Downcast (synExpr, _synType, _range) -> walkExpr synExpr - | SynExpr.InferredUpcast(synExpr, _range) - | SynExpr.InferredDowncast(synExpr, _range) -> + | SynExpr.InferredUpcast (synExpr, _range) + | SynExpr.InferredDowncast (synExpr, _range) -> walkExpr synExpr - | SynExpr.AddressOf(_, synExpr, _range, _range2) -> + | SynExpr.AddressOf (_, synExpr, _range, _range2) -> walkExpr synExpr - | SynExpr.TraitCall(_synTyparList, _synMemberSig, synExpr, _range) -> + | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> walkExpr synExpr - | SynExpr.Null(_range) - | SynExpr.ImplicitZero(_range) -> + | SynExpr.Null (_range) + | SynExpr.ImplicitZero (_range) -> None - | SynExpr.YieldOrReturn(_, synExpr, _range) - | SynExpr.YieldOrReturnFrom(_, synExpr, _range) - | SynExpr.DoBang(synExpr, _range) -> + | SynExpr.YieldOrReturn (_, synExpr, _range) + | SynExpr.YieldOrReturnFrom (_, synExpr, _range) + | SynExpr.DoBang (synExpr, _range) -> walkExpr synExpr - | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, _synPat, synExpr1, synExpr2, _range) -> + | SynExpr.LetOrUseBang (_sequencePointInfoForBinding, _, _, _synPat, synExpr1, synExpr2, _range) -> List.tryPick walkExpr [synExpr1; synExpr2] | SynExpr.LibraryOnlyILAssembly _ @@ -905,11 +905,11 @@ module internal InterfaceStubGenerator = | SynExpr.LibraryOnlyUnionCaseFieldGet _ | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None - | SynExpr.ArbitraryAfterError(_debugStr, _range) -> + | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None - | SynExpr.FromParseError(synExpr, _range) - | SynExpr.DiscardAfterMissingQualificationAfterDot(synExpr, _range) -> + | SynExpr.FromParseError (synExpr, _range) + | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> walkExpr synExpr | _ -> None diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index 3932fbf4b..7d19eeea2 100755 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -316,7 +316,7 @@ type FSharpTokenizerLexState = OtherBits: int64 } static member Initial = { PosBits = 0L; OtherBits = 0L } member this.Equals (other: FSharpTokenizerLexState) = (this.PosBits = other.PosBits) && (this.OtherBits = other.OtherBits) - override this.Equals (obj: obj) = match obj with :? FSharpTokenizerLexState as other -> this.Equals(other) | _ -> false + override this.Equals (obj: obj) = match obj with :? FSharpTokenizerLexState as other -> this.Equals other | _ -> false override this.GetHashCode () = hash this.PosBits + hash this.OtherBits type FSharpTokenizerColorState = @@ -432,7 +432,7 @@ module internal LexerStateEncoding = | LexCont.Token ifd -> FSharpTokenizerColorState.Token, 0L, pos0, ifd | LexCont.IfDefSkip (ifd, n, m) -> FSharpTokenizerColorState.IfDefSkip, int64 n, m.Start, ifd | LexCont.EndLine(LexerEndlineContinuation.Skip(ifd, n, m)) -> FSharpTokenizerColorState.EndLineThenSkip, int64 n, m.Start, ifd - | LexCont.EndLine(LexerEndlineContinuation.Token(ifd)) -> FSharpTokenizerColorState.EndLineThenToken, 0L, pos0, ifd + | LexCont.EndLine(LexerEndlineContinuation.Token ifd) -> FSharpTokenizerColorState.EndLineThenToken, 0L, pos0, ifd | LexCont.String (ifd, m) -> FSharpTokenizerColorState.String, 0L, m.Start, ifd | LexCont.Comment (ifd, n, m) -> FSharpTokenizerColorState.Comment, int64 n, m.Start, ifd | LexCont.SingleLineComment (ifd, n, m) -> FSharpTokenizerColorState.SingleLineComment, int64 n, m.Start, ifd @@ -461,7 +461,7 @@ module internal LexerStateEncoding = | FSharpTokenizerColorState.VerbatimString -> LexCont.VerbatimString (ifd, mkRange "file" p1 p1) | FSharpTokenizerColorState.TripleQuoteString -> LexCont.TripleQuoteString (ifd, mkRange "file" p1 p1) | FSharpTokenizerColorState.EndLineThenSkip -> LexCont.EndLine(LexerEndlineContinuation.Skip(ifd, n1, mkRange "file" p1 p1)) - | FSharpTokenizerColorState.EndLineThenToken -> LexCont.EndLine(LexerEndlineContinuation.Token(ifd)) + | FSharpTokenizerColorState.EndLineThenToken -> LexCont.EndLine(LexerEndlineContinuation.Token ifd) | _ -> LexCont.Token [] lightSyntaxStatusInital, lexcont @@ -512,7 +512,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, let mutable singleLineTokenState = SingleLineTokenState.BeforeHash let fsx = match filename with | None -> false - | Some(value) -> CompileOps.IsScript(value) + | Some value -> CompileOps.IsScript value // ---------------------------------------------------------------------------------- // This implements post-processing of #directive tokens - not very elegant, but it works... @@ -521,7 +521,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, // Stack for tokens that are split during postprocessing let mutable tokenStack = new Stack<_>() - let delayToken tok = tokenStack.Push(tok) + let delayToken tok = tokenStack.Push tok // Process: anywhite* # let processDirective (str: string) directiveLength delay cont = @@ -536,7 +536,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, let comment = rest.IndexOf('/') let spaceLength = if comment = -1 then rest.Length else comment if (spaceLength > 0) then delay(WHITESPACE cont, offset, offset + spaceLength - 1) - if (comment <> -1) then delay(COMMENT(cont), offset + comment, offset + rest.Length - 1) + if (comment <> -1) then delay(COMMENT cont, offset + comment, offset + rest.Length - 1) // Split a directive line from lexer into tokens usable in VS let processDirectiveLine ofs f = @@ -564,7 +564,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, let offset = processDirective str 2 delay cont // Process: anywhite+ ident let rest, spaces = - let w = str.Substring(offset) + let w = str.Substring offset let r = w.TrimStart [| ' '; '\t' |] r, w.Length - r.Length let beforeIdent = offset + spaces @@ -581,9 +581,9 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, do match filename with | None -> lexbuf.EndPos <- Internal.Utilities.Text.Lexing.Position.Empty - | Some(value) -> resetLexbufPos value lexbuf + | Some value -> resetLexbufPos value lexbuf - member x.ScanToken(lexintInitial) : FSharpTokenInfo option * FSharpTokenizerLexState = + member x.ScanToken lexintInitial : FSharpTokenInfo option * FSharpTokenizerLexState = use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) @@ -594,7 +594,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, // Build the arguments to the lexer function let lexargs = if lightSyntaxStatusInital then lexArgsLightOn else lexArgsLightOff - let GetTokenWithPosition(lexcontInitial) = + let GetTokenWithPosition lexcontInitial = // Column of token let ColumnsOfCurrentToken() = let leftp = lexbuf.StartPos @@ -620,11 +620,11 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, // because sometimes token shouldn't be split. However it is just for colorization & // for VS (which needs to recognize when user types "."). match token with - | HASH_IF(m, lineStr, cont) when lineStr <> "" -> + | HASH_IF (m, lineStr, cont) when lineStr <> "" -> false, processHashIfLine m.StartColumn lineStr cont - | HASH_ELSE(m, lineStr, cont) when lineStr <> "" -> + | HASH_ELSE (m, lineStr, cont) when lineStr <> "" -> false, processHashEndElse m.StartColumn lineStr 4 cont - | HASH_ENDIF(m, lineStr, cont) when lineStr <> "" -> + | HASH_ENDIF (m, lineStr, cont) when lineStr <> "" -> false, processHashEndElse m.StartColumn lineStr 5 cont | RQUOTE_DOT (s, raw) -> delayToken(DOT, rightc, rightc) @@ -638,41 +638,41 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, false, (greaters.[0] false, leftc, rightc - opstr.Length + 1) // break up any operators that start with '.' so that we can get auto-popup-completion for e.g. "x.+1" when typing the dot | INFIX_STAR_STAR_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_STAR_STAR_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(INFIX_STAR_STAR_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | PLUS_MINUS_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(PLUS_MINUS_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(PLUS_MINUS_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | INFIX_COMPARE_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_COMPARE_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(INFIX_COMPARE_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | INFIX_AT_HAT_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_AT_HAT_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(INFIX_AT_HAT_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | INFIX_BAR_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_BAR_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(INFIX_BAR_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | PREFIX_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(PREFIX_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(PREFIX_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | INFIX_STAR_DIV_MOD_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_STAR_DIV_MOD_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(INFIX_STAR_DIV_MOD_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | INFIX_AMP_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_AMP_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(INFIX_AMP_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | ADJACENT_PREFIX_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(ADJACENT_PREFIX_OP(opstr.Substring(1)), leftc+1, rightc) + delayToken(ADJACENT_PREFIX_OP(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | FUNKY_OPERATOR_NAME opstr when opstr.StartsWithOrdinal(".") -> - delayToken(FUNKY_OPERATOR_NAME(opstr.Substring(1)), leftc+1, rightc) + delayToken(FUNKY_OPERATOR_NAME(opstr.Substring 1), leftc+1, rightc) false, (DOT, leftc, leftc) | _ -> false, (token, leftc, rightc) with | e -> false, (EOF LexerStateEncoding.revertToDefaultLexCont, 0, 0) // REVIEW: report lex failure here // Grab a token - let isCached, (token, leftc, rightc) = GetTokenWithPosition(lexcontInitial) + let isCached, (token, leftc, rightc) = GetTokenWithPosition lexcontInitial // Check for end-of-string and failure let tokenDataOption, lexcontFinal, tokenTag = @@ -699,21 +699,21 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, FSharpTokenTriggerClass=triggerClass Tag=tokenTag FullMatchedLength=fullMatchedLength} - Some(tokenData), lexcontFinal, tokenTag + Some tokenData, lexcontFinal, tokenTag // Get the final lex int and color state - let FinalState(lexcontFinal) = + let FinalState lexcontFinal = LexerStateEncoding.encodeLexInt lightSyntaxStatus.Status lexcontFinal // Check for patterns like #-IDENT and see if they look like meta commands for .fsx files. If they do then merge them into a single token. let tokenDataOption, lexintFinal = - let lexintFinal = FinalState(lexcontFinal) + let lexintFinal = FinalState lexcontFinal match tokenDataOption, singleLineTokenState, tokenTagToTokenId tokenTag with - | Some(tokenData), SingleLineTokenState.BeforeHash, TOKEN_HASH -> + | Some tokenData, SingleLineTokenState.BeforeHash, TOKEN_HASH -> // Don't allow further matches. singleLineTokenState <- SingleLineTokenState.NoFurtherMatchPossible // Peek at the next token - let isCached, (nextToken, _, rightc) = GetTokenWithPosition(lexcontInitial) + let isCached, (nextToken, _, rightc) = GetTokenWithPosition lexcontInitial match nextToken with | IDENT possibleMetacommand -> match fsx, possibleMetacommand with @@ -738,10 +738,10 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, // These are for script and non-script | _, "nowarn" -> // Merge both tokens into one. - let lexcontFinal = if (isCached) then lexcontInitial else LexerStateEncoding.computeNextLexState token lexcontInitial + let lexcontFinal = if isCached then lexcontInitial else LexerStateEncoding.computeNextLexState token lexcontInitial let tokenData = {tokenData with RightColumn=rightc;ColorClass=FSharpTokenColorKind.PreprocessorKeyword;CharClass=FSharpTokenCharKind.Keyword;FSharpTokenTriggerClass=FSharpTokenTriggerClass.None} - let lexintFinal = FinalState(lexcontFinal) - Some(tokenData), lexintFinal + let lexintFinal = FinalState lexcontFinal + Some tokenData, lexintFinal | _ -> tokenDataOption, lexintFinal | _ -> tokenDataOption, lexintFinal | _, SingleLineTokenState.BeforeHash, TOKEN_WHITESPACE -> @@ -771,7 +771,7 @@ type FSharpSourceTokenizer(defineConstants : string list, filename : string opti FSharpLineTokenizer(lexbuf, Some lineText.Length, filename, lexArgsLightOn, lexArgsLightOff) - member this.CreateBufferTokenizer(bufferFiller) = + member this.CreateBufferTokenizer bufferFiller = let lexbuf = UnicodeLexing.FunctionAsLexbuf bufferFiller FSharpLineTokenizer(lexbuf, None, filename, lexArgsLightOn, lexArgsLightOff) diff --git a/src/fsharp/service/ServiceNavigation.fs b/src/fsharp/service/ServiceNavigation.fs index a85380518..9799e9621 100755 --- a/src/fsharp/service/ServiceNavigation.fs +++ b/src/fsharp/service/ServiceNavigation.fs @@ -127,7 +127,7 @@ module NavigationImpl = let processBinding isMember enclosingEntityKind isAbstract (Binding(_, _, _, _, _, _, SynValData(memebrOpt, _, _), synPat, _, synExpr, _, _)) = let m = match synExpr with - | SynExpr.Typed(e, _, _) -> e.Range // fix range for properties with type annotations + | SynExpr.Typed (e, _, _) -> e.Range // fix range for properties with type annotations | _ -> synExpr.Range match synPat, memebrOpt with diff --git a/src/fsharp/service/ServiceParamInfoLocations.fs b/src/fsharp/service/ServiceParamInfoLocations.fs index f527e493b..4ffaaf85d 100755 --- a/src/fsharp/service/ServiceParamInfoLocations.fs +++ b/src/fsharp/service/ServiceParamInfoLocations.fs @@ -41,10 +41,10 @@ module internal NoteworthyParamInfoLocationsImpl = let rec digOutIdentFromFuncExpr synExpr = // we found it, dig out ident match synExpr with - | SynExpr.Ident(id) -> Some ([id.idText], id.idRange) - | SynExpr.LongIdent(_, LongIdentWithDots(lid, _), _, lidRange) - | SynExpr.DotGet(_, _, LongIdentWithDots(lid, _), lidRange) -> Some (pathOfLid lid, lidRange) - | SynExpr.TypeApp(synExpr, _, _synTypeList, _commas, _, _, _range) -> digOutIdentFromFuncExpr synExpr + | SynExpr.Ident (id) -> Some ([id.idText], id.idRange) + | SynExpr.LongIdent (_, LongIdentWithDots(lid, _), _, lidRange) + | SynExpr.DotGet (_, _, LongIdentWithDots(lid, _), lidRange) -> Some (pathOfLid lid, lidRange) + | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> digOutIdentFromFuncExpr synExpr | _ -> None type FindResult = @@ -60,17 +60,17 @@ module internal NoteworthyParamInfoLocationsImpl = let getNamedParamName e = match e with // f(x=4) - | SynExpr.App(ExprAtomicFlag.NonAtomic, _, - SynExpr.App(ExprAtomicFlag.NonAtomic, true, + | SynExpr.App (ExprAtomicFlag.NonAtomic, _, + SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.Ident op, SynExpr.Ident n, _range), _, _) when op.idText="op_Equality" -> Some n.idText // f(?x=4) - | SynExpr.App(ExprAtomicFlag.NonAtomic, _, - SynExpr.App(ExprAtomicFlag.NonAtomic, true, + | SynExpr.App (ExprAtomicFlag.NonAtomic, _, + SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.Ident op, - SynExpr.LongIdent(true(*isOptional*), LongIdentWithDots([n], _), _ref, _lidrange), _range), + SynExpr.LongIdent (true(*isOptional*), LongIdentWithDots([n], _), _ref, _lidrange), _range), _, _) when op.idText="op_Equality" -> Some n.idText | _ -> None @@ -96,7 +96,7 @@ module internal NoteworthyParamInfoLocationsImpl = // see bug 345385. let rec searchSynArgExpr traverseSynExpr pos expr = match expr with - | SynExprParen((SynExpr.Tuple(false, synExprList, commaRanges, _tupleRange) as synExpr), _lpRange, rpRangeOpt, parenRange) -> // tuple argument + | SynExprParen((SynExpr.Tuple (false, synExprList, commaRanges, _tupleRange) as synExpr), _lpRange, rpRangeOpt, parenRange) -> // tuple argument let inner = traverseSynExpr synExpr match inner with | None -> @@ -108,7 +108,7 @@ module internal NoteworthyParamInfoLocationsImpl = NotFound, None | _ -> NotFound, None - | SynExprParen(SynExprParen(SynExpr.Tuple(false, _, _, _), _, _, _) as synExpr, _, rpRangeOpt, parenRange) -> // f((x, y)) is special, single tuple arg + | SynExprParen(SynExprParen(SynExpr.Tuple (false, _, _, _), _, _, _) as synExpr, _, rpRangeOpt, parenRange) -> // f((x, y)) is special, single tuple arg handleSingleArg traverseSynExpr (pos, synExpr, parenRange, rpRangeOpt) // dig into multiple parens @@ -119,14 +119,14 @@ module internal NoteworthyParamInfoLocationsImpl = | SynExprParen(synExpr, _lpRange, rpRangeOpt, parenRange) -> // single argument handleSingleArg traverseSynExpr (pos, synExpr, parenRange, rpRangeOpt) - | SynExpr.ArbitraryAfterError(_debugStr, range) -> // single argument when e.g. after open paren you hit EOF + | SynExpr.ArbitraryAfterError (_debugStr, range) -> // single argument when e.g. after open paren you hit EOF if AstTraversal.rangeContainsPosEdgesExclusive range pos then let r = Found (range.Start, [(range.End, None)], false) r, None else NotFound, None - | SynExpr.Const(SynConst.Unit, unitRange) -> + | SynExpr.Const (SynConst.Unit, unitRange) -> if AstTraversal.rangeContainsPosEdgesExclusive unitRange pos then let r = Found (unitRange.Start, [(unitRange.End, None)], true) r, None @@ -164,7 +164,7 @@ module internal NoteworthyParamInfoLocationsImpl = match expr with // new LID(...) and error recovery of these - | SynExpr.New(_, synType, synExpr, _) -> + | SynExpr.New (_, synType, synExpr, _) -> let constrArgsResult, cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr match constrArgsResult, cacheOpt with | Found(parenLoc, args, isThereACloseParen), _ -> @@ -178,7 +178,7 @@ module internal NoteworthyParamInfoLocationsImpl = | _ -> traverseSynExpr synExpr // EXPR< = error recovery of a form of half-written TypeApp - | SynExpr.App(_, _, SynExpr.App(_, true, SynExpr.Ident op, synExpr, openm), SynExpr.ArbitraryAfterError _, wholem) when op.idText = "op_LessThan" -> + | SynExpr.App (_, _, SynExpr.App (_, true, SynExpr.Ident op, synExpr, openm), SynExpr.ArbitraryAfterError _, wholem) when op.idText = "op_LessThan" -> // Look in the function expression let fResult = traverseSynExpr synExpr match fResult with @@ -194,7 +194,7 @@ module internal NoteworthyParamInfoLocationsImpl = None // EXPR EXPR2 - | SynExpr.App(_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> + | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> // Look in the function expression let fResult = traverseSynExpr synExpr match fResult with @@ -219,7 +219,7 @@ module internal NoteworthyParamInfoLocationsImpl = | _ -> traverseSynExpr synExpr2 // ID and error recovery of these - | SynExpr.TypeApp(synExpr, openm, tyArgs, commas, closemOpt, _, wholem) -> + | SynExpr.TypeApp (synExpr, openm, tyArgs, commas, closemOpt, _, wholem) -> match traverseSynExpr synExpr with | Some _ as r -> r | None -> diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index 40e6580cc..6a38afac7 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -199,17 +199,17 @@ module public AstTraversal = let path = TraverseStep.Expr e :: path let traverseSynExpr = traverseSynExpr path match e with - | SynExpr.Paren(synExpr, _, _, _parenRange) -> traverseSynExpr synExpr - | SynExpr.Quote(_synExpr, _, synExpr2, _, _range) -> + | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr + | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) -> [//dive synExpr synExpr.Range traverseSynExpr // TODO, what is this? dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.Const(_synConst, _range) -> None - | SynExpr.Typed(synExpr, synType, _range) -> [ traverseSynExpr synExpr; traverseSynType synType ] |> List.tryPick id - | SynExpr.Tuple(_, synExprList, _, _range) - | SynExpr.ArrayOrList(_, synExprList, _range) -> synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr + | SynExpr.Const (_synConst, _range) -> None + | SynExpr.Typed (synExpr, synType, _range) -> [ traverseSynExpr synExpr; traverseSynType synType ] |> List.tryPick id + | SynExpr.Tuple (_, synExprList, _, _range) + | SynExpr.ArrayOrList (_, synExprList, _range) -> synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr - | SynExpr.AnonRecd(_isStruct, copyOpt, synExprList, _range) -> + | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) -> [ match copyOpt with | Some(expr, (withRange, _)) -> yield dive expr expr.Range traverseSynExpr @@ -225,7 +225,7 @@ module public AstTraversal = for (_,x) in synExprList do yield dive x x.Range traverseSynExpr ] |> pick expr - | SynExpr.Record(inheritOpt,copyOpt,fields, _range) -> + | SynExpr.Record (inheritOpt,copyOpt,fields, _range) -> [ let diveIntoSeparator offsideColumn scPosOpt copyOpt = match scPosOpt with @@ -311,8 +311,8 @@ module public AstTraversal = | _ -> () ] |> pick expr - | SynExpr.New(_, _synType, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.ObjExpr(ty,baseCallOpt,binds,ifaces,_range1,_range2) -> + | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.ObjExpr (ty,baseCallOpt,binds,ifaces,_range1,_range2) -> let result = ifaces |> Seq.map (fun (InterfaceImpl(ty, _, _)) -> ty) @@ -325,7 +325,7 @@ module public AstTraversal = match baseCallOpt with | Some(expr,_) -> // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic - let newCall = SynExpr.New(false, ty, expr, unionRanges ty.Range expr.Range) + let newCall = SynExpr.New (false, ty, expr, unionRanges ty.Range expr.Range) yield dive newCall newCall.Range traverseSynExpr | _ -> () for b in binds do @@ -334,57 +334,57 @@ module public AstTraversal = for b in binds do yield dive b b.RangeOfBindingAndRhs (traverseSynBinding path) ] |> pick expr - | SynExpr.While(_sequencePointInfoForWhileLoop, synExpr, synExpr2, _range) -> + | SynExpr.While (_sequencePointInfoForWhileLoop, synExpr, synExpr2, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.For(_sequencePointInfoForForLoop, _ident, synExpr, _, synExpr2, synExpr3, _range) -> + | SynExpr.For (_sequencePointInfoForForLoop, _ident, synExpr, _, synExpr2, synExpr3, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr dive synExpr3 synExpr3.Range traverseSynExpr] |> pick expr - | SynExpr.ForEach(_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) -> + | SynExpr.ForEach (_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) -> [dive synPat synPat.Range traversePat dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.ArrayOrListOfSeqExpr(_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.CompExpr(_, _, synExpr, _range) -> + | SynExpr.ArrayOrListOfSeqExpr (_, synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.CompExpr (_, _, synExpr, _range) -> // now parser treats this syntactic expression as computation expression // { identifier } // here we detect this situation and treat CompExpr { Identifier } as attempt to create record // note: sequence expressions use SynExpr.CompExpr too - they need to be filtered out let isPartOfArrayOrList = match origPath with - | TraverseStep.Expr(SynExpr.ArrayOrListOfSeqExpr(_, _, _)) :: _ -> true + | TraverseStep.Expr(SynExpr.ArrayOrListOfSeqExpr (_, _, _)) :: _ -> true | _ -> false let ok = match isPartOfArrayOrList, synExpr with | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some (LongIdentWithDots([ident], []))) - | false, SynExpr.LongIdent(false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd) + | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd) | _ -> None if ok.IsSome then ok else traverseSynExpr synExpr - | SynExpr.Lambda(_, _, synSimplePats, synExpr, _range) -> + | SynExpr.Lambda (_, _, synSimplePats, synExpr, _range) -> match synSimplePats with | SynSimplePats.SimplePats(pats,_) -> match visitor.VisitSimplePats(pats) with | Some x -> Some x | None -> traverseSynExpr synExpr | _ -> traverseSynExpr synExpr - | SynExpr.MatchLambda(_isExnMatch,_argm,synMatchClauseList,_spBind,_wholem) -> + | SynExpr.MatchLambda (_isExnMatch,_argm,synMatchClauseList,_spBind,_wholem) -> synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) |> pick expr - | SynExpr.Match(_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> + | SynExpr.Match (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> [yield dive synExpr synExpr.Range traverseSynExpr yield! synMatchClauseList |> List.map (fun x -> dive x x.RangeOfGuardAndRhs (traverseSynMatchClause path))] |> pick expr - | SynExpr.Do(synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.Assert(synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.Fixed(synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.App(_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> + | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> if isInfix then [dive synExpr2 synExpr2.Range traverseSynExpr dive synExpr synExpr.Range traverseSynExpr] // reverse the args @@ -393,100 +393,100 @@ module public AstTraversal = [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.TypeApp(synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr - | SynExpr.LetOrUse(_, _, synBindingList, synExpr, range) -> + | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr + | SynExpr.LetOrUse (_, _, synBindingList, synExpr, range) -> match visitor.VisitLetOrUse(path, traverseSynBinding path, synBindingList, range) with | Some x -> Some x | None -> [yield! synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) yield dive synExpr synExpr.Range traverseSynExpr] |> pick expr - | SynExpr.TryWith(synExpr, _range, synMatchClauseList, _range2, _range3, _sequencePointInfoForTry, _sequencePointInfoForWith) -> + | SynExpr.TryWith (synExpr, _range, synMatchClauseList, _range2, _range3, _sequencePointInfoForTry, _sequencePointInfoForWith) -> [yield dive synExpr synExpr.Range traverseSynExpr yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))] |> pick expr - | SynExpr.TryFinally(synExpr, synExpr2, _range, _sequencePointInfoForTry, _sequencePointInfoForFinally) -> + | SynExpr.TryFinally (synExpr, synExpr2, _range, _sequencePointInfoForTry, _sequencePointInfoForFinally) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.Lazy(synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.Sequential(_sequencePointInfoForSeq, _, synExpr, synExpr2, _range) -> + | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.Sequential (_sequencePointInfoForSeq, _, synExpr, synExpr2, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.IfThenElse(synExpr, synExpr2, synExprOpt, _sequencePointInfoForBinding, _isRecovery, _range, _range2) -> + | SynExpr.IfThenElse (synExpr, synExpr2, synExprOpt, _sequencePointInfoForBinding, _isRecovery, _range, _range2) -> [yield dive synExpr synExpr.Range traverseSynExpr yield dive synExpr2 synExpr2.Range traverseSynExpr match synExprOpt with | None -> () | Some(x) -> yield dive x x.Range traverseSynExpr] |> pick expr - | SynExpr.Ident(_ident) -> None - | SynExpr.LongIdent(_, _longIdent, _altNameRefCell, _range) -> None - | SynExpr.LongIdentSet(_longIdent, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.DotGet(synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr - | SynExpr.Set(synExpr, synExpr2, _) - | SynExpr.DotSet(synExpr, _, synExpr2, _) -> + | SynExpr.Ident (_ident) -> None + | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None + | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr + | SynExpr.Set (synExpr, synExpr2, _) + | SynExpr.DotSet (synExpr, _, synExpr2, _) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.DotIndexedGet(synExpr, synExprList, _range, _range2) -> + | SynExpr.DotIndexedGet (synExpr, synExprList, _range, _range2) -> [yield dive synExpr synExpr.Range traverseSynExpr for synExpr in synExprList do for x in synExpr.Exprs do yield dive x x.Range traverseSynExpr] |> pick expr - | SynExpr.DotIndexedSet(synExpr, synExprList, synExpr2, _, _range, _range2) -> + | SynExpr.DotIndexedSet (synExpr, synExprList, synExpr2, _, _range, _range2) -> [yield dive synExpr synExpr.Range traverseSynExpr for synExpr in synExprList do for x in synExpr.Exprs do yield dive x x.Range traverseSynExpr yield dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.JoinIn(synExpr1, _range, synExpr2, _range2) -> + | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) -> [dive synExpr1 synExpr1.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.NamedIndexedPropertySet(_longIdent, synExpr, synExpr2, _range) -> + | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.DotNamedIndexedPropertySet(synExpr, _longIdent, synExpr2, synExpr3, _range) -> + | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr dive synExpr3 synExpr3.Range traverseSynExpr] |> pick expr - | SynExpr.TypeTest(synExpr, synType, _range) - | SynExpr.Upcast(synExpr, synType, _range) - | SynExpr.Downcast(synExpr, synType, _range) -> + | SynExpr.TypeTest (synExpr, synType, _range) + | SynExpr.Upcast (synExpr, synType, _range) + | SynExpr.Downcast (synExpr, synType, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synType synType.Range traverseSynType] |> pick expr - | SynExpr.InferredUpcast(synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.InferredDowncast(synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.Null(_range) -> None - | SynExpr.AddressOf(_, synExpr, _range, _range2) -> traverseSynExpr synExpr - | SynExpr.TraitCall(_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.ImplicitZero(_range) -> None - | SynExpr.YieldOrReturn(_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.YieldOrReturnFrom(_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, synPat, synExpr, synExpr2, _range) -> + | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.Null (_range) -> None + | SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr + | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.ImplicitZero (_range) -> None + | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.LetOrUseBang (_sequencePointInfoForBinding, _, _, synPat, synExpr, synExpr2, _range) -> [dive synPat synPat.Range traversePat dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - | SynExpr.MatchBang(_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> + | SynExpr.MatchBang (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> [yield dive synExpr synExpr.Range traverseSynExpr yield! synMatchClauseList |> List.map (fun x -> dive x x.RangeOfGuardAndRhs (traverseSynMatchClause path))] |> pick expr - | SynExpr.DoBang(synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr | SynExpr.LibraryOnlyILAssembly _ -> None | SynExpr.LibraryOnlyStaticOptimization _ -> None | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None - | SynExpr.ArbitraryAfterError(_debugStr, _range) -> None - | SynExpr.FromParseError(synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.DiscardAfterMissingQualificationAfterDot(synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None + | SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr visitor.VisitExpr(path, traverseSynExpr path, defaultTraverse, expr) diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index e235b90a6..00e0b4895 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -220,7 +220,7 @@ module Structure = match expression with | SynExpr.Upcast (e, _, _) | SynExpr.Downcast (e, _, _) - | SynExpr.AddressOf(_, e, _, _) + | SynExpr.AddressOf (_, e, _, _) | SynExpr.InferredDowncast (e, _) | SynExpr.InferredUpcast (e, _) | SynExpr.DotGet (e, _, _, _) diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index 0f465a280..ba573b24f 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -28,16 +28,16 @@ module SourceFile = let private singleFileProjectExtensions = CompileOps.FSharpScriptFileSuffixes /// Whether or not this file is compilable let IsCompilable file = - let ext = Path.GetExtension(file) + let ext = Path.GetExtension file compilableExtensions |> List.exists(fun e->0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) /// Whether or not this file should be a single-file project let MustBeSingleFileProject file = - let ext = Path.GetExtension(file) + let ext = Path.GetExtension file singleFileProjectExtensions |> List.exists(fun e-> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) module SourceFileImpl = let IsInterfaceFile file = - let ext = Path.GetExtension(file) + let ext = Path.GetExtension file 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) /// Additional #defines that should be in place when editing a file in a file editor such as VS. @@ -95,9 +95,9 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op member scope.ParseTree = input - member scope.FindNoteworthyParamInfoLocations(pos) = + member scope.FindNoteworthyParamInfoLocations pos = match input with - | Some(input) -> FSharpNoteworthyParamInfoLocations.Find(pos, input) + | Some input -> FSharpNoteworthyParamInfoLocations.Find(pos, input) | _ -> None /// Get declared items and the selected item at the specified location @@ -115,7 +115,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op Trace.TraceInformation(sprintf "FCS: recovering from error in GetNavigationItemsImpl: '%s'" err) NavigationImpl.empty) - member private scope.ValidateBreakpointLocationImpl(pos) = + member private scope.ValidateBreakpointLocationImpl pos = let isMatchRange m = rangeContainsPos m pos || m.StartLine = pos.Line // Process let-binding @@ -179,7 +179,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op | SynExpr.Const _ -> () - | SynExpr.Quote(_, _, e, _, _) + | SynExpr.Quote (_, _, e, _, _) | SynExpr.TypeTest (e, _, _) | SynExpr.Upcast (e, _, _) | SynExpr.AddressOf (_, e, _, _) @@ -200,8 +200,8 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op | SynExpr.InferredUpcast (e, _) | SynExpr.InferredDowncast (e, _) | SynExpr.Lazy (e, _) - | SynExpr.TraitCall(_, _, e, _) - | SynExpr.Paren(e, _, _, _) -> + | SynExpr.TraitCall (_, _, e, _) + | SynExpr.Paren (e, _, _, _) -> yield! walkExpr false e | SynExpr.YieldOrReturn (_, e, _) @@ -246,7 +246,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op yield! walkExpr false e1 yield! walkExpr true e2 - | SynExpr.JoinIn(e1, _range, e2, _range2) -> + | SynExpr.JoinIn (e1, _range, e2, _range2) -> yield! walkExpr false e1 yield! walkExpr false e2 @@ -261,7 +261,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op yield! walkExpr false e1 yield! walkExpr true e2 - | SynExpr.MatchLambda(_isExnMatch, _argm, cl, spBind, _wholem) -> + | SynExpr.MatchLambda (_isExnMatch, _argm, cl, spBind, _wholem) -> yield! walkBindSeqPt spBind for (Clause(_, whenExpr, e, _, _)) in cl do yield! walkExprOpt false whenExpr @@ -346,7 +346,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op | SynMemberDefn.AutoProperty(_attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> yield! walkExpr true synExpr | SynMemberDefn.ImplicitCtor(_, _, _, _, m) -> yield! checkRange m | SynMemberDefn.Member(bind, _) -> yield! walkBind bind - | SynMemberDefn.Interface(_synty, Some(membs), _) -> for m in membs do yield! walkMember m + | SynMemberDefn.Interface(_synty, Some membs, _) -> for m in membs do yield! walkMember m | SynMemberDefn.Inherit(_, _, m) -> // can break on the "inherit" clause yield! checkRange m @@ -429,9 +429,9 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op // This does not need to be run on the background thread scope.GetNavigationItemsImpl() - member scope.ValidateBreakpointLocation(pos) = + member scope.ValidateBreakpointLocation pos = // This does not need to be run on the background thread - scope.ValidateBreakpointLocationImpl(pos) + scope.ValidateBreakpointLocationImpl pos type ModuleKind = { IsAutoOpen: bool; HasModuleSuffix: bool } @@ -452,7 +452,7 @@ module UntypedParseImpl = let GetRangeOfExprLeftOfDot(pos: pos, parseTreeOpt) = match parseTreeOpt with | None -> None - | Some(parseTree) -> + | Some parseTree -> let CheckLongIdent(longIdent: LongIdent) = // find the longest prefix before the "pos" dot let mutable r = (List.head longIdent).idRange @@ -467,39 +467,39 @@ module UntypedParseImpl = member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let expr = expr // fix debugger locals match expr with - | SynExpr.LongIdent(_, LongIdentWithDots(longIdent, _), _altNameRefCell, _range) -> - let _, r = CheckLongIdent(longIdent) - Some(r) - | SynExpr.LongIdentSet(LongIdentWithDots(longIdent, _), synExpr, _range) -> + | SynExpr.LongIdent (_, LongIdentWithDots(longIdent, _), _altNameRefCell, _range) -> + let _, r = CheckLongIdent longIdent + Some r + | SynExpr.LongIdentSet (LongIdentWithDots(longIdent, _), synExpr, _range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr else - let _, r = CheckLongIdent(longIdent) - Some(r) - | SynExpr.DotGet(synExpr, _dotm, LongIdentWithDots(longIdent, _), _range) -> + let _, r = CheckLongIdent longIdent + Some r + | SynExpr.DotGet (synExpr, _dotm, LongIdentWithDots(longIdent, _), _range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr else - let inFront, r = CheckLongIdent(longIdent) + let inFront, r = CheckLongIdent longIdent if inFront then Some(synExpr.Range) else // see comment below for SynExpr.DotSet Some((unionRanges synExpr.Range r)) - | SynExpr.Set(synExpr, synExpr2, range) -> + | SynExpr.Set (synExpr, synExpr2, range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then traverseSynExpr synExpr2 else - Some(range) - | SynExpr.DotSet(synExpr, LongIdentWithDots(longIdent, _), synExpr2, _range) -> + Some range + | SynExpr.DotSet (synExpr, LongIdentWithDots(longIdent, _), synExpr2, _range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then traverseSynExpr synExpr2 else - let inFront, r = CheckLongIdent(longIdent) + let inFront, r = CheckLongIdent longIdent if inFront then Some(synExpr.Range) else @@ -509,7 +509,7 @@ module UntypedParseImpl = // ---- synExpr.Range has this value // ------ we want this value Some((unionRanges synExpr.Range r)) - | SynExpr.DotNamedIndexedPropertySet(synExpr, LongIdentWithDots(longIdent, _), synExpr2, synExpr3, _range) -> + | SynExpr.DotNamedIndexedPropertySet (synExpr, LongIdentWithDots(longIdent, _), synExpr2, synExpr3, _range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then @@ -517,22 +517,22 @@ module UntypedParseImpl = elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr3.Range pos then traverseSynExpr synExpr3 else - let inFront, r = CheckLongIdent(longIdent) + let inFront, r = CheckLongIdent longIdent if inFront then Some(synExpr.Range) else Some((unionRanges synExpr.Range r)) - | SynExpr.DiscardAfterMissingQualificationAfterDot(synExpr, _range) -> // get this for e.g. "bar()." + | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> // get this for e.g. "bar()." if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr else Some(synExpr.Range) - | SynExpr.FromParseError(synExpr, range) -> + | SynExpr.FromParseError (synExpr, range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr else - Some(range) - | SynExpr.App(ExprAtomicFlag.NonAtomic, true, (SynExpr.Ident(ident)), rhs, _) + Some range + | SynExpr.App (ExprAtomicFlag.NonAtomic, true, (SynExpr.Ident ident), rhs, _) when ident.idText = "op_ArrayLookup" && not(AstTraversal.rangeContainsPosLeftEdgeInclusive rhs.Range pos) -> match defaultTraverse expr with @@ -541,7 +541,7 @@ module UntypedParseImpl = // also want it for e.g. [|arr|].(0) Some(expr.Range) | x -> x // we found the answer deeper somewhere in the lhs - | SynExpr.Const(SynConst.Double(_), range) -> Some(range) + | SynExpr.Const (SynConst.Double(_), range) -> Some range | _ -> defaultTraverse expr }) @@ -549,7 +549,7 @@ module UntypedParseImpl = let TryFindExpressionIslandInPosition(pos: pos, parseTreeOpt) = match parseTreeOpt with | None -> None - | Some(parseTree) -> + | Some parseTree -> let getLidParts (lid : LongIdent) = lid |> Seq.takeWhile (fun i -> posGeq pos i.idRange.Start) @@ -561,11 +561,11 @@ module UntypedParseImpl = // foundCandidate = true - we found candidate (DotGet) and now drill down to the left part let rec TryGetExpression foundCandidate expr = match expr with - | SynExpr.Paren(e, _, _, _) when foundCandidate -> + | SynExpr.Paren (e, _, _, _) when foundCandidate -> TryGetExpression foundCandidate e - | SynExpr.LongIdent(_isOptional, LongIdentWithDots(lid, _), _altNameRefCell, _m) -> + | SynExpr.LongIdent (_isOptional, LongIdentWithDots(lid, _), _altNameRefCell, _m) -> getLidParts lid |> Some - | SynExpr.DotGet(leftPart, _, LongIdentWithDots(lid, _), _) when (rangeContainsPos (rangeOfLid lid) pos) || foundCandidate -> + | SynExpr.DotGet (leftPart, _, LongIdentWithDots(lid, _), _) when (rangeContainsPos (rangeOfLid lid) pos) || foundCandidate -> // requested position is at the lid part of the DotGet // process left part and append result to the result of processing lid let leftPartResult = TryGetExpression true leftPart @@ -576,7 +576,7 @@ module UntypedParseImpl = yield! getLidParts lid ] |> Some | None -> None - | SynExpr.FromParseError(synExpr, _range) -> TryGetExpression foundCandidate synExpr + | SynExpr.FromParseError (synExpr, _range) -> TryGetExpression foundCandidate synExpr | _ -> None let rec walker = @@ -585,7 +585,7 @@ module UntypedParseImpl = if rangeContainsPos expr.Range pos then match TryGetExpression false expr with | (Some parts) -> parts |> String.concat "." |> Some - | _ -> defaultTraverse(expr) + | _ -> defaultTraverse expr else None } AstTraversal.Traverse(pos, parseTree, walker) @@ -605,7 +605,7 @@ module UntypedParseImpl = let TryFindExpressionASTLeftOfDotLeftOfCursor(pos, parseTreeOpt) = match parseTreeOpt with | None -> None - | Some(parseTree) -> + | Some parseTree -> let dive x = AstTraversal.dive x let pick x = AstTraversal.pick pos x let walker = @@ -615,11 +615,11 @@ module UntypedParseImpl = let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars if not(rangeContainsPos expr.Range pos) then match expr with - | SynExpr.DiscardAfterMissingQualificationAfterDot(e, _m) -> + | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _m) -> // This happens with e.g. "f(x) . $" when you bring up a completion list a few spaces after a dot. The cursor is not 'in the parse tree', // but the dive algorithm will dive down into this node, and this is the one case where we do want to give a result despite the cursor // not properly being in a node. - match traverseSynExpr(e) with + match traverseSynExpr e with | None -> Some(e.Range.End, false) | r -> r | _ -> @@ -638,33 +638,33 @@ module UntypedParseImpl = | Some(n, _) -> Some((List.item n lid).idRange.End, (List.length lid = n+1) // foo.$ || (posGeq (List.item (n+1) lid).idRange.Start pos)) // foo.$bar match expr with - | SynExpr.LongIdent(_isOptional, lidwd, _altNameRefCell, _m) -> + | SynExpr.LongIdent (_isOptional, lidwd, _altNameRefCell, _m) -> traverseLidOrElse None lidwd - | SynExpr.LongIdentSet(lidwd, exprRhs, _m) -> + | SynExpr.LongIdentSet (lidwd, exprRhs, _m) -> [ dive lidwd lidwd.Range (traverseLidOrElse None) dive exprRhs exprRhs.Range traverseSynExpr ] |> pick expr - | SynExpr.DotGet(exprLeft, dotm, lidwd, _m) -> + | SynExpr.DotGet (exprLeft, dotm, lidwd, _m) -> let afterDotBeforeLid = mkRange dotm.FileName dotm.End lidwd.Range.Start [ dive exprLeft exprLeft.Range traverseSynExpr dive exprLeft afterDotBeforeLid (fun e -> Some(e.Range.End, true)) dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) ] |> pick expr - | SynExpr.DotSet(exprLeft, lidwd, exprRhs, _m) -> + | SynExpr.DotSet (exprLeft, lidwd, exprRhs, _m) -> [ dive exprLeft exprLeft.Range traverseSynExpr dive lidwd lidwd.Range (traverseLidOrElse(Some exprLeft)) dive exprRhs exprRhs.Range traverseSynExpr ] |> pick expr - | SynExpr.Set(exprLeft, exprRhs, _m) -> + | SynExpr.Set (exprLeft, exprRhs, _m) -> [ dive exprLeft exprLeft.Range traverseSynExpr dive exprRhs exprRhs.Range traverseSynExpr ] |> pick expr - | SynExpr.NamedIndexedPropertySet(lidwd, exprIndexer, exprRhs, _m) -> + | SynExpr.NamedIndexedPropertySet (lidwd, exprIndexer, exprRhs, _m) -> [ dive lidwd lidwd.Range (traverseLidOrElse None) dive exprIndexer exprIndexer.Range traverseSynExpr dive exprRhs exprRhs.Range traverseSynExpr ] |> pick expr - | SynExpr.DotNamedIndexedPropertySet(exprLeft, lidwd, exprIndexer, exprRhs, _m) -> + | SynExpr.DotNamedIndexedPropertySet (exprLeft, lidwd, exprIndexer, exprRhs, _m) -> [ dive exprLeft exprLeft.Range traverseSynExpr dive lidwd lidwd.Range (traverseLidOrElse(Some exprLeft)) dive exprIndexer exprIndexer.Range traverseSynExpr @@ -677,8 +677,8 @@ module UntypedParseImpl = else // the cursor is left of the dot None - | SynExpr.DiscardAfterMissingQualificationAfterDot(e, m) -> - match traverseSynExpr(e) with + | SynExpr.DiscardAfterMissingQualificationAfterDot (e, m) -> + match traverseSynExpr e with | None -> if posEq m.End pos then // the cursor is at the dot @@ -687,7 +687,7 @@ module UntypedParseImpl = // the cursor is left of the dot None | r -> r - | SynExpr.App(ExprAtomicFlag.NonAtomic, true, (SynExpr.Ident(ident)), lhs, _m) + | SynExpr.App (ExprAtomicFlag.NonAtomic, true, (SynExpr.Ident ident), lhs, _m) when ident.idText = "op_ArrayLookup" && not(AstTraversal.rangeContainsPosLeftEdgeInclusive lhs.Range pos) -> match defaultTraverse expr with @@ -696,7 +696,7 @@ module UntypedParseImpl = // also want it for e.g. [|arr|].(0) Some(lhs.Range.End, false) | x -> x // we found the answer deeper somewhere in the lhs - | _ -> defaultTraverse(expr) } + | _ -> defaultTraverse expr } AstTraversal.Traverse(pos, parseTree, walker) let GetEntityKind (pos: pos, input: ParsedInput) : EntityKind option = @@ -706,8 +706,8 @@ module UntypedParseImpl = /// An recursive pattern that collect all sequential expressions to avoid StackOverflowException let rec (|Sequentials|_|) = function - | SynExpr.Sequential(_, _, e, Sequentials es, _) -> Some(e::es) - | SynExpr.Sequential(_, _, e1, e2, _) -> Some [e1; e2] + | SynExpr.Sequential (_, _, e, Sequentials es, _) -> Some(e::es) + | SynExpr.Sequential (_, _, e1, e2, _) -> Some [e1; e2] | _ -> None let inline isPosInRange range = Range.rangeContainsPos range pos @@ -822,63 +822,63 @@ module UntypedParseImpl = else None | _ -> None | SynExpr.Paren (e, _, _, _) -> walkExprWithKind parentKind e - | SynExpr.Quote(_, _, e, _, _) -> walkExprWithKind parentKind e - | SynExpr.Typed(e, _, _) -> walkExprWithKind parentKind e - | SynExpr.Tuple(_, es, _, _) -> List.tryPick (walkExprWithKind parentKind) es - | SynExpr.ArrayOrList(_, es, _) -> List.tryPick (walkExprWithKind parentKind) es - | SynExpr.Record(_, _, fields, r) -> + | SynExpr.Quote (_, _, e, _, _) -> walkExprWithKind parentKind e + | SynExpr.Typed (e, _, _) -> walkExprWithKind parentKind e + | SynExpr.Tuple (_, es, _, _) -> List.tryPick (walkExprWithKind parentKind) es + | SynExpr.ArrayOrList (_, es, _) -> List.tryPick (walkExprWithKind parentKind) es + | SynExpr.Record (_, _, fields, r) -> ifPosInRange r (fun _ -> fields |> List.tryPick (fun (_, e, _) -> e |> Option.bind (walkExprWithKind parentKind))) - | SynExpr.New(_, t, e, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) - | SynExpr.ObjExpr(ty, _, bindings, ifaces, _, _) -> + | SynExpr.New (_, t, e, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) + | SynExpr.ObjExpr (ty, _, bindings, ifaces, _, _) -> walkType ty |> Option.orElse (List.tryPick walkBinding bindings) |> Option.orElse (List.tryPick walkInterfaceImpl ifaces) - | SynExpr.While(_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.For(_, _, e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] - | SynExpr.ForEach(_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.ArrayOrListOfSeqExpr(_, e, _) -> walkExprWithKind parentKind e - | SynExpr.CompExpr(_, _, e, _) -> walkExprWithKind parentKind e - | SynExpr.Lambda(_, _, _, e, _) -> walkExprWithKind parentKind e - | SynExpr.MatchLambda(_, _, synMatchClauseList, _, _) -> + | SynExpr.While (_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.For (_, _, e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] + | SynExpr.ForEach (_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.ArrayOrListOfSeqExpr (_, e, _) -> walkExprWithKind parentKind e + | SynExpr.CompExpr (_, _, e, _) -> walkExprWithKind parentKind e + | SynExpr.Lambda (_, _, _, e, _) -> walkExprWithKind parentKind e + | SynExpr.MatchLambda (_, _, synMatchClauseList, _, _) -> List.tryPick walkClause synMatchClauseList - | SynExpr.Match(_, e, synMatchClauseList, _) -> + | SynExpr.Match (_, e, synMatchClauseList, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause synMatchClauseList) - | SynExpr.Do(e, _) -> walkExprWithKind parentKind e - | SynExpr.Assert(e, _) -> walkExprWithKind parentKind e - | SynExpr.App(_, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.TypeApp(e, _, tys, _, _, _, _) -> + | SynExpr.Do (e, _) -> walkExprWithKind parentKind e + | SynExpr.Assert (e, _) -> walkExprWithKind parentKind e + | SynExpr.App (_, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.TypeApp (e, _, tys, _, _, _, _) -> walkExprWithKind (Some EntityKind.Type) e |> Option.orElse (List.tryPick walkType tys) - | SynExpr.LetOrUse(_, _, bindings, e, _) -> List.tryPick walkBinding bindings |> Option.orElse (walkExprWithKind parentKind e) - | SynExpr.TryWith(e, _, clauses, _, _, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause clauses) - | SynExpr.TryFinally(e1, e2, _, _, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.Lazy(e, _) -> walkExprWithKind parentKind e + | SynExpr.LetOrUse (_, _, bindings, e, _) -> List.tryPick walkBinding bindings |> Option.orElse (walkExprWithKind parentKind e) + | SynExpr.TryWith (e, _, clauses, _, _, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause clauses) + | SynExpr.TryFinally (e1, e2, _, _, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.Lazy (e, _) -> walkExprWithKind parentKind e | Sequentials es -> List.tryPick (walkExprWithKind parentKind) es - | SynExpr.IfThenElse(e1, e2, e3, _, _, _, _) -> + | SynExpr.IfThenElse (e1, e2, e3, _, _, _, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] |> Option.orElse (match e3 with None -> None | Some e -> walkExprWithKind parentKind e) | SynExpr.Ident ident -> ifPosInRange ident.idRange (fun _ -> Some (EntityKind.FunctionOrValue false)) - | SynExpr.LongIdentSet(_, e, _) -> walkExprWithKind parentKind e - | SynExpr.DotGet(e, _, _, _) -> walkExprWithKind parentKind e - | SynExpr.DotSet(e, _, _, _) -> walkExprWithKind parentKind e - | SynExpr.Set(e, _, _) -> walkExprWithKind parentKind e - | SynExpr.DotIndexedGet(e, args, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkIndexerArg args) - | SynExpr.DotIndexedSet(e, args, _, _, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkIndexerArg args) - | SynExpr.NamedIndexedPropertySet(_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.DotNamedIndexedPropertySet(e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] - | SynExpr.TypeTest(e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) - | SynExpr.Upcast(e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) - | SynExpr.Downcast(e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) - | SynExpr.InferredUpcast(e, _) -> walkExprWithKind parentKind e - | SynExpr.InferredDowncast(e, _) -> walkExprWithKind parentKind e - | SynExpr.AddressOf(_, e, _, _) -> walkExprWithKind parentKind e - | SynExpr.JoinIn(e1, _, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.YieldOrReturn(_, e, _) -> walkExprWithKind parentKind e - | SynExpr.YieldOrReturnFrom(_, e, _) -> walkExprWithKind parentKind e - | SynExpr.Match(_, e, synMatchClauseList, _) - | SynExpr.MatchBang(_, e, synMatchClauseList, _) -> + | SynExpr.LongIdentSet (_, e, _) -> walkExprWithKind parentKind e + | SynExpr.DotGet (e, _, _, _) -> walkExprWithKind parentKind e + | SynExpr.DotSet (e, _, _, _) -> walkExprWithKind parentKind e + | SynExpr.Set (e, _, _) -> walkExprWithKind parentKind e + | SynExpr.DotIndexedGet (e, args, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkIndexerArg args) + | SynExpr.DotIndexedSet (e, args, _, _, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkIndexerArg args) + | SynExpr.NamedIndexedPropertySet (_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] + | SynExpr.TypeTest (e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) + | SynExpr.Upcast (e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) + | SynExpr.Downcast (e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) + | SynExpr.InferredUpcast (e, _) -> walkExprWithKind parentKind e + | SynExpr.InferredDowncast (e, _) -> walkExprWithKind parentKind e + | SynExpr.AddressOf (_, e, _, _) -> walkExprWithKind parentKind e + | SynExpr.JoinIn (e1, _, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.YieldOrReturn (_, e, _) -> walkExprWithKind parentKind e + | SynExpr.YieldOrReturnFrom (_, e, _) -> walkExprWithKind parentKind e + | SynExpr.Match (_, e, synMatchClauseList, _) + | SynExpr.MatchBang (_, e, synMatchClauseList, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause synMatchClauseList) - | SynExpr.LetOrUseBang(_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.DoBang(e, _) -> walkExprWithKind parentKind e + | SynExpr.LetOrUseBang (_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.DoBang (e, _) -> walkExprWithKind parentKind e | SynExpr.TraitCall (ts, sign, e, _) -> List.tryPick walkTypar ts |> Option.orElse (walkMemberSig sign) @@ -1081,7 +1081,7 @@ module UntypedParseImpl = let (|Operator|_|) name e = match e with - | SynExpr.App(ExprAtomicFlag.NonAtomic, false, SynExpr.App(ExprAtomicFlag.NonAtomic, true, SynExpr.Ident(ident), lhs, _), rhs, _) + | SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.Ident ident, lhs, _), rhs, _) when ident.idText = name -> Some(lhs, rhs) | _ -> None @@ -1098,7 +1098,7 @@ module UntypedParseImpl = let findSetters argList = match argList with - | SynExpr.Paren(SynExpr.Tuple(false, parameters, _, _), _, _, _) -> + | SynExpr.Paren (SynExpr.Tuple (false, parameters, _, _), _, _, _) -> let setters = HashSet() for p in parameters do match p with @@ -1132,13 +1132,13 @@ module UntypedParseImpl = | (SynExpr.App (_, false, SynExpr.Ident id, arg, _)) -> // A() Some (id.idRange.End, findSetters arg) - | (SynExpr.App (_, false, SynExpr.TypeApp(SynExpr.Ident id, _, _, _, mGreaterThan, _, _), arg, _)) -> + | (SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.Ident id, _, _, _, mGreaterThan, _, _), arg, _)) -> // A<_>() Some (endOfClosingTokenOrIdent mGreaterThan id, findSetters arg) - | (SynExpr.App (_, false, SynExpr.LongIdent(_, lid, _, _), arg, _)) -> + | (SynExpr.App (_, false, SynExpr.LongIdent (_, lid, _, _), arg, _)) -> // A.B() Some (endOfLastIdent lid, findSetters arg) - | (SynExpr.App (_, false, SynExpr.TypeApp(SynExpr.LongIdent(_, lid, _, _), _, _, _, mGreaterThan, _, _), arg, _)) -> + | (SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.LongIdent (_, lid, _, _), _, _, _, mGreaterThan, _, _), arg, _)) -> // A.B<_>() Some (endOfClosingTokenOrLastIdent mGreaterThan lid, findSetters arg) | _ -> None @@ -1157,9 +1157,9 @@ module UntypedParseImpl = let (|PartOfParameterList|_|) precedingArgument path = match path with - | TS.Expr(SynExpr.Paren _)::TS.Expr(NewObjectOrMethodCall(args))::_ -> + | TS.Expr(SynExpr.Paren _)::TS.Expr(NewObjectOrMethodCall args)::_ -> if Option.isSome precedingArgument then None else Some args - | TS.Expr(SynExpr.Tuple (false, elements, commas, _))::TS.Expr(SynExpr.Paren _)::TS.Expr(NewObjectOrMethodCall(args))::_ -> + | TS.Expr(SynExpr.Tuple (false, elements, commas, _))::TS.Expr(SynExpr.Paren _)::TS.Expr(NewObjectOrMethodCall args)::_ -> match precedingArgument with | None -> Some args | Some e -> @@ -1184,7 +1184,7 @@ module UntypedParseImpl = else match expr with // new A($) - | SynExpr.Const(SynConst.Unit, m) when rangeContainsPos m pos -> + | SynExpr.Const (SynConst.Unit, m) when rangeContainsPos m pos -> match path with | TS.Expr(NewObjectOrMethodCall args)::_ -> Some (CompletionContext.ParameterList args) @@ -1215,11 +1215,11 @@ module UntypedParseImpl = match path with | TS.Expr(_)::TS.Binding(_):: TS.MemberDefn(_)::TS.TypeDefn(SynTypeDefn.TypeDefn(ComponentInfo(_, _, _, [id], _, _, _, _), _, _, _))::_ -> RecordContext.Constructor(id.idText) - | _ -> RecordContext.New (completionPath) + | _ -> RecordContext.New completionPath match field with | Some field -> match parseLid field with - | Some (completionPath) -> + | Some completionPath -> let recordContext = match copyOpt with | Some (s : SynExpr) -> RecordContext.CopyOnUpdate(s.Range, completionPath) @@ -1237,7 +1237,7 @@ module UntypedParseImpl = match synType with | SynType.LongIdent lidwd -> match parseLid lidwd with - | Some (completionPath) -> GetCompletionContextForInheritSynMember (componentInfo, typeDefnKind, completionPath) + | Some completionPath -> GetCompletionContextForInheritSynMember (componentInfo, typeDefnKind, completionPath) | None -> Some (CompletionContext.Invalid) // A $ .B -> no completion list | _ -> None @@ -1248,7 +1248,7 @@ module UntypedParseImpl = | SynPat.Named (range = range) when rangeContainsPos range pos -> // parameter without type hint, no completion Some CompletionContext.Invalid - | SynPat.Typed(SynPat.Named(SynPat.Wild(range), _, _, _, _), _, _) when rangeContainsPos range pos -> + | SynPat.Typed(SynPat.Named(SynPat.Wild range, _, _, _, _), _, _) when rangeContainsPos range pos -> // parameter with type hint, but we are on its name, no completion Some CompletionContext.Invalid | _ -> defaultTraverse synBinding @@ -1259,7 +1259,7 @@ module UntypedParseImpl = Some CompletionContext.Invalid | SynPat.LongIdent(_, _, _, ctorArgs, _, _) -> match ctorArgs with - | SynConstructorArgs.Pats(pats) -> + | SynConstructorArgs.Pats pats -> pats |> List.tryPick (fun pat -> match pat with | SynPat.Paren(pat, _) -> @@ -1267,7 +1267,7 @@ module UntypedParseImpl = | SynPat.Tuple(_, pats, _) -> pats |> List.tryPick visitParam | _ -> visitParam pat - | SynPat.Wild(range) when rangeContainsPos range pos -> + | SynPat.Wild range when rangeContainsPos range pos -> // let foo (x| Some CompletionContext.Invalid | _ -> visitParam pat @@ -1278,7 +1278,7 @@ module UntypedParseImpl = Some CompletionContext.Invalid | _ -> defaultTraverse synBinding - member __.VisitHashDirective(range) = + member __.VisitHashDirective range = if rangeContainsPos range pos then Some CompletionContext.Invalid else None @@ -1300,7 +1300,7 @@ module UntypedParseImpl = | [] when range.StartLine = pos.Line -> Some CompletionContext.Invalid | _ -> None - member __.VisitSimplePats(pats) = + member __.VisitSimplePats pats = pats |> List.tryPick (fun pat -> match pat with | SynSimplePat.Id(range = range) @@ -1345,7 +1345,7 @@ module UntypedParseImpl = // match the most nested paired [< and >] first let matches = - insideAttributeApplicationRegex.Matches(lineStr) + insideAttributeApplicationRegex.Matches lineStr |> Seq.cast |> Seq.filter (fun m -> m.Index <= pos.Column && m.Index + m.Length >= pos.Column) |> Seq.toArray diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 3ca946945..410205392 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -2312,7 +2312,7 @@ module CompileHelpers = // Register the reflected definitions for the dynamically generated assembly for resource in ilxMainModule.Resources.AsList do if IsReflectedDefinitionsResource resource then - Quotations.Expr.RegisterReflectedDefinitions(assemblyBuilder, moduleBuilder.Name, resource.GetBytes()) + Quotations.Expr.RegisterReflectedDefinitions (assemblyBuilder, moduleBuilder.Name, resource.GetBytes()) // Save the result assemblyBuilderRef := Some assemblyBuilder diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index fc50346f3..57cca88ab 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -19,16 +19,21 @@ module ExprTranslationImpl = let nonNil x = not (List.isEmpty x) type ExprTranslationEnv = - { //Map from Val to binding index + { + /// Map from Val to binding index vs: ValMap - //Map from typar stamps to binding index + + /// Map from typar stamps to binding index tyvs: StampMap + // Map for values bound by the // 'let v = isinst e in .... if nonnull v then ...v .... ' // construct arising out the compilation of pattern matching. We decode these back to the form // 'if istype v then ...unbox v .... ' isinstVals: ValMap - substVals: ValMap } + + substVals: ValMap + } static member Empty = { vs=ValMap<_>.Empty @@ -61,7 +66,6 @@ module ExprTranslationImpl = let wfail (msg, m: range) = failwith (msg + sprintf " at %s" (m.ToString())) - /// The core tree of data produced by converting F# compiler TAST expressions into the form which we make available through the compiler API /// through active patterns. type E = @@ -153,7 +157,7 @@ and [] FSharpExpr (cenv, f: (unit -> FSharpExpr) option, e: E, m: range, | E.UnionCaseTest (obj, _b, _c) -> [obj] | E.NewArray (_ty, elems) -> elems | E.Coerce (_ty, b) -> [b] - | E.Quote (a) -> [a] + | E.Quote a -> [a] | E.TypeTest (_ty, b) -> [b] | E.Sequential (a, b) -> [a;b] | E.FastIntegerForLoop (a, b, c, _dir) -> [a;b;c] @@ -161,12 +165,12 @@ and [] FSharpExpr (cenv, f: (unit -> FSharpExpr) option, e: E, m: range, | E.TryFinally (body, b) -> [body; b] | E.TryWith (body, _b, _c, _d, handler) -> [body; handler] | E.NewDelegate (_ty, body) -> [body] - | E.DefaultValue (_ty) -> [] + | E.DefaultValue _ty -> [] | E.AddressSet (lvalueExpr, rvalueExpr) -> [lvalueExpr; rvalueExpr] | E.ValueSet (_v, rvalueExpr) -> [rvalueExpr] - | E.AddressOf (lvalueExpr) -> [lvalueExpr] - | E.ThisValue (_ty) -> [] - | E.BaseValue (_ty) -> [] + | E.AddressOf lvalueExpr -> [lvalueExpr] + | E.ThisValue _ty -> [] + | E.BaseValue _ty -> [] | E.ILAsm (_code, _tyargs, argExprs) -> argExprs | E.ILFieldGet (objOpt, _ty, _fieldName) -> (match objOpt with None -> [] | Some x -> [x]) | E.ILFieldSet (objOpt, _ty, _fieldName, d) -> (match objOpt with None -> [d] | Some x -> [x;d]) @@ -195,13 +199,13 @@ module FSharpExprConvert = // Match "if [AI_clt](init@41, 6) then IntrinsicFunctions.FailStaticInit () else ()" let (|StaticInitializationCheck|_|) e = match e with - | Expr.Match (_, _, TDSwitch(Expr.Op(TOp.ILAsm ([ AI_clt ], _), _, [Expr.Op(TOp.ValFieldGet rfref, _, _, _) ;_], _), _, _, _), _, _, _) when IsStaticInitializationField rfref -> Some () + | Expr.Match (_, _, TDSwitch(Expr.Op (TOp.ILAsm ([ AI_clt ], _), _, [Expr.Op (TOp.ValFieldGet rfref, _, _, _) ;_], _), _, _, _), _, _, _) when IsStaticInitializationField rfref -> Some () | _ -> None // Match "init@41 <- 6" let (|StaticInitializationCount|_|) e = match e with - | Expr.Op(TOp.ValFieldSet rfref, _, _, _) when IsStaticInitializationField rfref -> Some () + | Expr.Op (TOp.ValFieldSet rfref, _, _, _) when IsStaticInitializationField rfref -> Some () | _ -> None let (|ILUnaryOp|_|) e = @@ -307,15 +311,15 @@ module FSharpExprConvert = let rec exprOfExprAddr (cenv: SymbolEnv) expr = match expr with - | Expr.Op(op, tyargs, args, m) -> + | Expr.Op (op, tyargs, args, m) -> match op, args, tyargs with - | TOp.LValueOp(LAddrOf _, vref), _, _ -> exprForValRef m vref - | TOp.ValFieldGetAddr(rfref, _), [], _ -> mkStaticRecdFieldGet(rfref, tyargs, m) - | TOp.ValFieldGetAddr(rfref, _), [arg], _ -> mkRecdFieldGetViaExprAddr(exprOfExprAddr cenv arg, rfref, tyargs, m) - | TOp.UnionCaseFieldGetAddr(uref, n, _), [arg], _ -> mkUnionCaseFieldGetProvenViaExprAddr(exprOfExprAddr cenv arg, uref, tyargs, n, m) - | TOp.ILAsm([ I_ldflda(fspec) ], rtys), [arg], _ -> mkAsmExpr([ mkNormalLdfld(fspec) ], tyargs, [exprOfExprAddr cenv arg], rtys, m) - | TOp.ILAsm([ I_ldsflda(fspec) ], rtys), _, _ -> mkAsmExpr([ mkNormalLdsfld(fspec) ], tyargs, args, rtys, m) - | TOp.ILAsm(([ I_ldelema(_ro, _isNativePtr, shape, _tyarg) ] ), _), (arr::idxs), [elemty] -> + | TOp.LValueOp (LAddrOf _, vref), _, _ -> exprForValRef m vref + | TOp.ValFieldGetAddr (rfref, _), [], _ -> mkStaticRecdFieldGet (rfref, tyargs, m) + | TOp.ValFieldGetAddr (rfref, _), [arg], _ -> mkRecdFieldGetViaExprAddr (exprOfExprAddr cenv arg, rfref, tyargs, m) + | TOp.UnionCaseFieldGetAddr (uref, n, _), [arg], _ -> mkUnionCaseFieldGetProvenViaExprAddr (exprOfExprAddr cenv arg, uref, tyargs, n, m) + | TOp.ILAsm ([ I_ldflda fspec ], rtys), [arg], _ -> mkAsmExpr ([ mkNormalLdfld fspec ], tyargs, [exprOfExprAddr cenv arg], rtys, m) + | TOp.ILAsm ([ I_ldsflda fspec ], rtys), _, _ -> mkAsmExpr ([ mkNormalLdsfld fspec ], tyargs, args, rtys, m) + | TOp.ILAsm (([ I_ldelema(_ro, _isNativePtr, shape, _tyarg) ] ), _), (arr::idxs), [elemty] -> match shape.Rank, idxs with | 1, [idx1] -> mkCallArrayGet cenv.g m elemty arr idx1 | 2, [idx1; idx2] -> mkCallArray2DGet cenv.g m elemty arr idx1 idx2 @@ -343,7 +347,7 @@ module FSharpExprConvert = match expr with // Large lists - | Expr.Op(TOp.UnionCase ucref, tyargs, [e1;e2], _) -> + | Expr.Op (TOp.UnionCase ucref, tyargs, [e1;e2], _) -> let mkR = ConvUnionCaseRef cenv ucref let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) let e1R = ConvExpr cenv env e1 @@ -354,7 +358,7 @@ module FSharpExprConvert = | Expr.Let (bind, body, _, _) -> match ConvLetBind cenv env bind with | None, env -> ConvExprPrimLinear cenv env body contf - | Some(bindR), env -> + | Some bindR, env -> // tail recursive ConvExprLinear cenv env body (contf << (fun bodyR -> E.Let(bindR, bodyR))) @@ -365,9 +369,9 @@ module FSharpExprConvert = // Put in ConvExprPrimLinear because of the overlap with Expr.Sequential below // // TODO: allow clients to see static initialization checks if they want to - | Expr.Sequential(ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) - | Expr.Sequential (StaticInitializationCount, x1, NormalSeq, _, _) - | Expr.Sequential (StaticInitializationCheck, x1, NormalSeq, _, _) -> + | Expr.Sequential (ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) + | Expr.Sequential (StaticInitializationCount, x1, NormalSeq, _, _) + | Expr.Sequential (StaticInitializationCheck, x1, NormalSeq, _, _) -> ConvExprPrim cenv env x1 |> contf // Large sequences of sequential code @@ -376,7 +380,7 @@ module FSharpExprConvert = // tail recursive ConvExprLinear cenv env e2 (contf << (fun e2R -> E.Sequential(e1R, e2R))) - | Expr.Sequential (x0, x1, ThenDoSeq, _, _) -> E.Sequential(ConvExpr cenv env x0, ConvExpr cenv env x1) + | Expr.Sequential (x0, x1, ThenDoSeq, _, _) -> E.Sequential(ConvExpr cenv env x0, ConvExpr cenv env x1) | ModuleValueOrMemberUse cenv.g (vref, vFlags, _f, _fty, tyargs, curriedArgs) when (nonNil tyargs || nonNil curriedArgs) && vref.IsMemberOrModuleBinding -> ConvModuleValueOrMemberUseLinear cenv env (expr, vref, vFlags, tyargs, curriedArgs) contf @@ -395,7 +399,6 @@ module FSharpExprConvert = | _ -> ConvExprPrim cenv env expr |> contf - /// A nasty function copied from creflect.fs. Made nastier by taking a continuation to process the /// arguments to the call in a tail-recursive fashion. and ConvModuleValueOrMemberUseLinear (cenv: SymbolEnv) env (expr: Expr, vref, vFlags, tyargs, curriedArgs) contf = @@ -483,12 +486,12 @@ module FSharpExprConvert = match expr with // Uses of possibly-polymorphic values which were not polymorphic in the end - | Expr.App(InnerExprPat(Expr.Val _ as ve), _fty, [], [], _) -> + | Expr.App (InnerExprPat(Expr.Val _ as ve), _fty, [], [], _) -> ConvExprPrim cenv env ve // These cases are the start of a "linear" sequence where we use tail recursion to allow use to // deal with large expressions. - | Expr.Op(TOp.UnionCase _, _, [_;_], _) // big lists + | Expr.Op (TOp.UnionCase _, _, [_;_], _) // big lists | Expr.Let _ // big linear sequences of 'let' | Expr.Match _ // big linear sequences of 'match ... -> ....' | Expr.Sequential _ -> @@ -498,17 +501,17 @@ module FSharpExprConvert = // Process applications of top-level values in a tail-recursive way ConvModuleValueOrMemberUseLinear cenv env (expr, vref, vFlags, tyargs, curriedArgs) (fun e -> e) - | Expr.Val(vref, _vFlags, m) -> + | Expr.Val (vref, _vFlags, m) -> ConvValRef cenv env m vref // Simple applications - | Expr.App(f, _fty, tyargs, args, _m) -> + | Expr.App (f, _fty, tyargs, args, _m) -> E.Application (ConvExpr cenv env f, ConvTypes cenv tyargs, ConvExprs cenv env args) - | Expr.Const(c, m, ty) -> + | Expr.Const (c, m, ty) -> ConvConst cenv env m c ty - | Expr.LetRec(binds, body, _, _) -> + | Expr.LetRec (binds, body, _, _) -> let vs = valsOfBinds binds let vsR = vs |> List.map (ConvVal cenv) let env = env.BindVals vs @@ -516,13 +519,13 @@ module FSharpExprConvert = let bindsR = List.zip vsR (binds |> List.map (fun b -> b.Expr |> ConvExpr cenv env)) E.LetRec(bindsR, bodyR) - | Expr.Lambda(_, _, _, vs, b, _, _) -> + | Expr.Lambda (_, _, _, vs, b, _, _) -> let v, b = MultiLambdaToTupledLambda cenv.g vs b let vR = ConvVal cenv v let bR = ConvExpr cenv (env.BindVal v) b E.Lambda(vR, bR) - | Expr.Quote(ast, _, _, _, _) -> + | Expr.Quote (ast, _, _, _, _) -> E.Quote(ConvExpr cenv env ast) | Expr.TyLambda (_, tps, b, _, _) -> @@ -558,7 +561,7 @@ module FSharpExprConvert = E.ObjectExpr(ConvType cenv ty, basecallR, overridesR, iimplsR) - | Expr.Op(op, tyargs, args, m) -> + | Expr.Op (op, tyargs, args, m) -> match op, tyargs, args with | TOp.UnionCase ucref, _, _ -> let mkR = ConvUnionCaseRef cenv ucref @@ -603,42 +606,42 @@ module FSharpExprConvert = | TOp.ValFieldGetAddr _, _tyargs, _ -> E.AddressOf(ConvLValueExpr cenv env expr) - | TOp.ValFieldGet(rfref), tyargs, [] -> + | TOp.ValFieldGet rfref, tyargs, [] -> let projR = ConvRecdFieldRef cenv rfref let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) E.FSharpFieldGet(None, typR, projR) - | TOp.ValFieldGet(rfref), tyargs, [obj] -> + | TOp.ValFieldGet rfref, tyargs, [obj] -> let objR = ConvLValueExpr cenv env obj let projR = ConvRecdFieldRef cenv rfref let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) E.FSharpFieldGet(Some objR, typR, projR) - | TOp.TupleFieldGet(tupInfo, n), tyargs, [e] -> + | TOp.TupleFieldGet (tupInfo, n), tyargs, [e] -> let tyR = ConvType cenv (mkAnyTupledTy cenv.g tupInfo tyargs) E.TupleGet(tyR, n, ConvExpr cenv env e) - | TOp.ILAsm([ I_ldfld(_, _, fspec) ], _), enclTypeArgs, [obj] -> + | TOp.ILAsm ([ I_ldfld (_, _, fspec) ], _), enclTypeArgs, [obj] -> let typR = ConvILTypeRefApp cenv m fspec.DeclaringTypeRef enclTypeArgs let objR = ConvLValueExpr cenv env obj E.ILFieldGet(Some objR, typR, fspec.Name) - | TOp.ILAsm(( [ I_ldsfld (_, fspec) ] | [ I_ldsfld (_, fspec); AI_nop ]), _), enclTypeArgs, [] -> + | TOp.ILAsm (( [ I_ldsfld (_, fspec) ] | [ I_ldsfld (_, fspec); AI_nop ]), _), enclTypeArgs, [] -> let typR = ConvILTypeRefApp cenv m fspec.DeclaringTypeRef enclTypeArgs E.ILFieldGet(None, typR, fspec.Name) - | TOp.ILAsm([ I_stfld(_, _, fspec) ], _), enclTypeArgs, [obj;arg] -> + | TOp.ILAsm ([ I_stfld (_, _, fspec) ], _), enclTypeArgs, [obj;arg] -> let typR = ConvILTypeRefApp cenv m fspec.DeclaringTypeRef enclTypeArgs let objR = ConvLValueExpr cenv env obj let argR = ConvExpr cenv env arg E.ILFieldSet(Some objR, typR, fspec.Name, argR) - | TOp.ILAsm([ I_stsfld(_, fspec) ], _), enclTypeArgs, [arg] -> + | TOp.ILAsm ([ I_stsfld (_, fspec) ], _), enclTypeArgs, [arg] -> let typR = ConvILTypeRefApp cenv m fspec.DeclaringTypeRef enclTypeArgs let argR = ConvExpr cenv env arg E.ILFieldSet(None, typR, fspec.Name, argR) - | TOp.ILAsm([ ], [tty]), _, [arg] -> + | TOp.ILAsm ([ ], [tty]), _, [arg] -> match tty with | TTypeConvOp cenv convOp -> let ty = tyOfExpr cenv.g arg @@ -647,15 +650,15 @@ module FSharpExprConvert = | _ -> ConvExprPrim cenv env arg - | TOp.ILAsm([ I_box _ ], _), [ty], [arg] -> + | TOp.ILAsm ([ I_box _ ], _), [ty], [arg] -> let op = mkCallBox cenv.g m ty arg ConvExprPrim cenv env op - | TOp.ILAsm([ I_unbox_any _ ], _), [ty], [arg] -> + | TOp.ILAsm ([ I_unbox_any _ ], _), [ty], [arg] -> let op = mkCallUnbox cenv.g m ty arg ConvExprPrim cenv env op - | TOp.ILAsm([ I_isinst _ ], _), [ty], [arg] -> + | TOp.ILAsm ([ I_isinst _ ], _), [ty], [arg] -> let op = mkCallTypeTest cenv.g m ty arg ConvExprPrim cenv env op @@ -665,56 +668,56 @@ module FSharpExprConvert = let op = mkCallHash cenv.g m ty arg ConvExprPrim cenv env op - | TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), [], - [Expr.Op(TOp.ILAsm([ I_ldtoken (ILToken.ILType _) ], _), [ty], _, _)] + | TOp.ILCall (_, _, _, _, _, _, _, mref, _, _, _), [], + [Expr.Op (TOp.ILAsm ([ I_ldtoken (ILToken.ILType _) ], _), [ty], _, _)] when mref.DeclaringTypeRef.Name = "System.Type" && mref.Name = "GetTypeFromHandle" -> let op = mkCallTypeOf cenv.g m ty ConvExprPrim cenv env op - | TOp.ILAsm([ EI_ilzero _ ], _), [ty], _ -> + | TOp.ILAsm ([ EI_ilzero _ ], _), [ty], _ -> E.DefaultValue (ConvType cenv ty) - | TOp.ILAsm([ AI_ldnull; AI_cgt_un ], _), _, [arg] -> + | TOp.ILAsm ([ AI_ldnull; AI_cgt_un ], _), _, [arg] -> let elemTy = tyOfExpr cenv.g arg let nullVal = mkNull m elemTy let op = mkCallNotEqualsOperator cenv.g m elemTy arg nullVal ConvExprPrim cenv env op - | TOp.ILAsm([ I_ldlen; AI_conv DT_I4 ], _), _, [arr] -> + | TOp.ILAsm ([ I_ldlen; AI_conv DT_I4 ], _), _, [arr] -> let arrayTy = tyOfExpr cenv.g arr let elemTy = destArrayTy cenv.g arrayTy let op = mkCallArrayLength cenv.g m elemTy arr ConvExprPrim cenv env op - | TOp.ILAsm([ I_newarr (ILArrayShape [(Some 0, None)], _)], _), [elemTy], xa -> + | TOp.ILAsm ([ I_newarr (ILArrayShape [(Some 0, None)], _)], _), [elemTy], xa -> E.NewArray(ConvType cenv elemTy, ConvExprs cenv env xa) - | TOp.ILAsm([ I_ldelem_any (ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx1] -> + | TOp.ILAsm ([ I_ldelem_any (ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx1] -> let op = mkCallArrayGet cenv.g m elemTy arr idx1 ConvExprPrim cenv env op - | TOp.ILAsm([ I_stelem_any (ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx1; v] -> + | TOp.ILAsm ([ I_stelem_any (ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx1; v] -> let op = mkCallArraySet cenv.g m elemTy arr idx1 v ConvExprPrim cenv env op - | TOp.ILAsm([ ILUnaryOp unaryOp ], _), _, [arg] -> + | TOp.ILAsm ([ ILUnaryOp unaryOp ], _), _, [arg] -> let ty = tyOfExpr cenv.g arg let op = unaryOp cenv.g m ty arg ConvExprPrim cenv env op - | TOp.ILAsm([ ILBinaryOp binaryOp ], _), _, [arg1;arg2] -> + | TOp.ILAsm ([ ILBinaryOp binaryOp ], _), _, [arg1;arg2] -> let ty = tyOfExpr cenv.g arg1 let op = binaryOp cenv.g m ty arg1 arg2 ConvExprPrim cenv env op - | TOp.ILAsm([ ILConvertOp convertOp1; ILConvertOp convertOp2 ], _), _, [arg] -> + | TOp.ILAsm ([ ILConvertOp convertOp1; ILConvertOp convertOp2 ], _), _, [arg] -> let ty1 = tyOfExpr cenv.g arg let op1 = convertOp1 cenv.g m ty1 arg let ty2 = tyOfExpr cenv.g op1 let op2 = convertOp2 cenv.g m ty2 op1 ConvExprPrim cenv env op2 - | TOp.ILAsm([ ILConvertOp convertOp ], [TType_app (tcref,_)]), _, [arg] -> + | TOp.ILAsm ([ ILConvertOp convertOp ], [TType_app (tcref,_)]), _, [arg] -> let ty = tyOfExpr cenv.g arg let op = if tyconRefEq cenv.g tcref cenv.g.char_tcr @@ -722,11 +725,11 @@ module FSharpExprConvert = else convertOp cenv.g m ty arg ConvExprPrim cenv env op - | TOp.ILAsm([ I_throw ], _), _, [arg1] -> + | TOp.ILAsm ([ I_throw ], _), _, [arg1] -> let raiseExpr = mkCallRaise cenv.g m (tyOfExpr cenv.g expr) arg1 ConvExprPrim cenv env raiseExpr - | TOp.ILAsm(il, _), tyargs, args -> + | TOp.ILAsm (il, _), tyargs, args -> E.ILAsm(sprintf "%+A" il, ConvTypes cenv tyargs, ConvExprs cenv env args) | TOp.ExnConstr tcref, tyargs, args -> @@ -745,7 +748,7 @@ module FSharpExprConvert = let projR = ConvRecdFieldRef cenv rfref E.FSharpFieldSet(None, typR, projR, argR) - | TOp.ExnFieldGet(tcref, i), [], [obj] -> + | TOp.ExnFieldGet (tcref, i), [], [obj] -> let exnc = stripExnEqns tcref let fspec = exnc.TrueInstanceFieldsAsList.[i] let fref = mkRecdFieldRef tcref fspec.Name @@ -753,7 +756,7 @@ module FSharpExprConvert = let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkAppTy tcref [], m, cenv.g.exn_ty)) E.FSharpFieldGet(Some objR, typR, ConvRecdFieldRef cenv fref) - | TOp.ExnFieldSet(tcref, i), [], [obj;e2] -> + | TOp.ExnFieldSet (tcref, i), [], [obj;e2] -> let exnc = stripExnEqns tcref let fspec = exnc.TrueInstanceFieldsAsList.[i] let fref = mkRecdFieldRef tcref fspec.Name @@ -771,44 +774,44 @@ module FSharpExprConvert = // rebuild reraise() and Convert mkReraiseLibCall cenv.g toTy m |> ConvExprPrim cenv env - | TOp.LValueOp(LAddrOf _, vref), [], [] -> + | TOp.LValueOp (LAddrOf _, vref), [], [] -> E.AddressOf(ConvExpr cenv env (exprForValRef m vref)) - | TOp.LValueOp(LByrefSet, vref), [], [e] -> + | TOp.LValueOp (LByrefSet, vref), [], [e] -> E.AddressSet(ConvExpr cenv env (exprForValRef m vref), ConvExpr cenv env e) - | TOp.LValueOp(LSet, vref), [], [e] -> + | TOp.LValueOp (LSet, vref), [], [e] -> E.ValueSet(FSharpMemberOrFunctionOrValue(cenv, vref), ConvExpr cenv env e) - | TOp.LValueOp(LByrefGet, vref), [], [] -> + | TOp.LValueOp (LByrefGet, vref), [], [] -> ConvValRef cenv env m vref | TOp.Array, [ty], xa -> E.NewArray(ConvType cenv ty, ConvExprs cenv env xa) - | TOp.While _, [], [Expr.Lambda(_, _, _, [_], test, _, _);Expr.Lambda(_, _, _, [_], body, _, _)] -> + | TOp.While _, [], [Expr.Lambda (_, _, _, [_], test, _, _);Expr.Lambda (_, _, _, [_], body, _, _)] -> E.WhileLoop(ConvExpr cenv env test, ConvExpr cenv env body) - | TOp.For(_, dir), [], [Expr.Lambda(_, _, _, [_], lim0, _, _); Expr.Lambda(_, _, _, [_], SimpleArrayLoopUpperBound, lm, _); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> + | TOp.For (_, dir), [], [Expr.Lambda (_, _, _, [_], lim0, _, _); Expr.Lambda (_, _, _, [_], SimpleArrayLoopUpperBound, lm, _); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> let lim1 = let len = mkCallArrayLength cenv.g lm elemTy arr // Array.length arr mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty len (mkOne cenv.g lm) // len - 1 E.FastIntegerForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body, dir <> FSharpForLoopDown) - | TOp.For(_, dir), [], [Expr.Lambda(_, _, _, [_], lim0, _, _); Expr.Lambda(_, _, _, [_], lim1, lm, _); body] -> + | TOp.For (_, dir), [], [Expr.Lambda (_, _, _, [_], lim0, _, _); Expr.Lambda (_, _, _, [_], lim1, lm, _); body] -> let lim1 = if dir = CSharpForLoopUp then mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty lim1 (mkOne cenv.g lm) // len - 1 else lim1 E.FastIntegerForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body, dir <> FSharpForLoopDown) - | TOp.ILCall(_, _, _, isNewObj, valUseFlags, _isProp, _, ilMethRef, enclTypeArgs, methTypeArgs, _tys), [], callArgs -> + | TOp.ILCall (_, _, _, isNewObj, valUseFlags, _isProp, _, ilMethRef, enclTypeArgs, methTypeArgs, _tys), [], callArgs -> ConvILCall cenv env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) - | TOp.TryFinally _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> + | TOp.TryFinally _, [_resty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)] -> E.TryFinally(ConvExpr cenv env e1, ConvExpr cenv env e2) - | TOp.TryCatch _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [vf], ef, _, _); Expr.Lambda(_, _, _, [vh], eh, _, _)] -> + | TOp.TryCatch _, [_resty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [vf], ef, _, _); Expr.Lambda (_, _, _, [vh], eh, _, _)] -> let vfR = ConvVal cenv vf let envf = env.BindVal vf let vhR = ConvVal cenv vh @@ -848,7 +851,7 @@ module FSharpExprConvert = // 'if istype e then ...unbox e .... ' // It's bit annoying that pattern matching does this tranformation. Like all premature optimization we pay a // cost here to undo it. - | Expr.Op(TOp.ILAsm([ I_isinst _ ], _), [ty], [e], _) -> + | Expr.Op (TOp.ILAsm ([ I_isinst _ ], _), [ty], [e], _) -> None, env.BindIsInstVal bind.Var (ty, e) // Remove let = from quotation tree @@ -856,11 +859,11 @@ module FSharpExprConvert = None, env.BindSubstVal bind.Var bind.Expr // Remove let = () from quotation tree - | Expr.Const(Const.Unit, _, _) when bind.Var.IsCompilerGenerated -> + | Expr.Const (Const.Unit, _, _) when bind.Var.IsCompilerGenerated -> None, env.BindSubstVal bind.Var bind.Expr // Remove let unionCase = ... from quotation tree - | Expr.Op(TOp.UnionCaseProof _, _, [e], _) -> + | Expr.Op (TOp.UnionCaseProof _, _, [e], _) -> None, env.BindSubstVal bind.Var e | _ -> @@ -973,12 +976,12 @@ module FSharpExprConvert = let objR = ConvExpr cenv env callArgs.Head E.UnionCaseTag(objR, typR) elif vName.StartsWithOrdinal("New") then - let name = vName.Substring(3) + let name = vName.Substring 3 let mkR = ConvUnionCaseRef cenv (UCRef(tcref, name)) let argsR = ConvExprs cenv env callArgs E.NewUnionCase(typR, mkR, argsR) elif vName.StartsWithOrdinal("Is") then - let name = vName.Substring(2) + let name = vName.Substring 2 let mkR = ConvUnionCaseRef cenv (UCRef(tcref, name)) let objR = ConvExpr cenv env callArgs.Head E.UnionCaseTest(objR, typR, mkR) @@ -1040,7 +1043,7 @@ module FSharpExprConvert = let isCtor = (ilMethRef.Name = ".ctor") let isStatic = isCtor || ilMethRef.CallingConv.IsStatic let scoref = ilMethRef.DeclaringTypeRef.Scope - let typars1 = tcref.Typars(m) + let typars1 = tcref.Typars m let typars2 = [ 1 .. ilMethRef.GenericArity ] |> List.map (fun _ -> NewRigidTypar "T" m) let tinst1 = typars1 |> generalizeTypars let tinst2 = typars2 |> generalizeTypars @@ -1188,7 +1191,7 @@ module FSharpExprConvert = | DecisionTreeTest.IsNull -> // Decompile cached isinst tests match e1 with - | Expr.Val(vref, _, _) when env.isinstVals.ContainsVal vref.Deref -> + | Expr.Val (vref, _, _) when env.isinstVals.ContainsVal vref.Deref -> let (ty, e) = env.isinstVals.[vref.Deref] let tyR = ConvType cenv ty let eR = ConvExpr cenv env e @@ -1216,7 +1219,7 @@ module FSharpExprConvert = // The binding may be a compiler-generated binding that gets removed in the quotation presentation match ConvLetBind cenv env bind with | None, env -> ConvDecisionTreePrim cenv env dtreeRetTy rest - | Some(bindR), env -> E.Let(bindR, ConvDecisionTree cenv env dtreeRetTy rest bind.Var.Range) + | Some bindR, env -> E.Let(bindR, ConvDecisionTree cenv env dtreeRetTy rest bind.Var.Range) /// Wrap the conversion in a function to make it on-demand. Any pattern matching on the FSharpExpr will /// force the evaluation of the entire conversion process eagerly. @@ -1265,15 +1268,15 @@ and FSharpImplementationFileContents(cenv, mimpl) = | ModuleOrNamespaceBinding.Module(mspec, def) -> let entity = FSharpEntity(cenv, mkLocalEntityRef mspec) yield FSharpImplementationFileDeclaration.Entity (entity, getDecls def) - | ModuleOrNamespaceBinding.Binding(bind) -> + | ModuleOrNamespaceBinding.Binding bind -> yield getBind bind ] - | TMAbstract(mexpr) -> getDecls2 mexpr + | TMAbstract mexpr -> getDecls2 mexpr | TMDefLet(bind, _m) -> [ yield getBind bind ] | TMDefDo(expr, _m) -> [ let expr = FSharpExprConvert.ConvExprOnDemand cenv ExprTranslationEnv.Empty expr - yield FSharpImplementationFileDeclaration.InitAction(expr) ] - | TMDefs(mdefs) -> + yield FSharpImplementationFileDeclaration.InitAction expr ] + | TMDefs mdefs -> [ for mdef in mdefs do yield! getDecls mdef ] member __.QualifiedName = qname.Text @@ -1284,7 +1287,7 @@ and FSharpImplementationFileContents(cenv, mimpl) = module BasicPatterns = - let (|Value|_|) (e: FSharpExpr) = match e.E with E.Value (v) -> Some (v) | _ -> None + let (|Value|_|) (e: FSharpExpr) = match e.E with E.Value v -> Some v | _ -> None let (|Const|_|) (e: FSharpExpr) = match e.E with E.Const (v, ty) -> Some (v, ty) | _ -> None let (|TypeLambda|_|) (e: FSharpExpr) = match e.E with E.TypeLambda (v, e) -> Some (v, e) | _ -> None let (|Lambda|_|) (e: FSharpExpr) = match e.E with E.Lambda (v, e) -> Some (v, e) | _ -> None @@ -1307,7 +1310,7 @@ module BasicPatterns = let (|UnionCaseTest|_|) (e: FSharpExpr) = match e.E with E.UnionCaseTest (a, b, c) -> Some (a, b, c) | _ -> None let (|NewArray|_|) (e: FSharpExpr) = match e.E with E.NewArray (a, b) -> Some (a, b) | _ -> None let (|Coerce|_|) (e: FSharpExpr) = match e.E with E.Coerce (a, b) -> Some (a, b) | _ -> None - let (|Quote|_|) (e: FSharpExpr) = match e.E with E.Quote (a) -> Some (a) | _ -> None + let (|Quote|_|) (e: FSharpExpr) = match e.E with E.Quote a -> Some a | _ -> None let (|TypeTest|_|) (e: FSharpExpr) = match e.E with E.TypeTest (a, b) -> Some (a, b) | _ -> None let (|Sequential|_|) (e: FSharpExpr) = match e.E with E.Sequential (a, b) -> Some (a, b) | _ -> None let (|FastIntegerForLoop|_|) (e: FSharpExpr) = match e.E with E.FastIntegerForLoop (a, b, c, d) -> Some (a, b, c, d) | _ -> None @@ -1315,12 +1318,12 @@ module BasicPatterns = let (|TryFinally|_|) (e: FSharpExpr) = match e.E with E.TryFinally (a, b) -> Some (a, b) | _ -> None let (|TryWith|_|) (e: FSharpExpr) = match e.E with E.TryWith (a, b, c, d, e) -> Some (a, b, c, d, e) | _ -> None let (|NewDelegate|_|) (e: FSharpExpr) = match e.E with E.NewDelegate (ty, e) -> Some (ty, e) | _ -> None - let (|DefaultValue|_|) (e: FSharpExpr) = match e.E with E.DefaultValue (ty) -> Some (ty) | _ -> None + let (|DefaultValue|_|) (e: FSharpExpr) = match e.E with E.DefaultValue ty -> Some ty | _ -> None let (|AddressSet|_|) (e: FSharpExpr) = match e.E with E.AddressSet (a, b) -> Some (a, b) | _ -> None let (|ValueSet|_|) (e: FSharpExpr) = match e.E with E.ValueSet (a, b) -> Some (a, b) | _ -> None - let (|AddressOf|_|) (e: FSharpExpr) = match e.E with E.AddressOf (a) -> Some (a) | _ -> None - let (|ThisValue|_|) (e: FSharpExpr) = match e.E with E.ThisValue (a) -> Some (a) | _ -> None - let (|BaseValue|_|) (e: FSharpExpr) = match e.E with E.BaseValue (a) -> Some (a) | _ -> None + let (|AddressOf|_|) (e: FSharpExpr) = match e.E with E.AddressOf a -> Some a | _ -> None + let (|ThisValue|_|) (e: FSharpExpr) = match e.E with E.ThisValue a -> Some a | _ -> None + let (|BaseValue|_|) (e: FSharpExpr) = match e.E with E.BaseValue a -> Some a | _ -> None let (|ILAsm|_|) (e: FSharpExpr) = match e.E with E.ILAsm (a, b, c) -> Some (a, b, c) | _ -> None let (|ILFieldGet|_|) (e: FSharpExpr) = match e.E with E.ILFieldGet (a, b, c) -> Some (a, b, c) | _ -> None let (|ILFieldSet|_|) (e: FSharpExpr) = match e.E with E.ILFieldSet (a, b, c, d) -> Some (a, b, c, d) | _ -> None diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 943337a7d..5e04544c2 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -55,8 +55,8 @@ type FSharpErrorInfo(fileName, s: pos, e: pos, severity: FSharpErrorSeverity, me member __.Subcategory = subcategory member __.FileName = fileName member __.ErrorNumber = errorNum - member __.WithStart(newStart) = FSharpErrorInfo(fileName, newStart, e, severity, message, subcategory, errorNum) - member __.WithEnd(newEnd) = FSharpErrorInfo(fileName, s, newEnd, severity, message, subcategory, errorNum) + member __.WithStart newStart = FSharpErrorInfo(fileName, newStart, e, severity, message, subcategory, errorNum) + member __.WithEnd newEnd = FSharpErrorInfo(fileName, s, newEnd, severity, message, subcategory, errorNum) override __.ToString()= sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName (int s.Line) (s.Column + 1) (int e.Line) (e.Column + 1) subcategory (if severity=FSharpErrorSeverity.Warning then "warning" else "error") message /// Decompose a warning or error into parts: position, severity, message, error number @@ -253,17 +253,17 @@ module Tooltips = match tooltip with | FSharpStructuredToolTipElement.None -> FSharpToolTipElement.None - | FSharpStructuredToolTipElement.Group(l) -> + | FSharpStructuredToolTipElement.Group l -> FSharpToolTipElement.Group(l |> List.map(fun x -> { MainDescription=showL x.MainDescription XmlDoc=x.XmlDoc TypeMapping=List.map showL x.TypeMapping ParamName=x.ParamName Remarks= Option.map showL x.Remarks })) - | FSharpStructuredToolTipElement.CompositionError(text) -> - FSharpToolTipElement.CompositionError(text) + | FSharpStructuredToolTipElement.CompositionError text -> + FSharpToolTipElement.CompositionError text - let ToFSharpToolTipText (FSharpStructuredToolTipText.FSharpToolTipText(text)) = + let ToFSharpToolTipText (FSharpStructuredToolTipText.FSharpToolTipText text) = FSharpToolTipText(List.map ToFSharpToolTipElement text) let Map f a = async.Bind(a, f >> async.Return) @@ -369,7 +369,7 @@ module internal SymbolHelpers = | Item.Types(_, tys) -> tys |> List.tryPick (tryNiceEntityRefOfTyOption >> Option.map (rangeOfEntityRef preferFlag)) | Item.CustomOperation (_, _, Some minfo) -> rangeOfMethInfo g preferFlag minfo | Item.TypeVar (_, tp) -> Some tp.Range - | Item.ModuleOrNamespaces(modrefs) -> modrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) + | Item.ModuleOrNamespaces modrefs -> modrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) | Item.MethodGroup(_, minfos, _) | Item.CtorGroup(_, minfos) -> minfos |> List.tryPick (rangeOfMethInfo g preferFlag) | Item.ActivePatternResult(APInfo _, _, _, m) -> Some m @@ -424,8 +424,8 @@ module internal SymbolHelpers = | Item.ArgName (_, _, Some (ArgumentContainer.Type eref)) -> computeCcuOfTyconRef eref - | Item.ModuleOrNamespaces(erefs) - | Item.UnqualifiedType(erefs) -> erefs |> List.tryPick computeCcuOfTyconRef + | Item.ModuleOrNamespaces erefs + | Item.UnqualifiedType erefs -> erefs |> List.tryPick computeCcuOfTyconRef | Item.SetterArg (_, item) -> ccuOfItem g item | Item.AnonRecdField (info, _, _, _) -> Some info.Assembly @@ -474,7 +474,7 @@ module internal SymbolHelpers = | ERefLocal _ -> None | ERefNonLocal nlref -> // Generalize to get a formal signature - let formalTypars = tcref.Typars(m) + let formalTypars = tcref.Typars m let formalTypeInst = generalizeTypars formalTypars let ty = TType_app(tcref, formalTypeInst) if isILAppTy g ty then @@ -484,7 +484,7 @@ module internal SymbolHelpers = let mkXmlComment thing = match thing with - | Some (Some(fileName), xmlDocSig) -> FSharpXmlDoc.XmlDocFileSignature(fileName, xmlDocSig) + | Some (Some fileName, xmlDocSig) -> FSharpXmlDoc.XmlDocFileSignature(fileName, xmlDocSig) | _ -> FSharpXmlDoc.None let GetXmlDocSigOfEntityRef infoReader m (eref: EntityRef) = @@ -619,7 +619,7 @@ module internal SymbolHelpers = | Item.ModuleOrNamespaces(modref :: _) -> mkXmlComment (GetXmlDocSigOfEntityRef infoReader m modref) | Item.Property(_, (pinfo :: _)) -> mkXmlComment (GetXmlDocSigOfProp infoReader m pinfo) - | Item.Event(einfo) -> mkXmlComment (GetXmlDocSigOfEvent infoReader m einfo) + | Item.Event einfo -> mkXmlComment (GetXmlDocSigOfEvent infoReader m einfo) | Item.MethodGroup(_, minfo :: _, _) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) | Item.CtorGroup(_, minfo :: _) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) @@ -673,7 +673,7 @@ module internal SymbolHelpers = let tpsL = FormatTyparMapping denv prettyTyparInst FSharpToolTipElementData<_>.Create(layout, xml, tpsL) ] - FSharpStructuredToolTipElement.Group(layouts) + FSharpStructuredToolTipElement.Group layouts let pubpathOfValRef (v: ValRef) = v.PublicPath @@ -731,15 +731,15 @@ module internal SymbolHelpers = // Much of this logic is already covered by 'ItemsAreEffectivelyEqual' match item1, item2 with - | Item.DelegateCtor(ty1), Item.DelegateCtor(ty2) -> equalHeadTypes(ty1, ty2) + | Item.DelegateCtor ty1, Item.DelegateCtor ty2 -> equalHeadTypes(ty1, ty2) | Item.Types(dn1, [ty1]), Item.Types(dn2, [ty2]) -> // Bug 4403: We need to compare names as well, because 'int' and 'Int32' are physically the same type, but we want to show both dn1 = dn2 && equalHeadTypes(ty1, ty2) // Prefer a type to a DefaultStructCtor, a DelegateCtor and a FakeInterfaceCtor - | ItemWhereTypIsPreferred(ty1), ItemWhereTypIsPreferred(ty2) -> equalHeadTypes(ty1, ty2) + | ItemWhereTypIsPreferred ty1, ItemWhereTypIsPreferred ty2 -> equalHeadTypes(ty1, ty2) - | Item.ExnCase(tcref1), Item.ExnCase(tcref2) -> tyconRefEq g tcref1 tcref2 + | Item.ExnCase tcref1, Item.ExnCase tcref2 -> tyconRefEq g tcref1 tcref2 | Item.ILField(ILFieldInfo(_, fld1)), Item.ILField(ILFieldInfo(_, fld2)) -> fld1 === fld2 // reference equality on the object identity of the AbstractIL metadata blobs for the fields | Item.CustomOperation (_, _, Some minfo1), Item.CustomOperation (_, _, Some minfo2) -> @@ -761,14 +761,14 @@ module internal SymbolHelpers = (tyconRefEq g tcref1 tcref2) && (n1 = n2) // there is no direct function as in the previous case | Item.Property(_, pi1s), Item.Property(_, pi2s) -> List.zip pi1s pi2s |> List.forall(fun (pi1, pi2) -> PropInfo.PropInfosUseIdenticalDefinitions pi1 pi2) - | Item.Event(evt1), Item.Event(evt2) -> + | Item.Event evt1, Item.Event evt2 -> EventInfo.EventInfosUseIdenticalDefintions evt1 evt2 | Item.AnonRecdField(anon1, _, i1, _), Item.AnonRecdField(anon2, _, i2, _) -> Tastops.anonInfoEquiv anon1 anon2 && i1 = i2 | Item.CtorGroup(_, meths1), Item.CtorGroup(_, meths2) -> List.zip meths1 meths2 |> List.forall (fun (minfo1, minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) - | Item.UnqualifiedType(tcRefs1), Item.UnqualifiedType(tcRefs2) -> + | Item.UnqualifiedType tcRefs1, Item.UnqualifiedType tcRefs2 -> List.zip tcRefs1 tcRefs2 |> List.forall (fun (tcRef1, tcRef2) -> tyconRefEq g tcRef1 tcRef2) | Item.Types(_, [TType.TType_app(tcRef1, _)]), Item.UnqualifiedType([tcRef2]) -> tyconRefEq g tcRef1 tcRef2 @@ -782,7 +782,7 @@ module internal SymbolHelpers = match item with | ItemWhereTypIsPreferred ty -> match tryDestAppTy g ty with - | ValueSome tcref -> hash (tcref).LogicalName + | ValueSome tcref -> hash tcref.LogicalName | _ -> 1010 | Item.ILField(ILFieldInfo(_, fld)) -> System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode fld // hash on the object identity of the AbstractIL metadata blob for the field @@ -795,7 +795,7 @@ module internal SymbolHelpers = | Item.CtorGroup(name, meths) -> name.GetHashCode() + (meths |> List.fold (fun st a -> st + a.ComputeHashCode()) 0) | (Item.Value vref | Item.CustomBuilder (_, vref)) -> hash vref.LogicalName | Item.ActivePatternCase(APElemRef(_apinfo, vref, idx)) -> hash (vref.LogicalName, idx) - | Item.ExnCase(tcref) -> hash tcref.LogicalName + | Item.ExnCase tcref -> hash tcref.LogicalName | Item.UnionCase(UnionCaseInfo(_, UCRef(tcref, n)), _) -> hash(tcref.Stamp, n) | Item.RecdField(RecdFieldInfo(_, RFRef(tcref, n))) -> hash(tcref.Stamp, n) | Item.AnonRecdField(anon, _, i, _) -> hash anon.SortedNames.[i] @@ -810,7 +810,7 @@ module internal SymbolHelpers = { new IPartialEqualityComparer with member x.InEqualityRelation item = itemComparer.InEqualityRelation item.Item member x.Equals(item1, item2) = itemComparer.Equals(item1.Item, item2.Item) - member x.GetHashCode (item) = itemComparer.GetHashCode(item.Item) } + member x.GetHashCode item = itemComparer.GetHashCode(item.Item) } let ItemWithTypeDisplayPartialEquality g = let itemComparer = ItemDisplayPartialEquality g @@ -818,7 +818,7 @@ module internal SymbolHelpers = { new IPartialEqualityComparer with member x.InEqualityRelation ((item, _)) = itemComparer.InEqualityRelation item member x.Equals((item1, _), (item2, _)) = itemComparer.Equals(item1, item2) - member x.GetHashCode ((item, _)) = itemComparer.GetHashCode(item) } + member x.GetHashCode ((item, _)) = itemComparer.GetHashCode item } // Remove items containing the same module references let RemoveDuplicateModuleRefs modrefs = @@ -826,7 +826,7 @@ module internal SymbolHelpers = { new IPartialEqualityComparer with member x.InEqualityRelation _ = true member x.Equals(item1, item2) = (fullDisplayTextOfModRef item1 = fullDisplayTextOfModRef item2) - member x.GetHashCode(item) = hash item.Stamp } + member x.GetHashCode item = hash item.Stamp } /// Remove all duplicate items let RemoveDuplicateItems g (items: ItemWithInst list) = @@ -871,7 +871,7 @@ module internal SymbolHelpers = maxMembers=Some EnvMisc2.maxMembers } let rec FullNameOfItem g item = - let denv = DisplayEnv.Empty(g) + let denv = DisplayEnv.Empty g match item with | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) | Item.Value vref | Item.CustomBuilder (_, vref) -> fullDisplayTextOfValRef vref @@ -958,11 +958,11 @@ module internal SymbolHelpers = | Item.ArgName (_, _, argContainer) -> let xmldoc = match argContainer with - | Some(ArgumentContainer.Method (minfo)) -> + | Some(ArgumentContainer.Method minfo) -> if minfo.HasDirectXmlComment || minfo.XmlDoc.NonEmpty then Some minfo.XmlDoc else None - | Some(ArgumentContainer.Type(tcref)) -> + | Some(ArgumentContainer.Type tcref) -> if tyconRefUsesLocalXmlDoc g.compilingFslib tcref || tcref.XmlDoc.NonEmpty then Some tcref.XmlDoc else None - | Some(ArgumentContainer.UnionCase(ucinfo)) -> + | Some(ArgumentContainer.UnionCase ucinfo) -> if tyconRefUsesLocalXmlDoc g.compilingFslib ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None | _ -> None GetXmlCommentForItemAux xmldoc infoReader m item @@ -1270,7 +1270,7 @@ module internal SymbolHelpers = match tyconRef.TypeReprInfo with | TProvidedTypeExtensionPoint info -> info.ProvidedType | _ -> failwith "unreachable" - let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) + let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters provider), range=m) let staticParameters = staticParameters.PApplyArray(id, "GetStaticParameters", m) Some staticParameters else @@ -1459,7 +1459,7 @@ module internal SymbolHelpers = let FormatStructuredDescriptionOfItem isListItem infoReader m denv item = ErrorScope.Protect m (fun () -> FormatItemDescriptionToToolTipElement isListItem infoReader m denv item) - (fun err -> FSharpStructuredToolTipElement.CompositionError(err)) + (fun err -> FSharpStructuredToolTipElement.CompositionError err) /// Get rid of groups of overloads an replace them with single items. let FlattenItems g (m: range) item = @@ -1471,10 +1471,10 @@ module internal SymbolHelpers = | Item.NewDef _ | Item.ILField _ -> [] | Item.Event _ -> [] - | Item.RecdField(rfinfo) -> if isFunction g rfinfo.FieldType then [item] else [] + | Item.RecdField rfinfo -> if isFunction g rfinfo.FieldType then [item] else [] | Item.Value v -> if isFunction g v.Type then [item] else [] | Item.UnionCase(ucr, _) -> if not ucr.UnionCase.IsNullary then [item] else [] - | Item.ExnCase(ecr) -> if isNil (recdFieldsOfExnDefRef ecr) then [] else [item] + | Item.ExnCase ecr -> if isNil (recdFieldsOfExnDefRef ecr) then [] else [item] | Item.Property(_, pinfos) -> let pinfo = List.head pinfos if pinfo.IsIndexer then [item] else [] diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index e55e073e0..444302feb 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -73,7 +73,7 @@ module Impl = let makeReadOnlyCollection (arr: seq<'T>) = System.Collections.ObjectModel.ReadOnlyCollection<_>(Seq.toArray arr) :> IList<_> - let makeXmlDoc (XmlDoc x) = makeReadOnlyCollection (x) + let makeXmlDoc (XmlDoc x) = makeReadOnlyCollection x let rescopeEntity optViewedCcu (entity: Entity) = match optViewedCcu with @@ -90,7 +90,7 @@ module Impl = | _ -> false let checkEntityIsResolved(entity:EntityRef) = - if entityIsUnresolved(entity) then + if entityIsUnresolved entity then let poorQualifiedName = if entity.nlr.AssemblyName = "mscorlib" then entity.nlr.DisplayName + ", mscorlib" @@ -187,8 +187,8 @@ module Impl = | _ -> "" type FSharpDisplayContext(denv: TcGlobals -> DisplayEnv) = - member x.Contents(g) = denv(g) - static member Empty = FSharpDisplayContext(fun g -> DisplayEnv.Empty(g)) + member x.Contents g = denv g + static member Empty = FSharpDisplayContext(fun g -> DisplayEnv.Empty g) // delay the realization of 'item' in case it is unresolved @@ -206,12 +206,12 @@ type FSharpSymbol(cenv: SymbolEnv, item: (unit -> Item), access: (FSharpSymbol - member x.DeclarationLocation = SymbolHelpers.rangeOfItem cenv.g None x.Item - member x.ImplementationLocation = SymbolHelpers.rangeOfItem cenv.g (Some(false)) x.Item + member x.ImplementationLocation = SymbolHelpers.rangeOfItem cenv.g (Some false) x.Item - member x.SignatureLocation = SymbolHelpers.rangeOfItem cenv.g (Some(true)) x.Item + member x.SignatureLocation = SymbolHelpers.rangeOfItem cenv.g (Some true) x.Item member x.IsEffectivelySameAs(y:FSharpSymbol) = - x.Equals(y) || ItemsAreEffectivelyEqual cenv.g x.Item y.Item + x.Equals y || ItemsAreEffectivelyEqual cenv.g x.Item y.Item member x.GetEffectivelySameAsHash() = ItemsAreEffectivelyEqualHash cenv.g x.Item @@ -320,7 +320,7 @@ type FSharpSymbol(cenv: SymbolEnv, item: (unit -> Item), access: (FSharpSymbol - and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = inherit FSharpSymbol(cenv, (fun () -> - checkEntityIsResolved(entity) + checkEntityIsResolved entity if entity.IsModuleOrNamespace then Item.ModuleOrNamespaces [entity] else Item.UnqualifiedType [entity]), (fun _this thisCcu2 ad -> @@ -535,11 +535,11 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member __.Accessibility = - if isUnresolved() then FSharpAccessibility(taccessPublic) else + if isUnresolved() then FSharpAccessibility taccessPublic else FSharpAccessibility(getApproxFSharpAccessibilityOfEntity entity) member __.RepresentationAccessibility = - if isUnresolved() then FSharpAccessibility(taccessPublic) else + if isUnresolved() then FSharpAccessibility taccessPublic else FSharpAccessibility(entity.TypeReprAccessibility) member x.DeclaredInterfaces = @@ -641,7 +641,7 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = | TProvidedTypeExtensionPoint info -> let m = x.DeclarationLocation let typeBeforeArguments = info.ProvidedType - let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) + let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters provider), range=m) let staticParameters = staticParameters.PApplyArray(id, "GetStaticParameters", m) [| for p in staticParameters -> FSharpStaticParameter(cenv, p, m) |] #endif @@ -674,7 +674,7 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = let formalTypeInfo = ILTypeInfo.FromType cenv.g ty tdef.Fields.AsList |> List.map (fun tdef -> let ilFieldInfo = ILFieldInfo(formalTypeInfo, tdef) - FSharpField(cenv, FSharpFieldData.ILField(ilFieldInfo) )) + FSharpField(cenv, FSharpFieldData.ILField ilFieldInfo )) |> makeReadOnlyCollection else @@ -805,7 +805,7 @@ and FSharpUnionCase(cenv, v: UnionCaseRef) = v.Attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection member __.Accessibility = - if isUnresolved() then FSharpAccessibility(taccessPublic) else + if isUnresolved() then FSharpAccessibility taccessPublic else FSharpAccessibility(v.UnionCase.Accessibility) member private x.V = v @@ -830,7 +830,7 @@ and FSharpFieldData = match x with | AnonField (anonInfo, tinst, n, m) -> (anonInfo, tinst, n, m) |> Choice3Of3 | RecdOrClass v -> v.RecdField |> Choice1Of3 - | Union (v, n) -> v.FieldByIndex(n) |> Choice1Of3 + | Union (v, n) -> v.FieldByIndex n |> Choice1Of3 | ILField f -> f |> Choice2Of3 member x.TryDeclaringTyconRef = @@ -896,7 +896,7 @@ and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = new (cenv, ucref, n) = FSharpField(cenv, FSharpFieldData.Union(ucref, n)) - new (cenv, rfref) = FSharpField(cenv, FSharpFieldData.RecdOrClass(rfref)) + new (cenv, rfref) = FSharpField(cenv, FSharpFieldData.RecdOrClass rfref) member __.DeclaringEntity = d.TryDeclaringTyconRef |> Option.map (fun tcref -> FSharpEntity(cenv, tcref)) @@ -1034,13 +1034,13 @@ and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = |> makeReadOnlyCollection member __.Accessibility: FSharpAccessibility = - if isUnresolved() then FSharpAccessibility(taccessPublic) else + if isUnresolved() then FSharpAccessibility taccessPublic else let access = match d.TryRecdField with | Choice1Of3 r -> r.Accessibility | Choice2Of3 _ -> taccessPublic | Choice3Of3 _ -> taccessPublic - FSharpAccessibility(access) + FSharpAccessibility access member private x.V = d @@ -1932,7 +1932,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = /// How visible is this? member this.Accessibility: FSharpAccessibility = - if isUnresolved() then FSharpAccessibility(taccessPublic) else + if isUnresolved() then FSharpAccessibility taccessPublic else match fsharpInfo() with | Some v -> FSharpAccessibility(v.Accessibility) | None -> @@ -1948,7 +1948,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = getApproxFSharpAccessibilityOfMember this.DeclaringEntity.Value.Entity ilAccess | _ -> taccessPublic - FSharpAccessibility(access) + FSharpAccessibility access | P p -> // For IL properties, we get an approximate accessiblity that at least reports "internal" as "internal" and "private" as "private" @@ -1959,7 +1959,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = getApproxFSharpAccessibilityOfMember this.DeclaringEntity.Value.Entity ilAccess | _ -> taccessPublic - FSharpAccessibility(access) + FSharpAccessibility access | M m | C m -> @@ -2160,7 +2160,7 @@ and FSharpType(cenv, ty:TType) = member private x.V = ty member private x.cenv = cenv - member private ty.AdjustType(t) = + member private ty.AdjustType t = FSharpType(ty.cenv, t) // Note: This equivalence relation is modulo type abbreviations @@ -2208,12 +2208,12 @@ and FSharpType(cenv, ty:TType) = | h :: _ -> let cenv = h.cenv let prettyTys = PrettyTypes.PrettifyTypes cenv.g [ for t in xs -> t.V ] |> fst - (xs, prettyTys) ||> List.map2 (fun p pty -> p.AdjustType(pty)) + (xs, prettyTys) ||> List.map2 (fun p pty -> p.AdjustType pty) |> makeReadOnlyCollection static member Prettify(parameter: FSharpParameter) = let prettyTy = parameter.V |> PrettyTypes.PrettifyType parameter.cenv.g |> fst - parameter.AdjustType(prettyTy) + parameter.AdjustType prettyTy static member Prettify(parameters: IList) = let parameters = parameters |> List.ofSeq @@ -2222,7 +2222,7 @@ and FSharpType(cenv, ty:TType) = | h :: _ -> let cenv = h.cenv let prettyTys = parameters |> List.map (fun p -> p.V) |> PrettyTypes.PrettifyTypes cenv.g |> fst - (parameters, prettyTys) ||> List.map2 (fun p pty -> p.AdjustType(pty)) + (parameters, prettyTys) ||> List.map2 (fun p pty -> p.AdjustType pty) |> makeReadOnlyCollection static member Prettify(parameters: IList>) = @@ -2233,15 +2233,15 @@ and FSharpType(cenv, ty:TType) = | Some h -> let cenv = h.cenv let prettyTys = xs |> List.mapSquared (fun p -> p.V) |> PrettyTypes.PrettifyCurriedTypes cenv.g |> fst - (xs, prettyTys) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty))) + (xs, prettyTys) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType pty)) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection static member Prettify(parameters: IList>, returnParameter: FSharpParameter) = let xs = parameters |> List.ofSeq |> List.map List.ofSeq let cenv = returnParameter.cenv let prettyTys, prettyRetTy = xs |> List.mapSquared (fun p -> p.V) |> (fun tys -> PrettyTypes.PrettifyCurriedSigTypes cenv.g (tys, returnParameter.V) )|> fst - let ps = (xs, prettyTys) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty))) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection - ps, returnParameter.AdjustType(prettyRetTy) + let ps = (xs, prettyTys) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType pty)) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection + ps, returnParameter.AdjustType prettyRetTy and FSharpAttribute(cenv: SymbolEnv, attrib: AttribInfo) = @@ -2331,7 +2331,7 @@ and FSharpParameter(cenv, paramTy:TType, topArgInfo:ArgReprInfo, mOpt, isParamAr member __.cenv: SymbolEnv = cenv - member __.AdjustType(t) = FSharpParameter(cenv, t, topArgInfo, mOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg) + member __.AdjustType t = FSharpParameter(cenv, t, topArgInfo, mOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg) member __.Type: FSharpType = FSharpType(cenv, paramTy) diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 766bff82f..eac296da2 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -36,13 +36,13 @@ open Microsoft.FSharp.Core.CompilerServices type Unique = int64 //++GLOBAL MUTABLE STATE (concurrency-safe) -let newUnique = let i = ref 0L in fun () -> System.Threading.Interlocked.Increment(i) +let newUnique = let i = ref 0L in fun () -> System.Threading.Interlocked.Increment i type Stamp = int64 /// Unique name generator for stamps attached to to val_specs, tycon_specs etc. //++GLOBAL MUTABLE STATE (concurrency-safe) -let newStamp = let i = ref 0L in fun () -> System.Threading.Interlocked.Increment(i) +let newStamp = let i = ref 0L in fun () -> System.Threading.Interlocked.Increment i /// A global generator of compiler generated names // ++GLOBAL MUTABLE STATE (concurrency safe by locking inside NiceNameGenerator) @@ -165,7 +165,7 @@ type ValFlags(flags: int64) = | false -> 0b0000000000000000000L | true -> 0b0100000000000000000L) - ValFlags(flags) + ValFlags flags member x.BaseOrThisInfo = match (flags &&& 0b0000000000000000110L) with @@ -179,12 +179,12 @@ type ValFlags(flags: int64) = member x.IsCompilerGenerated = (flags &&& 0b0000000000000001000L) <> 0x0L - member x.SetIsCompilerGenerated(isCompGen) = + member x.SetIsCompilerGenerated isCompGen = let flags = (flags &&& ~~~0b0000000000000001000L) ||| (match isCompGen with | false -> 0b0000000000000000000L | true -> 0b0000000000000001000L) - ValFlags(flags) + ValFlags flags member x.InlineInfo = match (flags &&& 0b0000000000000110000L) with @@ -219,18 +219,18 @@ type ValFlags(flags: int64) = member x.RecursiveValInfo = match (flags &&& 0b0000001100000000000L) with | 0b0000000000000000000L -> ValNotInRecScope - | 0b0000000100000000000L -> ValInRecScope(true) - | 0b0000001000000000000L -> ValInRecScope(false) + | 0b0000000100000000000L -> ValInRecScope true + | 0b0000001000000000000L -> ValInRecScope false | _ -> failwith "unreachable" - member x.WithRecursiveValInfo(recValInfo) = + member x.WithRecursiveValInfo recValInfo = let flags = (flags &&& ~~~0b0000001100000000000L) ||| (match recValInfo with | ValNotInRecScope -> 0b0000000000000000000L - | ValInRecScope(true) -> 0b0000000100000000000L - | ValInRecScope(false) -> 0b0000001000000000000L) - ValFlags(flags) + | ValInRecScope true -> 0b0000000100000000000L + | ValInRecScope false -> 0b0000001000000000000L) + ValFlags flags member x.MakesNoCriticalTailcalls = (flags &&& 0b0000010000000000000L) <> 0L @@ -387,7 +387,7 @@ type TyparFlags(flags: int32) = member x.IsCompatFlex = (flags &&& 0b00010000000000000) <> 0x0 - member x.WithCompatFlex(b) = + member x.WithCompatFlex b = if b then TyparFlags(flags ||| 0b00010000000000000) else @@ -436,13 +436,13 @@ type EntityFlags(flags: int64) = | _ -> None /// Adjust the on-demand analysis about whether the entity has the IsByRefLike attribute - member x.WithIsByRefLike(flag) = + member x.WithIsByRefLike flag = let flags = (flags &&& ~~~0b000000011000000L) ||| (match flag with | true -> 0b000000011000000L | false -> 0b000000010000000L) - EntityFlags(flags) + EntityFlags flags /// These two bits represents the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct member x.TryIsReadOnly = (flags &&& 0b000001100000000L) @@ -452,13 +452,13 @@ type EntityFlags(flags: int64) = | _ -> None /// Adjust the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct - member x.WithIsReadOnly(flag) = + member x.WithIsReadOnly flag = let flags = (flags &&& ~~~0b000001100000000L) ||| (match flag with | true -> 0b000001100000000L | false -> 0b000001000000000L) - EntityFlags(flags) + EntityFlags flags /// Get the flags as included in the F# binary metadata member x.PickledBits = (flags &&& ~~~0b000001111000100L) @@ -506,7 +506,7 @@ let getNameOfScopeRef sref = #if !NO_EXTENSIONTYPING let ComputeDefinitionLocationOfProvidedItem (p: Tainted<#IProvidedCustomAttributeProvider>) = - let attrs = p.PUntaintNoFailure(fun x -> x.GetDefinitionLocationAttribute(p.TypeProvider.PUntaintNoFailure(id))) + let attrs = p.PUntaintNoFailure(fun x -> x.GetDefinitionLocationAttribute(p.TypeProvider.PUntaintNoFailure id)) match attrs with | None | Some (null, _, _) -> None | Some (filePath, line, column) -> @@ -522,7 +522,7 @@ let ComputeDefinitionLocationOfProvidedItem (p: Tainted<#IProvidedCustomAttribut type PublicPath = | PubPath of string[] member x.EnclosingPath = - let (PubPath(pp)) = x + let (PubPath pp) = x assert (pp.Length >= 1) pp.[0..pp.Length-2] @@ -683,7 +683,7 @@ and /// Represents a type definition, exception definition, module definition or | Some optData -> optData.entity_compiled_name | _ -> None - member x.SetCompiledName(name) = + member x.SetCompiledName name = match x.entity_opt_data with | Some optData -> optData.entity_compiled_name <- name | _ -> x.entity_opt_data <- Some { Entity.NewEmptyEntityOptData() with entity_compiled_name = name } @@ -775,7 +775,7 @@ and /// Represents a type definition, exception definition, module definition or member x.XmlDoc = #if !NO_EXTENSIONTYPING match x.TypeReprInfo with - | TProvidedTypeExtensionPoint info -> XmlDoc (info.ProvidedType.PUntaintNoFailure(fun st -> (st :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(info.ProvidedType.TypeProvider.PUntaintNoFailure(id)))) + | TProvidedTypeExtensionPoint info -> XmlDoc (info.ProvidedType.PUntaintNoFailure(fun st -> (st :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(info.ProvidedType.TypeProvider.PUntaintNoFailure id))) | _ -> #endif match x.entity_opt_data with @@ -1541,7 +1541,7 @@ and if n >= 0 && n < x.FieldsByIndex.Length then x.FieldsByIndex.[n] else failwith "FieldByIndex" - member x.FieldByName n = x.FieldsByName.TryFind(n) + member x.FieldByName n = x.FieldsByName.TryFind n member x.AllFieldsAsList = x.FieldsByIndex |> Array.toList @@ -1752,7 +1752,7 @@ and /// Get or set the XML documentation signature for the field member v.XmlDocSig with get() = v.rfield_xmldocsig - and set(x) = v.rfield_xmldocsig <- x + and set x = v.rfield_xmldocsig <- x /// The default initialization info, for static literals member v.LiteralValue = @@ -2202,7 +2202,7 @@ and member x.IsCompatFlex = x.typar_flags.IsCompatFlex /// Set whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning) - member x.SetIsCompatFlex(b) = x.typar_flags <- x.typar_flags.WithCompatFlex(b) + member x.SetIsCompatFlex b = x.typar_flags <- x.typar_flags.WithCompatFlex b /// Indicates whether a type variable can be instantiated by types or units-of-measure. member x.Kind = x.typar_flags.Kind @@ -2431,7 +2431,7 @@ and /// minst -- the generic method instantiation | ILMethSln of TType * ILTypeRef option * ILMethodRef * TypeInst - /// ClosedExprSln(expr) + /// ClosedExprSln expr /// /// Indicates a trait is solved by an erased provided expression | ClosedExprSln of Expr @@ -2698,19 +2698,19 @@ and [] /// Indicates if this is an F#-defined 'new' constructor member member x.IsConstructor = match x.MemberInfo with - | Some(memberInfo) when not x.IsExtensionMember && (memberInfo.MemberFlags.MemberKind = MemberKind.Constructor) -> true + | Some memberInfo when not x.IsExtensionMember && (memberInfo.MemberFlags.MemberKind = MemberKind.Constructor) -> true | _ -> false /// Indicates if this is a compiler-generated class constructor member member x.IsClassConstructor = match x.MemberInfo with - | Some(memberInfo) when not x.IsExtensionMember && (memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor) -> true + | Some memberInfo when not x.IsExtensionMember && (memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor) -> true | _ -> false /// Indicates if this value was a member declared 'override' or an implementation of an interface slot member x.IsOverrideOrExplicitImpl = match x.MemberInfo with - | Some(memberInfo) when memberInfo.MemberFlags.IsOverrideOrExplicitImpl -> true + | Some memberInfo when memberInfo.MemberFlags.IsOverrideOrExplicitImpl -> true | _ -> false /// Indicates if this is declared 'mutable' @@ -2778,7 +2778,7 @@ and [] match x.val_opt_data with | Some optData -> optData.val_xmldocsig | _ -> String.Empty - and set(v) = + and set v = match x.val_opt_data with | Some optData -> optData.val_xmldocsig <- v | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_xmldocsig = v } @@ -2845,7 +2845,7 @@ and [] /// Indicates if this member is an F#-defined dispatch slot. member x.IsDispatchSlot = match x.MemberInfo with - | Some(membInfo) -> membInfo.MemberFlags.IsDispatchSlot + | Some membInfo -> membInfo.MemberFlags.IsDispatchSlot | _ -> false /// Get the type of the value including any generic type parameters @@ -3121,8 +3121,8 @@ and | Tainted.Null -> ValueNone | st -> let newEntity = Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m) - parentEntity.ModuleOrNamespaceType.AddProvidedTypeEntity(newEntity) - if i = path.Length-1 then ValueSome(newEntity) + parentEntity.ModuleOrNamespaceType.AddProvidedTypeEntity newEntity + if i = path.Length-1 then ValueSome newEntity else tryResolveNestedTypeOf(newEntity, resolutionEnvironment, st, i+1) tryResolveNestedTypeOf(entity, resolutionEnvironment, st, i) @@ -3164,7 +3164,7 @@ and let rec injectNamespacesFromIToJ (entity: Entity) k = if k = j then let newEntity = Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m) - entity.ModuleOrNamespaceType.AddProvidedTypeEntity(newEntity) + entity.ModuleOrNamespaceType.AddProvidedTypeEntity newEntity newEntity else let cpath = entity.CompilationPath.NestedCompPath entity.LogicalName ModuleOrNamespaceKind.Namespace @@ -3173,7 +3173,7 @@ and (Some cpath) (TAccess []) (ident(path.[k], m)) XmlDoc.Empty [] (MaybeLazy.Strict (Construct.NewEmptyModuleOrNamespaceType Namespace)) - entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation(newEntity) + entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation newEntity injectNamespacesFromIToJ newEntity (k+1) let newEntity = injectNamespacesFromIToJ entity i @@ -3195,10 +3195,10 @@ and #endif /// Try to link a non-local entity reference to an actual entity - member nleref.TryDeref(canError) = + member nleref.TryDeref canError = let (NonLocalEntityRef(ccu, path)) = nleref if canError then - ccu.EnsureDerefable(path) + ccu.EnsureDerefable path if ccu.IsUnresolvedReference then ValueNone else @@ -3276,8 +3276,8 @@ and member x.ResolvedTarget = x.binding - member private tcr.Resolve(canError) = - let res = tcr.nlr.TryDeref(canError) + member private tcr.Resolve canError = + let res = tcr.nlr.TryDeref canError match res with | ValueSome r -> tcr.binding <- nullableSlotFull r @@ -4275,7 +4275,7 @@ and name = nm } /// Create a CCU with the given name but where the contents have not yet been specified - static member CreateDelayed(nm) = + static member CreateDelayed nm = { target = Unchecked.defaultof<_> orphanfixup = false name = nm } @@ -4304,7 +4304,7 @@ and /// Try to resolve a path into the CCU by referencing the .NET/CLI type forwarder table of the CCU member ccu.TryForward(nlpath: string[], item: string) : EntityRef option = - ccu.EnsureDerefable(nlpath) + ccu.EnsureDerefable nlpath let key = nlpath, item match ccu.TypeForwarders.TryGetValue key with | true, entity -> Some(entity.Force()) @@ -4721,7 +4721,7 @@ and /// A few of intrinsics (TOp_try, TOp.While, TOp.For) expect arguments kept in a normal form involving lambdas | Op of TOp * TypeInst * Exprs * range - /// Expr.Quote(quotedExpr, (referencedTypes, spliceTypes, spliceExprs, data) option ref, isFromQueryExpression, fullRange, quotedType) + /// Expr.Quote (quotedExpr, (referencedTypes, spliceTypes, spliceExprs, data) option ref, isFromQueryExpression, fullRange, quotedType) /// /// Indicates the expression is a quoted expression tree. /// @@ -4878,7 +4878,7 @@ and RecordConstructionInfo = /// Normal record construction | RecdExpr -/// If this is Some(ty) then it indicates that a .NET 2.0 constrained call is required, with the given type as the +/// If this is Some ty then it indicates that a .NET 2.0 constrained call is required, with the given type as the /// static type of the object argument. and ConstrainedCallInfo = TType option @@ -5444,10 +5444,10 @@ let mkNestedValRef (cref: EntityRef) (v: Val) : ValRef = mkNonLocalValRefPreResolved v nlr key /// From Ref_private to Ref_nonlocal when exporting data. -let rescopePubPathToParent viewedCcu (PubPath(p)) = NonLocalEntityRef(viewedCcu, p.[0..p.Length-2]) +let rescopePubPathToParent viewedCcu (PubPath p) = NonLocalEntityRef(viewedCcu, p.[0..p.Length-2]) /// From Ref_private to Ref_nonlocal when exporting data. -let rescopePubPath viewedCcu (PubPath(p)) = NonLocalEntityRef(viewedCcu, p) +let rescopePubPath viewedCcu (PubPath p) = NonLocalEntityRef(viewedCcu, p) //--------------------------------------------------------------------------- // Equality between TAST items. @@ -5494,7 +5494,7 @@ let nonLocalRefDefinitelyNotEq (NonLocalEntityRef(_, y1)) (NonLocalEntityRef(_, let pubPathEq (PubPath path1) (PubPath path2) = arrayPathEq path1 path2 -let fslibRefEq (nlr1: NonLocalEntityRef) (PubPath(path2)) = +let fslibRefEq (nlr1: NonLocalEntityRef) (PubPath path2) = arrayPathEq nlr1.Path path2 // Compare two EntityRef's for equality when compiling fslib (FSharp.Core.dll) diff --git a/tests/scripts/codingConventions.fsx b/tests/scripts/codingConventions.fsx index 16b1d10fa..02e0dc541 100644 --- a/tests/scripts/codingConventions.fsx +++ b/tests/scripts/codingConventions.fsx @@ -4,7 +4,7 @@ open System.IO let lines = [| for dir in [ "src/fsharp"; "src/fsharp/FSharp.Core"; "src/fsharp/symbols"; "src/fsharp/service"; "src/absil" ]do - for file in Directory.EnumerateFiles(__SOURCE_DIRECTORY__ + "/../../" + dir,"*.fs") do + for file in Directory.EnumerateFiles(__SOURCE_DIRECTORY__ + "/../../" + dir, "*.fs") do // TcGlobals.fs gets an exception let lines = File.ReadAllLines file for (line, lineText) in Array.indexed lines do @@ -44,9 +44,9 @@ let commas = lines |> Array.groupBy fst |> Array.map (fun (file, lines) -> - file, + file, lines - |> Array.sumBy (fun (_,(_,line)) -> + |> Array.sumBy (fun (_, (_, line)) -> line |> Seq.pairwise |> Seq.filter (fun (c1, c2) -> c1 = ',' && c2 <> ' ') |> Seq.length)) |> Array.sortByDescending snd @@ -59,9 +59,9 @@ let semis = lines |> Array.groupBy fst |> Array.map (fun (file, lines) -> - file, + file, lines - |> Array.filter (fun (_,(_,line)) -> line.Trim().EndsWith(";")) + |> Array.filter (fun (_, (_, line)) -> line.Trim().EndsWith(";")) |> Array.length) |> Array.sortByDescending snd @@ -77,9 +77,9 @@ let noSpaceAfterColons = lines |> Array.groupBy fst |> Array.map (fun (file, lines) -> - file, + file, lines - |> Array.filter (fun (_,(_,line)) -> re.IsMatch(line)) + |> Array.filter (fun (_, (_, line)) -> re.IsMatch(line)) |> Array.length) |> Array.sortByDescending snd @@ -93,9 +93,9 @@ let spaceBeforeColon = lines |> Array.groupBy fst |> Array.map (fun (file, lines) -> - file, + file, lines - |> Array.filter (fun (_,(_,line)) -> re.IsMatch(line)) + |> Array.filter (fun (_, (_, line)) -> re.IsMatch(line)) |> Array.length) |> Array.sortByDescending snd @@ -109,9 +109,9 @@ let internalSpacing = lines |> Array.groupBy fst |> Array.map (fun (file, lines) -> - file, + file, lines - |> Array.filter (fun (_,(_,line)) -> re.IsMatch(line)) + |> Array.filter (fun (_, (_, line)) -> re.IsMatch(line)) |> Array.length) |> Array.sortByDescending snd @@ -119,17 +119,31 @@ printfn "Top files that have internal spacing in lines:\n%A" (Array.truncate 10 printfn "------ cenv.g ----------" - let cenv_dot_g = let re = Regex("cenv\.g") lines |> Array.groupBy fst |> Array.map (fun (file, lines) -> - file, + file, lines - |> Array.filter (fun (_,(_,line)) -> re.IsMatch(line)) + |> Array.filter (fun (_, (_, line)) -> re.IsMatch(line)) |> Array.length) |> Array.sortByDescending snd printfn "Top files that have endless cenv.g:\n%A" (Array.truncate 10 cenv_dot_g) +printfn "------ parenthesized atomic expressions (id) ----------" + +let parens_id = + let re = Regex("\([a-zA-Z0-9]+\)") + lines + |> Array.groupBy fst + |> Array.map (fun (file, lines) -> + file, + lines + |> Array.filter (fun (_, (_, line)) -> re.IsMatch(line)) + |> Array.length) + |> Array.sortByDescending snd + +printfn "Top files that have parenthesized atomic expressionsg:\n%A" (Array.truncate 10 parens_id) + -- GitLab