diff --git a/src/absil/il.fs b/src/absil/il.fs index c1a8bc55b03..751e21f64de 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. module FSharp.Compiler.AbstractIL.IL @@ -6,7 +6,6 @@ module FSharp.Compiler.AbstractIL.IL #nowarn "343" // The type 'ILAssemblyRef' implements 'System.IComparable' explicitly but provides no corresponding override for 'Object.Equals'. #nowarn "346" // The struct, record or union type 'IlxExtensionType' has an explicit implementation of 'Object.Equals'. ... - open System open System.Diagnostics open System.IO @@ -50,7 +49,7 @@ 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 +/// 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())) @@ -196,20 +195,20 @@ type LazyOrderedMultiMap<'Key, 'Data when 'Key : equality>(keyf : 'Data -> 'Key, //--------------------------------------------------------------------- -// SHA1 hash-signing algorithm. Used to get the public key token from +// SHA1 hash-signing algorithm. Used to get the public key token from // the public key. //--------------------------------------------------------------------- -let b0 n = (n &&& 0xFF) -let b1 n = ((n >>> 8) &&& 0xFF) -let b2 n = ((n >>> 16) &&& 0xFF) -let b3 n = ((n >>> 24) &&& 0xFF) +let b0 n = (n &&& 0xFF) +let b1 n = ((n >>> 8) &&& 0xFF) +let b2 n = ((n >>> 16) &&& 0xFF) +let b3 n = ((n >>> 24) &&& 0xFF) module SHA1 = - let inline (>>>&) (x: int) (y: int) = int32 (uint32 x >>> y) + let inline (>>>&) (x: int) (y: int) = int32 (uint32 x >>> y) let f(t, b, c, d) = if t < 20 then (b &&& c) ||| ((~~~b) &&& d) @@ -232,19 +231,19 @@ module SHA1 = type SHAStream = { stream: byte[] mutable pos: int - mutable eof: bool } + mutable eof: bool } - let rotLeft32 x n = (x <<< n) ||| (x >>>& (32-n)) + let rotLeft32 x n = (x <<< n) ||| (x >>>& (32-n)) // padding and length (in bits!) recorded at end - let shaAfterEof sha = + let shaAfterEof sha = let n = sha.pos let len = sha.stream.Length if n = len then 0x80 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 @@ -261,7 +260,7 @@ module SHA1 = sha.pos <- sha.pos + 1 b - let shaRead32 sha = + let shaRead32 sha = let b0 = shaRead8 sha let b1 = shaRead8 sha let b2 = shaRead8 sha @@ -307,11 +306,11 @@ module SHA1 = 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; |] + Array.map byte [| b0 h4; b1 h4; b2 h4; b3 h4; b0 h3; b1 h3; b2 h3; b3 h3; |] 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 + (int64 h3 <<< 32) ||| int64 h4 let sha1HashBytes s = SHA1.sha1HashBytes s let sha1HashInt64 s = SHA1.sha1HashInt64 s @@ -362,7 +361,7 @@ let isMscorlib data = data.assemRefName = "mscorlib" [] -type ILAssemblyRef(data) = +type ILAssemblyRef(data) = let uniqueStamp = AssemblyRefUniqueStampGenerator.Encode(data) member x.Name=data.assemRefName @@ -400,9 +399,9 @@ type ILAssemblyRef(data) = let locale = None let publicKey = - match aname.GetPublicKey() with + match aname.GetPublicKey() with | null | [| |] -> - match aname.GetPublicKeyToken() with + match aname.GetPublicKeyToken() with | null | [| |] -> None | bytes -> Some (PublicKeyToken bytes) | bytes -> @@ -445,7 +444,7 @@ type ILAssemblyRef(data) = let convDigit(digit) = let digitc = if digit < 10 - then System.Convert.ToInt32 '0' + digit + then System.Convert.ToInt32 '0' + digit else System.Convert.ToInt32 'a' + (digit - 10) System.Convert.ToChar(digitc) for i = 0 to pkt.Length-1 do @@ -482,15 +481,15 @@ type ILScopeRef = | Module of ILModuleRef | Assembly of ILAssemblyRef - member x.IsLocalRef = match x with ILScopeRef.Local -> true | _ -> false + member x.IsLocalRef = match x with ILScopeRef.Local -> true | _ -> false - member x.IsModuleRef = match x with ILScopeRef.Module _ -> true | _ -> false + member x.IsModuleRef = match x with ILScopeRef.Module _ -> true | _ -> false member x.IsAssemblyRef= match x with ILScopeRef.Assembly _ -> true | _ -> false - member x.ModuleRef = match x with ILScopeRef.Module x -> x | _ -> failwith "not a module reference" + member x.ModuleRef = match x with ILScopeRef.Module x -> x | _ -> failwith "not a module reference" - member x.AssemblyRef = match x with ILScopeRef.Assembly x -> x | _ -> failwith "not an assembly reference" + member x.AssemblyRef = match x with ILScopeRef.Assembly x -> x | _ -> failwith "not an assembly reference" member x.QualifiedName = match x with @@ -541,15 +540,15 @@ 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 + member x.IsInstance = match x.ThisConv with ILThisConvention.Instance -> true | _ -> false member x.IsInstanceExplicit = match x.ThisConv with ILThisConvention.InstanceExplicit -> true | _ -> false - member x.IsStatic = match x.ThisConv with ILThisConvention.Static -> true | _ -> false + member x.IsStatic = match x.ThisConv with ILThisConvention.Static -> true | _ -> false static member Instance = ILCallingConvStatics.Instance @@ -560,7 +559,7 @@ and ILCallingConvStatics() = 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 @@ -687,13 +686,13 @@ 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 + | 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 = @@ -855,9 +854,9 @@ type ILFieldSpec = { FieldRef: ILFieldRef DeclaringType: ILType } - member x.FormalType = x.FieldRef.Type + member x.FormalType = x.FieldRef.Type - member x.Name = x.FieldRef.Name + member x.Name = x.FieldRef.Name member x.DeclaringTypeRef = x.FieldRef.DeclaringTypeRef @@ -871,7 +870,7 @@ type ILFieldSpec = // Debug info. // -------------------------------------------------------------------- -type ILGuid = byte[] +type ILGuid = byte[] type ILPlatform = | X86 @@ -930,7 +929,7 @@ type ILSourceMarker = override x.ToString() = sprintf "(%d, %d)-(%d, %d)" x.Line x.Column x.EndLine x.EndColumn type ILAttribElem = - | String of string option + | String of string option | Bool of bool | Char of char | SByte of int8 @@ -948,7 +947,7 @@ type ILAttribElem = | TypeRef of ILTypeRef option | Array of ILType * ILAttribElem list -type ILAttributeNamedArg = (string * ILType * bool * ILAttribElem) +type ILAttributeNamedArg = (string * ILType * bool * ILAttribElem) [] type ILAttribute = @@ -1005,7 +1004,7 @@ let mkILCustomAttrs l = match l with [] -> emptyILCustomAttrs | _ -> mkILCustomA let emptyILCustomAttrsStored = ILAttributesStored.Given emptyILCustomAttrs -let storeILCustomAttrs (attrs: ILAttributes) = if attrs.AsArray.Length = 0 then emptyILCustomAttrsStored else ILAttributesStored.Given attrs +let storeILCustomAttrs (attrs: ILAttributes) = if attrs.AsArray.Length = 0 then emptyILCustomAttrsStored else ILAttributesStored.Given attrs let mkILCustomAttrsReader f = ILAttributesStored.Reader f @@ -1093,9 +1092,9 @@ type ILInstr = | AI_cgt_un | AI_clt | AI_clt_un - | AI_conv of ILBasicType - | AI_conv_ovf of ILBasicType - | AI_conv_ovf_un of ILBasicType + | AI_conv of ILBasicType + | AI_conv_ovf of ILBasicType + | AI_conv_ovf_un of ILBasicType | AI_mul | AI_mul_ovf | AI_mul_ovf_un @@ -1117,66 +1116,66 @@ type ILInstr = | AI_ckfinite | AI_nop | AI_ldc of ILBasicType * ILConst - | I_ldarg of uint16 - | I_ldarga of uint16 - | I_ldind of ILAlignment * ILVolatility * ILBasicType - | I_ldloc of uint16 - | I_ldloca of uint16 - | I_starg of uint16 - | I_stind of ILAlignment * ILVolatility * ILBasicType - | I_stloc of uint16 - - | I_br of ILCodeLabel - | I_jmp of ILMethodSpec + | I_ldarg of uint16 + | I_ldarga of uint16 + | I_ldind of ILAlignment * ILVolatility * ILBasicType + | I_ldloc of uint16 + | I_ldloca of uint16 + | I_starg of uint16 + | I_stind of ILAlignment * ILVolatility * ILBasicType + | I_stloc of uint16 + + | I_br of ILCodeLabel + | I_jmp of ILMethodSpec | I_brcmp of ILComparisonInstr * ILCodeLabel - | I_switch of ILCodeLabel list + | I_switch of ILCodeLabel list | I_ret - | I_call of ILTailcall * ILMethodSpec * ILVarArgs + | I_call of ILTailcall * ILMethodSpec * ILVarArgs | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs | I_callconstraint of ILTailcall * ILType * ILMethodSpec * ILVarArgs - | I_calli of ILTailcall * ILCallingSignature * ILVarArgs - | I_ldftn of ILMethodSpec - | I_newobj of ILMethodSpec * ILVarArgs + | I_calli of ILTailcall * ILCallingSignature * ILVarArgs + | I_ldftn of ILMethodSpec + | I_newobj of ILMethodSpec * ILVarArgs | I_throw | I_endfinally | I_endfilter - | I_leave of ILCodeLabel + | I_leave of ILCodeLabel | I_rethrow - | I_ldsfld of ILVolatility * ILFieldSpec - | I_ldfld of ILAlignment * ILVolatility * ILFieldSpec - | I_ldsflda of ILFieldSpec - | I_ldflda of ILFieldSpec - | I_stsfld of ILVolatility * ILFieldSpec - | I_stfld of ILAlignment * ILVolatility * ILFieldSpec - | I_ldstr of string - | I_isinst of ILType - | I_castclass of ILType - | I_ldtoken of ILToken - | I_ldvirtftn of ILMethodSpec - - | I_cpobj of ILType - | I_initobj of ILType - | I_ldobj of ILAlignment * ILVolatility * ILType - | I_stobj of ILAlignment * ILVolatility * ILType - | I_box of ILType - | I_unbox of ILType - | I_unbox_any of ILType - | I_sizeof of ILType - - | I_ldelem of ILBasicType - | I_stelem of ILBasicType - | 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_ldsfld of ILVolatility * ILFieldSpec + | I_ldfld of ILAlignment * ILVolatility * ILFieldSpec + | I_ldsflda of ILFieldSpec + | I_ldflda of ILFieldSpec + | I_stsfld of ILVolatility * ILFieldSpec + | I_stfld of ILAlignment * ILVolatility * ILFieldSpec + | I_ldstr of string + | I_isinst of ILType + | I_castclass of ILType + | I_ldtoken of ILToken + | I_ldvirtftn of ILMethodSpec + + | I_cpobj of ILType + | I_initobj of ILType + | I_ldobj of ILAlignment * ILVolatility * ILType + | I_stobj of ILAlignment * ILVolatility * ILType + | I_box of ILType + | I_unbox of ILType + | I_unbox_any of ILType + | I_sizeof of ILType + + | I_ldelem of ILBasicType + | I_stelem of ILBasicType + | 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_ldlen - | I_mkrefany of ILType + | I_mkrefany of ILType | I_refanytype - | I_refanyval of ILType + | I_refanyval of ILType | I_break | I_seqpoint of ILSourceMarker @@ -1185,17 +1184,17 @@ type ILInstr = | I_localloc | I_cpblk of ILAlignment * ILVolatility - | I_initblk of ILAlignment * ILVolatility + | I_initblk of ILAlignment * ILVolatility (* FOR EXTENSIONS, e.g. MS-ILX *) | EI_ilzero of ILType - | EI_ldlen_multi of int32 * int32 + | EI_ldlen_multi of int32 * int32 [] type ILExceptionClause = | Finally of (ILCodeLabel * ILCodeLabel) - | Fault of (ILCodeLabel * ILCodeLabel) + | Fault of (ILCodeLabel * ILCodeLabel) | FilterCatch of (ILCodeLabel * ILCodeLabel) * (ILCodeLabel * ILCodeLabel) | TypeCatch of ILType * (ILCodeLabel * ILCodeLabel) @@ -1239,7 +1238,7 @@ type ILMethodBody = NoInlining: bool AggressiveInlining: bool Locals: ILLocals - Code: ILCode + Code: ILCode SourceMarker: ILSourceMarker option } [] @@ -1419,7 +1418,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 @@ -1467,7 +1466,7 @@ type ILParameter = IsOut: bool IsOptional: bool CustomAttrsStored: ILAttributesStored - MetadataIndex: int32 } + MetadataIndex: int32 } member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex @@ -1478,7 +1477,7 @@ type ILReturn = { Marshal: ILNativeType option Type: ILType CustomAttrsStored: ILAttributesStored - MetadataIndex: int32 } + MetadataIndex: int32 } member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex @@ -1507,7 +1506,7 @@ type MethodKind = [] type MethodBody = | IL of ILMethodBody - | PInvoke of PInvokeMethod (* platform invoke to native *) + | PInvoke of PInvokeMethod (* platform invoke to native *) | Abstract | Native | NotAvailable @@ -1558,23 +1557,23 @@ 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) = match ilMemberAccess with - | ILMemberAccess.Public -> MethodAttributes.Public - | ILMemberAccess.Private -> MethodAttributes.Private - | ILMemberAccess.Assembly -> MethodAttributes.Assembly - | ILMemberAccess.FamilyAndAssembly -> MethodAttributes.FamANDAssem - | ILMemberAccess.CompilerControlled -> MethodAttributes.PrivateScope - | ILMemberAccess.FamilyOrAssembly -> MethodAttributes.FamORAssem - | ILMemberAccess.Family -> MethodAttributes.Family + | ILMemberAccess.Public -> MethodAttributes.Public + | ILMemberAccess.Private -> MethodAttributes.Private + | ILMemberAccess.Assembly -> MethodAttributes.Assembly + | ILMemberAccess.FamilyAndAssembly -> MethodAttributes.FamANDAssem + | ILMemberAccess.CompilerControlled -> MethodAttributes.PrivateScope + | ILMemberAccess.FamilyOrAssembly -> MethodAttributes.FamORAssem + | ILMemberAccess.Family -> MethodAttributes.Family let inline conditionalAdd condition flagToAdd source = if condition then source ||| flagToAdd else source &&& ~~~flagToAdd @@ -1650,37 +1649,37 @@ 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 + member x.IsZeroInit = x.MethodBody.IsZeroInit - member md.CallingSignature = mkILCallSig (md.CallingConv, md.ParameterTypes, md.Return.Type) + member md.CallingSignature = mkILCallSig (md.CallingConv, md.ParameterTypes, md.Return.Type) - member x.IsClassInitializer = x.Name = ".cctor" - member x.IsConstructor = x.Name = ".ctor" + member x.IsClassInitializer = x.Name = ".cctor" + member x.IsConstructor = x.Name = ".ctor" - member x.Access = memberAccessOfFlags (int x.Attributes) - member x.IsStatic = x.Attributes &&& MethodAttributes.Static <> enum 0 - member x.IsNonVirtualInstance = not x.IsStatic && not x.IsVirtual - member x.IsVirtual = x.Attributes &&& MethodAttributes.Virtual <> enum 0 - member x.IsFinal = x.Attributes &&& MethodAttributes.Final <> enum 0 - member x.IsNewSlot = x.Attributes &&& MethodAttributes.NewSlot <> enum 0 + member x.Access = memberAccessOfFlags (int x.Attributes) + member x.IsStatic = x.Attributes &&& MethodAttributes.Static <> enum 0 + member x.IsNonVirtualInstance = not x.IsStatic && not x.IsVirtual + member x.IsVirtual = x.Attributes &&& MethodAttributes.Virtual <> enum 0 + member x.IsFinal = x.Attributes &&& MethodAttributes.Final <> enum 0 + member x.IsNewSlot = x.Attributes &&& MethodAttributes.NewSlot <> enum 0 member x.IsCheckAccessOnOverride= x.Attributes &&& MethodAttributes.CheckAccessOnOverride <> enum 0 - member x.IsAbstract = x.Attributes &&& MethodAttributes.Abstract <> enum 0 - member x.IsHideBySig = x.Attributes &&& MethodAttributes.HideBySig <> enum 0 - member x.IsSpecialName = x.Attributes &&& MethodAttributes.SpecialName <> enum 0 - member x.IsUnmanagedExport = x.Attributes &&& MethodAttributes.UnmanagedExport <> enum 0 - member x.IsReqSecObj = x.Attributes &&& MethodAttributes.RequireSecObject <> enum 0 - member x.HasSecurity = x.Attributes &&& MethodAttributes.HasSecurity <> enum 0 - - member x.IsManaged = x.ImplAttributes &&& MethodImplAttributes.Managed <> enum 0 - member x.IsForwardRef = x.ImplAttributes &&& MethodImplAttributes.ForwardRef <> enum 0 - member x.IsInternalCall = x.ImplAttributes &&& MethodImplAttributes.InternalCall <> enum 0 - member x.IsPreserveSig = x.ImplAttributes &&& MethodImplAttributes.PreserveSig <> enum 0 - member x.IsSynchronized = x.ImplAttributes &&& MethodImplAttributes.Synchronized <> enum 0 - member x.IsNoInline = x.ImplAttributes &&& MethodImplAttributes.NoInlining <> enum 0 + member x.IsAbstract = x.Attributes &&& MethodAttributes.Abstract <> enum 0 + member x.IsHideBySig = x.Attributes &&& MethodAttributes.HideBySig <> enum 0 + member x.IsSpecialName = x.Attributes &&& MethodAttributes.SpecialName <> enum 0 + member x.IsUnmanagedExport = x.Attributes &&& MethodAttributes.UnmanagedExport <> enum 0 + member x.IsReqSecObj = x.Attributes &&& MethodAttributes.RequireSecObject <> enum 0 + member x.HasSecurity = x.Attributes &&& MethodAttributes.HasSecurity <> enum 0 + + member x.IsManaged = x.ImplAttributes &&& MethodImplAttributes.Managed <> enum 0 + member x.IsForwardRef = x.ImplAttributes &&& MethodImplAttributes.ForwardRef <> enum 0 + member x.IsInternalCall = x.ImplAttributes &&& MethodImplAttributes.InternalCall <> enum 0 + member x.IsPreserveSig = x.ImplAttributes &&& MethodImplAttributes.PreserveSig <> enum 0 + member x.IsSynchronized = x.ImplAttributes &&& MethodImplAttributes.Synchronized <> enum 0 + member x.IsNoInline = x.ImplAttributes &&& MethodImplAttributes.NoInlining <> enum 0 member x.IsAggressiveInline= x.ImplAttributes &&& MethodImplAttributes.AggressiveInlining <> enum 0 - member x.IsMustRun = x.ImplAttributes &&& MethodImplAttributes.NoOptimization <> enum 0 + member x.IsMustRun = x.ImplAttributes &&& MethodImplAttributes.NoOptimization <> enum 0 member x.WithSpecialName = x.With(attributes = (x.Attributes ||| MethodAttributes.SpecialName)) member x.WithHideBySig() = @@ -1831,17 +1830,17 @@ type ILPropertyDefs = let convertFieldAccess (ilMemberAccess: ILMemberAccess) = match ilMemberAccess with - | ILMemberAccess.Assembly -> FieldAttributes.Assembly - | ILMemberAccess.CompilerControlled -> enum(0) - | ILMemberAccess.FamilyAndAssembly -> FieldAttributes.FamANDAssem - | ILMemberAccess.FamilyOrAssembly -> FieldAttributes.FamORAssem - | ILMemberAccess.Family -> FieldAttributes.Family - | ILMemberAccess.Private -> FieldAttributes.Private - | ILMemberAccess.Public -> FieldAttributes.Public + | ILMemberAccess.Assembly -> FieldAttributes.Assembly + | ILMemberAccess.CompilerControlled -> enum(0) + | ILMemberAccess.FamilyAndAssembly -> FieldAttributes.FamANDAssem + | ILMemberAccess.FamilyOrAssembly -> FieldAttributes.FamORAssem + | ILMemberAccess.Family -> FieldAttributes.Family + | ILMemberAccess.Private -> FieldAttributes.Private + | ILMemberAccess.Public -> FieldAttributes.Public [] type ILFieldDef(name: string, fieldType: ILType, attributes: FieldAttributes, data: byte[] option, - literalValue: ILFieldInit option, offset: int32 option, marshal: ILNativeType option, + literalValue: ILFieldInit option, offset: int32 option, marshal: ILNativeType option, customAttrsStored: ILAttributesStored, metadataIndex: int32) = new (name, fieldType, attributes, data, literalValue, offset, marshal, customAttrs) = @@ -1857,7 +1856,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, @@ -1881,7 +1880,7 @@ type ILFieldDef(name: string, fieldType: ILType, attributes: FieldAttributes, da 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. +// Index table by name. Keep a canonical list to make sure field order is not disturbed for binary manipulation. type ILFieldDefs = | ILFields of LazyOrderedMultiMap @@ -1957,7 +1956,7 @@ let typeKindOfFlags nm _mdefs _fdefs (super: ILType option) flags = else let isEnum, isDelegate, isMulticastDelegate, isValueType = match super with - | None -> false , false, false, false + | None -> false, false, false, false | Some ty -> ty.TypeSpec.Name = "System.Enum", ty.TypeSpec.Name = "System.Delegate", @@ -1965,17 +1964,17 @@ let typeKindOfFlags nm _mdefs _fdefs (super: ILType option) flags = ty.TypeSpec.Name = "System.ValueType" && nm <> "System.Enum" let selfIsMulticastDelegate = nm = "System.MulticastDelegate" if isEnum then ILTypeDefKind.Enum - elif (isDelegate && not selfIsMulticastDelegate) || isMulticastDelegate then ILTypeDefKind.Delegate + elif (isDelegate && not selfIsMulticastDelegate) || isMulticastDelegate then ILTypeDefKind.Delegate elif isValueType then ILTypeDefKind.ValueType else ILTypeDefKind.Class let convertTypeAccessFlags access = match access with | ILTypeDefAccess.Public -> TypeAttributes.Public - | ILTypeDefAccess.Private -> TypeAttributes.NotPublic + | ILTypeDefAccess.Private -> TypeAttributes.NotPublic | ILTypeDefAccess.Nested ILMemberAccess.Public -> TypeAttributes.NestedPublic - | ILTypeDefAccess.Nested ILMemberAccess.Private -> TypeAttributes.NestedPrivate - | ILTypeDefAccess.Nested ILMemberAccess.Family -> TypeAttributes.NestedFamily + | ILTypeDefAccess.Nested ILMemberAccess.Private -> TypeAttributes.NestedPrivate + | ILTypeDefAccess.Nested ILMemberAccess.Family -> TypeAttributes.NestedFamily | ILTypeDefAccess.Nested ILMemberAccess.CompilerControlled -> TypeAttributes.NestedPrivate | ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly -> TypeAttributes.NestedFamANDAssem | ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly -> TypeAttributes.NestedFamORAssem @@ -2003,13 +2002,13 @@ let convertEncoding encoding = let convertToNestedTypeAccess (ilMemberAccess: ILMemberAccess) = match ilMemberAccess with - | ILMemberAccess.Assembly -> TypeAttributes.NestedAssembly - | ILMemberAccess.CompilerControlled -> failwith "Method access compiler controlled." - | ILMemberAccess.FamilyAndAssembly -> TypeAttributes.NestedFamANDAssem - | ILMemberAccess.FamilyOrAssembly -> TypeAttributes.NestedFamORAssem - | ILMemberAccess.Family -> TypeAttributes.NestedFamily - | ILMemberAccess.Private -> TypeAttributes.NestedPrivate - | ILMemberAccess.Public -> TypeAttributes.NestedPublic + | ILMemberAccess.Assembly -> TypeAttributes.NestedAssembly + | ILMemberAccess.CompilerControlled -> failwith "Method access compiler controlled." + | ILMemberAccess.FamilyAndAssembly -> TypeAttributes.NestedFamANDAssem + | ILMemberAccess.FamilyOrAssembly -> TypeAttributes.NestedFamORAssem + | ILMemberAccess.Family -> TypeAttributes.NestedFamily + | ILMemberAccess.Private -> TypeAttributes.NestedPrivate + | ILMemberAccess.Public -> TypeAttributes.NestedPublic let convertInitSemantics (init: ILTypeInit) = match init with @@ -2069,11 +2068,11 @@ type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex - member x.IsClass = (typeKindOfFlags x.Name x.Methods x.Fields x.Extends (int x.Attributes)) = ILTypeDefKind.Class - member x.IsStruct = (typeKindOfFlags x.Name x.Methods x.Fields x.Extends (int x.Attributes)) = ILTypeDefKind.ValueType + member x.IsClass = (typeKindOfFlags x.Name x.Methods x.Fields x.Extends (int x.Attributes)) = ILTypeDefKind.Class + member x.IsStruct = (typeKindOfFlags x.Name x.Methods x.Fields x.Extends (int x.Attributes)) = ILTypeDefKind.ValueType 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.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.IsAbstract = x.Attributes &&& TypeAttributes.Abstract <> enum 0 member x.IsSealed = x.Attributes &&& TypeAttributes.Sealed <> enum 0 @@ -2121,7 +2120,7 @@ and [] ILTypeDefs(f : unit -> ILPreTypeDef[]) = member x.AsArrayOfPreTypeDefs = array.Value - member x.FindByName nm = + member x.FindByName nm = let ns, n = splitILTypeName nm dict.Value.[(ns, n)].GetTypeDef() @@ -2314,15 +2313,15 @@ let emptyILGenericArgsList = ([]: ILType list) // -------------------------------------------------------------------- -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) +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 mkILNonGenericTySpec tref = mkILTySpec (tref, []) let mkILTyRefInTyRef (tref: ILTypeRef, nm) = mkILNestedTyRef (tref.Scope, tref.Enclosing@[tref.Name], nm) @@ -2428,14 +2427,14 @@ let generateCodeLabel() = System.Threading.Interlocked.Increment(codeLabelCount) let instrIsRet i = match i with - | I_ret -> true + | I_ret -> true | _ -> false let nonBranchingInstrsToCode instrs : ILCode = let instrs = Array.ofList instrs let instrs = if instrs.Length <> 0 && instrIsRet (Array.last instrs) then instrs - else Array.append instrs [| I_ret |] + else Array.append instrs [| I_ret |] { Labels = Dictionary() Instrs = instrs @@ -2463,7 +2462,7 @@ let gparam_of_gactual (_ga: ILType) = mkILSimpleTypar "T" let mkILFormalTypars (x: ILGenericArgsList) = List.map gparam_of_gactual x -let mkILFormalGenericArgs numtypars (gparams: ILGenericParameterDefs) = +let mkILFormalGenericArgs numtypars (gparams: ILGenericParameterDefs) = List.mapi (fun n _gf -> mkILTyvarTy (uint16 (numtypars + n))) gparams let mkILFormalBoxedTy tref gparams = mkILBoxedTy tref (mkILFormalGenericArgs 0 gparams) @@ -2474,7 +2473,7 @@ let mkILFormalNamedTy bx tref gparams = mkILNamedTy bx tref (mkILFormalGenericAr // Operations on class etc. defs. // -------------------------------------------------------------------- -let mkRefForNestedILTypeDef scope (enc: ILTypeDef list, td: ILTypeDef) = +let mkRefForNestedILTypeDef scope (enc: ILTypeDef list, td: ILTypeDef) = mkILNestedTyRef(scope, (enc |> List.map (fun etd -> etd.Name)), td.Name) // -------------------------------------------------------------------- @@ -2491,8 +2490,8 @@ let mkILPreTypeDefRead (ns, n, idx, f) = let addILTypeDef td (tdefs: ILTypeDefs) = ILTypeDefs (fun () -> [| yield mkILPreTypeDef td; yield! tdefs.AsArrayOfPreTypeDefs |]) -let mkILTypeDefsFromArray (l: ILTypeDef[]) = ILTypeDefs (fun () -> Array.map mkILPreTypeDef l) -let mkILTypeDefs l = mkILTypeDefsFromArray (Array.ofList l) +let mkILTypeDefsFromArray (l: ILTypeDef[]) = ILTypeDefs (fun () -> Array.map mkILPreTypeDef l) +let mkILTypeDefs l = mkILTypeDefsFromArray (Array.ofList l) let mkILTypeDefsComputed f = ILTypeDefs f let emptyILTypeDefs = mkILTypeDefsFromArray [| |] @@ -2500,9 +2499,9 @@ 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 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) = @@ -2612,26 +2611,26 @@ type ILGlobals(primaryScopeRef) = let m_typ_IntPtr = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IntPtr)) let m_typ_UIntPtr = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UIntPtr)) - member x.primaryAssemblyScopeRef = m_typ_Object.TypeRef.Scope - member x.primaryAssemblyName = m_typ_Object.TypeRef.Scope.AssemblyRef.Name - member x.typ_Object = m_typ_Object - 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_UIntPtr = m_typ_UIntPtr - 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 - member x.typ_SByte = m_typ_SByte - member x.typ_UInt16 = m_typ_UInt16 - member x.typ_UInt32 = m_typ_UInt32 - member x.typ_UInt64 = m_typ_UInt64 - member x.typ_Single = m_typ_Single - member x.typ_Double = m_typ_Double - member x.typ_Bool = m_typ_Bool - member x.typ_Char = m_typ_Char + member x.primaryAssemblyScopeRef = m_typ_Object.TypeRef.Scope + member x.primaryAssemblyName = m_typ_Object.TypeRef.Scope.AssemblyRef.Name + member x.typ_Object = m_typ_Object + 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_UIntPtr = m_typ_UIntPtr + 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 + member x.typ_SByte = m_typ_SByte + member x.typ_UInt16 = m_typ_UInt16 + member x.typ_UInt32 = m_typ_UInt32 + member x.typ_UInt64 = m_typ_UInt64 + member x.typ_Single = m_typ_Single + member x.typ_Double = m_typ_Double + member x.typ_Bool = m_typ_Bool + member x.typ_Char = m_typ_Char /// For debugging [] @@ -2647,12 +2646,12 @@ let mkNormalCallvirt mspec = I_callvirt (Normalcall, mspec, None) let mkNormalCallconstraint (ty, mspec) = I_callconstraint (Normalcall, ty, mspec, None) -let mkNormalNewobj mspec = I_newobj (mspec, None) +let mkNormalNewobj mspec = I_newobj (mspec, None) /// Comment on common object cache sizes: /// mkLdArg - I can't imagine any IL method we generate needing more than this /// mkLdLoc - I tried 256, and there were LdLoc allocations left, so I upped it o 512. I didn't check again. -/// mkStLoc - it should be the same as LdLoc (where there's a LdLoc there must be a StLoc) +/// mkStLoc - it should be the same as LdLoc (where there's a LdLoc there must be a StLoc) /// mkLdcInt32 - just a guess let ldargs = [| for i in 0 .. 128 -> I_ldarg (uint16 i) |] @@ -2699,39 +2698,39 @@ let isILBoxedPrimaryAssemblyTy (ty: ILType) n = let isILValuePrimaryAssemblyTy (ty: ILType) n = isILValueTy ty && isPrimaryAssemblyTySpec ty.TypeSpec n -let isILObjectTy ty = isILBoxedPrimaryAssemblyTy ty tname_Object +let isILObjectTy ty = isILBoxedPrimaryAssemblyTy ty tname_Object -let isILStringTy ty = isILBoxedPrimaryAssemblyTy ty tname_String +let isILStringTy ty = isILBoxedPrimaryAssemblyTy ty tname_String -let isILTypedReferenceTy ty = isILValuePrimaryAssemblyTy ty "System.TypedReference" +let isILTypedReferenceTy ty = isILValuePrimaryAssemblyTy ty "System.TypedReference" -let isILSByteTy ty = isILValuePrimaryAssemblyTy ty tname_SByte +let isILSByteTy ty = isILValuePrimaryAssemblyTy ty tname_SByte -let isILByteTy ty = isILValuePrimaryAssemblyTy ty tname_Byte +let isILByteTy ty = isILValuePrimaryAssemblyTy ty tname_Byte -let isILInt16Ty ty = isILValuePrimaryAssemblyTy ty tname_Int16 +let isILInt16Ty ty = isILValuePrimaryAssemblyTy ty tname_Int16 -let isILUInt16Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt16 +let isILUInt16Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt16 -let isILInt32Ty ty = isILValuePrimaryAssemblyTy ty tname_Int32 +let isILInt32Ty ty = isILValuePrimaryAssemblyTy ty tname_Int32 -let isILUInt32Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt32 +let isILUInt32Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt32 -let isILInt64Ty ty = isILValuePrimaryAssemblyTy ty tname_Int64 +let isILInt64Ty ty = isILValuePrimaryAssemblyTy ty tname_Int64 -let isILUInt64Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt64 +let isILUInt64Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt64 -let isILIntPtrTy ty = isILValuePrimaryAssemblyTy ty tname_IntPtr +let isILIntPtrTy ty = isILValuePrimaryAssemblyTy ty tname_IntPtr -let isILUIntPtrTy ty = isILValuePrimaryAssemblyTy ty tname_UIntPtr +let isILUIntPtrTy ty = isILValuePrimaryAssemblyTy ty tname_UIntPtr -let isILBoolTy ty = isILValuePrimaryAssemblyTy ty tname_Bool +let isILBoolTy ty = isILValuePrimaryAssemblyTy ty tname_Bool -let isILCharTy ty = isILValuePrimaryAssemblyTy ty tname_Char +let isILCharTy ty = isILValuePrimaryAssemblyTy ty tname_Char -let isILSingleTy ty = isILValuePrimaryAssemblyTy ty tname_Single +let isILSingleTy ty = isILValuePrimaryAssemblyTy ty tname_Single -let isILDoubleTy ty = isILValuePrimaryAssemblyTy ty tname_Double +let isILDoubleTy ty = isILValuePrimaryAssemblyTy ty tname_Double // -------------------------------------------------------------------- // Rescoping @@ -2793,7 +2792,7 @@ 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) = @@ -2818,13 +2817,13 @@ let rec instILTypeSpecAux numFree inst (tspec: ILTypeSpec) = 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.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.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 -> let v = int v let top = inst.Length if v < numFree then ty else @@ -2836,10 +2835,10 @@ and instILTypeAux numFree (inst: ILGenericArgs) ty = and instILGenericArgsAux numFree inst i = List.map (instILTypeAux numFree inst) i -and instILCallSigAux numFree inst csig = - mkILCallSig (csig.CallingConv, List.map (instILTypeAux numFree inst) csig.ArgTypes, instILTypeAux numFree inst csig.ReturnType) +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 +let instILType i t = instILTypeAux 0 i t // -------------------------------------------------------------------- // MS-IL: Parameters, Return types and Locals @@ -2854,7 +2853,7 @@ let mkILParam (name, ty) : ILParameter = IsOptional=false Type=ty CustomAttrsStored=storeILCustomAttrs emptyILCustomAttrs - MetadataIndex = NoMetadataIdx } + MetadataIndex = NoMetadataIdx } let mkILParamNamed (s, ty) = mkILParam (Some s, ty) @@ -3022,14 +3021,14 @@ let mkILNonGenericInstanceMethod (nm, access, args, ret, impl) = // -------------------------------------------------------------------- -// Add some code to the end of the .cctor for a type. Create a .cctor +// 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) = +let ilmbody_code2code f (il: ILMethodBody) = {il with Code = f il.Code} -let mdef_code2code f (md: ILMethodDef) = +let mdef_code2code f (md: ILMethodDef) = let il = match md.Body.Contents with | MethodBody.IL il-> il @@ -3057,7 +3056,7 @@ let prependInstrsToCode (instrs: ILInstr list) (c2: ILCode) = { 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 @@ -3081,7 +3080,7 @@ let code_of_mdef (md: ILMethodDef) = let mkRefToILMethod (tref, md: ILMethodDef) = mkILMethRef (tref, md.CallingConv, md.Name, md.GenericParams.Length, md.ParameterTypes, md.Return.Type) -let mkRefToILField (tref, fdef: ILFieldDef) = mkILFieldRef (tref, fdef.Name, fdef.FieldType) +let mkRefToILField (tref, fdef: ILFieldDef) = mkILFieldRef (tref, fdef.Name, fdef.FieldType) let mkRefForILMethod scope (tdefs, tdef) mdef = mkRefToILMethod (mkRefForNestedILTypeDef scope (tdefs, tdef), mdef) @@ -3126,29 +3125,29 @@ type ILLocalsAllocator(numPrealloc: int) = 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 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 mkILEvents l = mkILEventsLazy (notlazy l) -let emptyILEvents = mkILEvents [] +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) +let mkILProperties l = mkILPropertiesLazy (notlazy l) -let emptyILProperties = mkILProperties [] +let emptyILProperties = mkILProperties [] let addExportedTypeToTable (y: ILExportedTypeOrForwarder) tab = Map.add y.Name y tab -let mkILExportedTypes l = ILExportedTypesAndForwarders (notlazy (List.foldBack addExportedTypeToTable l Map.empty)) +let mkILExportedTypes l = ILExportedTypesAndForwarders (notlazy (List.foldBack addExportedTypeToTable l Map.empty)) -let mkILExportedTypesLazy (l: Lazy<_>) = ILExportedTypesAndForwarders (lazy (List.foldBack addExportedTypeToTable (l.Force()) Map.empty)) +let mkILExportedTypesLazy (l: Lazy<_>) = ILExportedTypesAndForwarders (lazy (List.foldBack addExportedTypeToTable (l.Force()) Map.empty)) let addNestedExportedTypeToTable (y: ILNestedExportedType) tab = Map.add y.Name y tab @@ -3167,21 +3166,21 @@ let mkILNestedExportedTypes l = let mkILNestedExportedTypesLazy (l: Lazy<_>) = ILNestedExportedTypes (lazy (List.foldBack addNestedExportedTypeToTable (l.Force()) Map.empty)) -let mkILResources l = ILResources l +let mkILResources l = ILResources l let addMethodImplToTable y tab = let key = (y.Overrides.MethodRef.Name, y.Overrides.MethodRef.ArgTypes.Length) let prev = Map.tryFindMulti key tab Map.add key (y::prev) tab -let mkILMethodImpls l = ILMethodImpls (notlazy (List.foldBack addMethodImplToTable l Map.empty)) +let mkILMethodImpls l = ILMethodImpls (notlazy (List.foldBack addMethodImplToTable l Map.empty)) -let mkILMethodImplsLazy l = ILMethodImpls (lazy (List.foldBack addMethodImplToTable (Lazy.force l) Map.empty)) +let mkILMethodImplsLazy l = ILMethodImpls (lazy (List.foldBack addMethodImplToTable (Lazy.force l) Map.empty)) -let emptyILMethodImpls = mkILMethodImpls [] +let emptyILMethodImpls = mkILMethodImpls [] /// Make a constructor that simply takes its arguments and stuffs -/// them in fields. preblock is how to call the superclass constructor.... +/// them in fields. preblock is how to call the superclass constructor.... let mkILStorageCtorWithParamNames(tag, preblock, ty, extraParams, flds, access) = mkILCtor(access, (flds |> List.map (fun (pnm, _, ty) -> mkILParamNamed (pnm, ty))) @ extraParams, @@ -3195,7 +3194,7 @@ let mkILStorageCtorWithParamNames(tag, preblock, ty, extraParams, flds, access) [ mkLdarg0 mkLdarg (uint16 (n+1)) mkNormalStfld (mkILFieldSpecInTy (ty, nm, fieldTy)) - ]) flds) + ]) flds) end, tag)) let mkILSimpleStorageCtorWithParamNames(tag, baseTySpec, ty, extraParams, flds, access) = @@ -3223,7 +3222,7 @@ let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nes implements = impl, layout=ILTypeDefLayout.Auto, extends = Some extends, - methods= methods , + methods= methods, fields= fields, nestedTypes=nestedTypes, customAttrs=attrs, @@ -3305,7 +3304,7 @@ let mkILSimpleModule assemblyName modname dll subsystemVersion useHighEntropyVA //----------------------------------------------------------------------- // [instructions_to_code] makes the basic block structure of code from -// a primitive array of instructions. We +// a primitive array of instructions. We // do this be iterating over the instructions, pushing new basic blocks // everytime we encounter an address that has been recorded // [bbstartToCodeLabelMap]. @@ -3355,12 +3354,12 @@ 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"))) } + 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") //--------------------------------------------------------------------- -// Primitives to help read signatures. These do not use the file cursor, but +// Primitives to help read signatures. These do not use the file cursor, but // pass around an int index //--------------------------------------------------------------------- @@ -3369,7 +3368,7 @@ let sigptr_get_byte bytes sigptr = let sigptr_get_bool bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr - (b0 = 0x01) , sigptr + (b0 = 0x01), sigptr let sigptr_get_u8 bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr @@ -3436,7 +3435,7 @@ let sigptr_get_intarray n (bytes: byte[]) 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 + System.Text.Encoding.UTF8.GetString(intarray, 0, intarray.Length), sigptr let sigptr_get_z_i32 bytes sigptr = let b0, sigptr = sigptr_get_byte bytes sigptr @@ -3452,15 +3451,15 @@ let sigptr_get_z_i32 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 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 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 + else // throw away new_sigptr, getting length & text advance let len, sigptr = sigptr_get_z_i32 bytes sigptr let s, sigptr = sigptr_get_string len bytes sigptr Some(s), sigptr @@ -3478,7 +3477,7 @@ let z_unsigned_int_size n = else 3 let z_unsigned_int n = - if n >= 0 && n <= 0x7F then [| byte 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) @@ -3500,13 +3499,13 @@ let dw3 n = byte ((n >>> 24) &&& 0xFFL) let dw2 n = byte ((n >>> 16) &&& 0xFFL) -let dw1 n = byte ((n >>> 8) &&& 0xFFL) +let dw1 n = byte ((n >>> 8) &&& 0xFFL) -let dw0 n = byte (n &&& 0xFFL) +let dw0 n = byte (n &&& 0xFFL) let u8AsBytes (i: byte) = [| i |] -let u16AsBytes x = let n = (int x) in [| byte (b0 n); byte (b1 n) |] +let u16AsBytes x = let n = (int x) in [| byte (b0 n); byte (b1 n) |] let i32AsBytes i = [| byte (b0 i); byte (b1 i); byte (b2 i); byte (b3 i) |] @@ -3545,20 +3544,20 @@ let et_R8 = 0x0Duy let et_STRING = 0x0Euy let et_PTR = 0x0Fuy let et_BYREF = 0x10uy -let et_VALUETYPE = 0x11uy -let et_CLASS = 0x12uy -let et_VAR = 0x13uy -let et_ARRAY = 0x14uy -let et_WITH = 0x15uy -let et_TYPEDBYREF = 0x16uy -let et_I = 0x18uy -let et_U = 0x19uy -let et_FNPTR = 0x1Buy -let et_OBJECT = 0x1Cuy -let et_SZARRAY = 0x1Duy -let et_MVAR = 0x1Euy -let et_CMOD_REQD = 0x1Fuy -let et_CMOD_OPT = 0x20uy +let et_VALUETYPE = 0x11uy +let et_CLASS = 0x12uy +let et_VAR = 0x13uy +let et_ARRAY = 0x14uy +let et_WITH = 0x15uy +let et_TYPEDBYREF = 0x16uy +let et_I = 0x18uy +let et_U = 0x19uy +let et_FNPTR = 0x1Buy +let et_OBJECT = 0x1Cuy +let et_SZARRAY = 0x1Duy +let et_MVAR = 0x1Euy +let et_CMOD_REQD = 0x1Fuy +let et_CMOD_OPT = 0x20uy let formatILVersion ((a, b, c, d):ILVersionInfo) = sprintf "%d.%d.%d.%d" (int a) (int b) (int c) (int d) @@ -3568,69 +3567,69 @@ let encodeCustomAttrString s = 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 |] - | ILType.Value tspec when tspec.Name = tname_Int16 -> [| et_I2 |] - | ILType.Value tspec when tspec.Name = tname_UInt16 -> [| et_U2 |] - | ILType.Value tspec when tspec.Name = tname_Int32 -> [| et_I4 |] - | ILType.Value tspec when tspec.Name = tname_UInt32 -> [| et_U4 |] - | ILType.Value tspec when tspec.Name = tname_Int64 -> [| et_I8 |] - | ILType.Value tspec when tspec.Name = tname_UInt64 -> [| et_U8 |] - | ILType.Value tspec when tspec.Name = tname_Double -> [| et_R8 |] - | ILType.Value tspec when tspec.Name = tname_Single -> [| et_R4 |] - | 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_Type -> [| 0x50uy |] - | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedName) + | ILType.Value tspec when tspec.Name = tname_SByte -> [| et_I1 |] + | ILType.Value tspec when tspec.Name = tname_Byte -> [| et_U1 |] + | ILType.Value tspec when tspec.Name = tname_Int16 -> [| et_I2 |] + | ILType.Value tspec when tspec.Name = tname_UInt16 -> [| et_U2 |] + | ILType.Value tspec when tspec.Name = tname_Int32 -> [| et_I4 |] + | ILType.Value tspec when tspec.Name = tname_UInt32 -> [| et_U4 |] + | ILType.Value tspec when tspec.Name = tname_Int64 -> [| et_I8 |] + | ILType.Value tspec when tspec.Name = tname_UInt64 -> [| et_U8 |] + | ILType.Value tspec when tspec.Name = tname_Double -> [| et_R8 |] + | ILType.Value tspec when tspec.Name = tname_Single -> [| et_R4 |] + | 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_Type -> [| 0x50uy |] + | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedName) | ILType.Array (shape, elemType) when shape = ILArrayShape.SingleDimensional -> Array.append [| et_SZARRAY |] (encodeCustomAttrElemType elemType) - | _ -> failwith "encodeCustomAttrElemType: unrecognized custom element type" + | _ -> 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 = match x with - | ILAttribElem.String _ -> [| et_STRING |] - | ILAttribElem.Bool _ -> [| et_BOOLEAN |] - | ILAttribElem.Char _ -> [| et_CHAR |] - | ILAttribElem.SByte _ -> [| et_I1 |] - | ILAttribElem.Int16 _ -> [| et_I2 |] - | ILAttribElem.Int32 _ -> [| et_I4 |] - | ILAttribElem.Int64 _ -> [| et_I8 |] - | ILAttribElem.Byte _ -> [| et_U1 |] - | ILAttribElem.UInt16 _ -> [| et_U2 |] - | ILAttribElem.UInt32 _ -> [| et_U4 |] - | ILAttribElem.UInt64 _ -> [| et_U8 |] - | ILAttribElem.Type _ -> [| 0x50uy |] + | ILAttribElem.String _ -> [| et_STRING |] + | ILAttribElem.Bool _ -> [| et_BOOLEAN |] + | ILAttribElem.Char _ -> [| et_CHAR |] + | ILAttribElem.SByte _ -> [| et_I1 |] + | ILAttribElem.Int16 _ -> [| et_I2 |] + | ILAttribElem.Int32 _ -> [| et_I4 |] + | ILAttribElem.Int64 _ -> [| et_I8 |] + | ILAttribElem.Byte _ -> [| et_U1 |] + | ILAttribElem.UInt16 _ -> [| et_U2 |] + | ILAttribElem.UInt32 _ -> [| et_U4 |] + | ILAttribElem.UInt64 _ -> [| et_U8 |] + | ILAttribElem.Type _ -> [| 0x50uy |] | ILAttribElem.TypeRef _ -> [| 0x50uy |] - | ILAttribElem.Null _ -> [| et_STRING |]// yes, the 0xe prefix is used when passing a "null" to a property or argument of type "object" here - | ILAttribElem.Single _ -> [| et_R4 |] - | ILAttribElem.Double _ -> [| et_R8 |] + | ILAttribElem.Null _ -> [| et_STRING |]// yes, the 0xe prefix is used when passing a "null" to a property or argument of type "object" here + | ILAttribElem.Single _ -> [| et_R4 |] + | ILAttribElem.Double _ -> [| et_R8 |] | ILAttribElem.Array (elemTy, _) -> [| yield et_SZARRAY; yield! encodeCustomAttrElemType elemTy |] let rec decodeCustomAttrElemType (ilg: ILGlobals) bytes sigptr x = match x with - | x when x = et_I1 -> ilg.typ_SByte, sigptr + | x when x = et_I1 -> ilg.typ_SByte, sigptr | x when x = et_U1 -> ilg.typ_Byte, sigptr - | x when x = et_I2 -> ilg.typ_Int16, sigptr - | x when x = et_U2 -> ilg.typ_UInt16, sigptr - | x when x = et_I4 -> ilg.typ_Int32, sigptr - | x when x = et_U4 -> ilg.typ_UInt32, sigptr - | x when x = et_I8 -> ilg.typ_Int64, sigptr - | x when x = et_U8 -> ilg.typ_UInt64, sigptr - | x when x = et_R8 -> ilg.typ_Double, sigptr - | x when x = et_R4 -> ilg.typ_Single, sigptr + | x when x = et_I2 -> ilg.typ_Int16, sigptr + | x when x = et_U2 -> ilg.typ_UInt16, sigptr + | x when x = et_I4 -> ilg.typ_Int32, sigptr + | x when x = et_U4 -> ilg.typ_UInt32, sigptr + | x when x = et_I8 -> ilg.typ_Int64, sigptr + | x when x = et_U8 -> ilg.typ_UInt64, sigptr + | x when x = et_R8 -> ilg.typ_Double, sigptr + | x when x = et_R4 -> ilg.typ_Single, sigptr | x when x = et_CHAR -> ilg.typ_Char, sigptr - | 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 -> + | 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 let elemTy, sigptr = decodeCustomAttrElemType ilg bytes sigptr et mkILArr1DTy elemTy, sigptr | x when x = 0x50uy -> ilg.typ_Type, sigptr - | _ -> failwithf "decodeCustomAttrElemType ilg: unrecognized custom element type: %A" x + | _ -> failwithf "decodeCustomAttrElemType ilg: unrecognized custom element type: %A" x /// Given a custom attribute element, encode it to a binary representation according to the rules in Ecma 335 Partition II. @@ -3642,7 +3641,7 @@ let rec encodeCustomAttrPrimValue ilg c = | ILAttribElem.TypeRef None | ILAttribElem.Null -> [| 0xFFuy |] | ILAttribElem.String (Some s) -> encodeCustomAttrString s - | ILAttribElem.Char x -> u16AsBytes (uint16 x) + | ILAttribElem.Char x -> u16AsBytes (uint16 x) | ILAttribElem.SByte x -> i8AsBytes x | ILAttribElem.Int16 x -> i16AsBytes x | ILAttribElem.Int32 x -> i32AsBytes x @@ -3754,7 +3753,7 @@ type ILTypeSigParser(tstring : string) = s // The format we accept is - // "{`[, +]}{}{}" E.g., + // "{`[, +]}{}{}" E.g., // // System.Collections.Generic.Dictionary // `2[ @@ -3768,7 +3767,7 @@ type ILTypeSigParser(tstring : string) = // Still needs testing with jagged arrays and byref parameters member private x.ParseType() = - // Does the type name start with a leading '['? If so, ignore it + // 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() @@ -3829,7 +3828,7 @@ type ILTypeSigParser(tstring : string) = ILScopeRef.Local // strip any extraneous trailing brackets or commas - if (here() = ']') then drop() + if (here() = ']') then drop() if (here() = ',') then drop() // build the IL type @@ -3942,10 +3941,10 @@ let decodeILAttribData (ilg: ILGlobals) (ca: ILAttribute) = parseElems (v ::acc) (n-1) sigptr let elems, sigptr = parseElems [] n sigptr ILAttribElem.Array(elemTy, elems), sigptr - | ILType.Value _ -> (* assume it is an enumeration *) + | 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" + | _ -> failwith "decodeILAttribData: attribute data involves an enum or System.Type value" let rec parseFixed argtys sigptr = match argtys with [] -> [], sigptr @@ -3989,7 +3988,7 @@ let decodeILAttribData (ilg: ILGlobals) (ca: ILAttribute) = // -------------------------------------------------------------------- // Functions to collect up all the references in a full module or -// assembly manifest. The process also allocates +// assembly manifest. The process also allocates // a unique name to each unique internal assembly reference. // -------------------------------------------------------------------- @@ -4007,6 +4006,7 @@ let emptyILRefs = (* Now find references. *) 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 = @@ -4019,7 +4019,7 @@ let refs_of_tref s (x: ILTypeRef) = refs_of_scoref s x.Scope let rec refs_of_typ s x = match x with - | ILType.Void | ILType.TypeVar _ -> () + | ILType.Void | ILType.TypeVar _ -> () | 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 @@ -4027,9 +4027,13 @@ let rec refs_of_typ s x = | ILType.FunctionPointer mref -> refs_of_callsig s mref and refs_of_inst s i = refs_of_tys s i -and refs_of_tspec s (x: ILTypeSpec) = refs_of_tref s x.TypeRef; refs_of_inst s x.GenericArgs -and refs_of_callsig s csig = refs_of_tys s csig.ArgTypes; refs_of_typ s csig.ReturnType + +and refs_of_tspec s (x: ILTypeSpec) = refs_of_tref s x.TypeRef; refs_of_inst s x.GenericArgs + +and refs_of_callsig s csig = refs_of_tys s csig.ArgTypes; refs_of_typ s csig.ReturnType + 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 @@ -4040,7 +4044,9 @@ and refs_of_mref s (x: ILMethodRef) = 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_mspec s (x: ILMethodSpec) = refs_of_mref s x.MethodRef refs_of_typ s x.DeclaringType @@ -4061,7 +4067,9 @@ and refs_of_token s x = 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_instr s x = match x with | I_call (_, mr, varargs) | I_newobj (mr, varargs) | I_callvirt (_, mr, varargs) -> @@ -4072,7 +4080,7 @@ and refs_of_instr s x = refs_of_mspec s mr refs_of_varargs s varargs | I_calli (_, callsig, varargs) -> - refs_of_callsig s callsig; refs_of_varargs s 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) -> @@ -4081,7 +4089,7 @@ and refs_of_instr s x = | 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 + | 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 _ @@ -4089,13 +4097,13 @@ and refs_of_instr s x = | 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_ldnull | AI_dup | AI_pop | AI_ckfinite | AI_nop | AI_ldc _ - | I_seqpoint _ | EI_ldlen_multi _ -> () + | 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) = +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 @@ -4116,29 +4124,29 @@ and refs_of_mbody s x = 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 + 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_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_mdefs s x = Seq.iter (refs_of_mdef s) x and refs_of_event_def s (ed: ILEventDef) = - Option.iter (refs_of_typ s) ed.EventType + 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_events s (x: ILEventDefs) = List.iter (refs_of_event_def s) x.AsList and refs_of_property_def s (pd: ILPropertyDef) = - Option.iter (refs_of_mref s) pd.SetMethod - Option.iter (refs_of_mref s) pd.GetMethod + 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 @@ -4146,35 +4154,35 @@ and refs_of_property_def s (pd: ILPropertyDef) = and refs_of_properties s (x: ILPropertyDefs) = List.iter (refs_of_property_def s) x.AsList and refs_of_fdef s (fd: ILFieldDef) = - refs_of_typ s fd.FieldType - refs_of_custom_attrs s fd.CustomAttrs + 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_impls s mimpls = List.iter (refs_of_method_impl s) mimpls 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_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 + refs_of_genparams s td.GenericParams + refs_of_tys s td.Implements Option.iter (refs_of_typ s) td.Extends - refs_of_mdefs s td.Methods - refs_of_fields s td.Fields.AsList + refs_of_mdefs s td.Methods + refs_of_fields s td.Fields.AsList refs_of_method_impls s td.MethodImpls.AsList - refs_of_events s td.Events - refs_of_tdef_kind s td + refs_of_events s td.Events + refs_of_tdef_kind s td refs_of_custom_attrs s td.CustomAttrs - refs_of_properties s td.Properties + refs_of_properties s td.Properties and refs_of_string _s _ = () -and refs_of_types s (types: ILTypeDefs) = Seq.iter (refs_of_tdef s) types +and refs_of_types s (types: ILTypeDefs) = Seq.iter (refs_of_tdef s) types and refs_of_exported_type s (c: ILExportedTypeOrForwarder) = refs_of_custom_attrs s c.CustomAttrs @@ -4210,7 +4218,7 @@ let computeILRefs modul = 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 } + ModuleReferences = Seq.fold (fun acc x -> x::acc) [] s.refsM } let tspan = System.TimeSpan(System.DateTime.UtcNow.Ticks - System.DateTime(2000, 1, 1).Ticks) @@ -4292,12 +4300,12 @@ let resolveILMethodRefWithRescope r (td: ILTypeDef) (mref: ILMethodRef) = 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 + (md.Parameters, argTypes) ||> List.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) && + // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct + r md.Return.Type = retType) with | [] -> failwith ("no method named "+nm+" with appropriate argument types found in type "+td.Name) - | [mdef] -> mdef + | [mdef] -> mdef | _ -> failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name) let resolveILMethodRef td mref = resolveILMethodRefWithRescope id td mref diff --git a/src/absil/ilbinary.fs b/src/absil/ilbinary.fs index 41297d117ef..2b22b4cbabb 100644 --- a/src/absil/ilbinary.fs +++ b/src/absil/ilbinary.fs @@ -508,155 +508,155 @@ let i_leave = 0xdd let i_leave_s = 0xde let i_stind_i = 0xdf let i_conv_u = 0xe0 -let i_arglist = 0xfe00 -let i_ceq = 0xfe01 -let i_cgt = 0xfe02 +let i_arglist = 0xfe00 +let i_ceq = 0xfe01 +let i_cgt = 0xfe02 let i_cgt_un = 0xfe03 -let i_clt = 0xfe04 +let i_clt = 0xfe04 let i_clt_un = 0xfe05 -let i_ldftn = 0xfe06 -let i_ldvirtftn = 0xfe07 -let i_ldarg = 0xfe09 -let i_ldarga = 0xfe0a -let i_starg = 0xfe0b -let i_ldloc = 0xfe0c -let i_ldloca = 0xfe0d -let i_stloc = 0xfe0e -let i_localloc = 0xfe0f -let i_endfilter = 0xfe11 -let i_unaligned = 0xfe12 -let i_volatile = 0xfe13 -let i_constrained = 0xfe16 -let i_readonly = 0xfe1e -let i_tail = 0xfe14 -let i_initobj = 0xfe15 -let i_cpblk = 0xfe17 -let i_initblk = 0xfe18 -let i_rethrow = 0xfe1a -let i_sizeof = 0xfe1c -let i_refanytype = 0xfe1d - -let i_ldelem_any = 0xa3 -let i_stelem_any = 0xa4 -let i_unbox_any = 0xa5 +let i_ldftn = 0xfe06 +let i_ldvirtftn = 0xfe07 +let i_ldarg = 0xfe09 +let i_ldarga = 0xfe0a +let i_starg = 0xfe0b +let i_ldloc = 0xfe0c +let i_ldloca = 0xfe0d +let i_stloc = 0xfe0e +let i_localloc = 0xfe0f +let i_endfilter = 0xfe11 +let i_unaligned = 0xfe12 +let i_volatile = 0xfe13 +let i_constrained = 0xfe16 +let i_readonly = 0xfe1e +let i_tail = 0xfe14 +let i_initobj = 0xfe15 +let i_cpblk = 0xfe17 +let i_initblk = 0xfe18 +let i_rethrow = 0xfe1a +let i_sizeof = 0xfe1c +let i_refanytype = 0xfe1d +let i_ldelem_any = 0xa3 +let i_stelem_any = 0xa4 +let i_unbox_any = 0xa5 let mk_ldc i = mkLdcInt32 i + let noArgInstrs = - lazy [ i_ldc_i4_0, mk_ldc 0 - i_ldc_i4_1, mk_ldc 1 - i_ldc_i4_2, mk_ldc 2 - i_ldc_i4_3, mk_ldc 3 - i_ldc_i4_4, mk_ldc 4 - i_ldc_i4_5, mk_ldc 5 - i_ldc_i4_6, mk_ldc 6 - i_ldc_i4_7, mk_ldc 7 - i_ldc_i4_8, mk_ldc 8 - i_ldc_i4_m1, mk_ldc -1 - 0x0a, mkStloc 0us - 0x0b, mkStloc 1us - 0x0c, mkStloc 2us - 0x0d, mkStloc 3us - 0x06, mkLdloc 0us - 0x07, mkLdloc 1us - 0x08, mkLdloc 2us - 0x09, mkLdloc 3us - 0x02, mkLdarg 0us - 0x03, mkLdarg 1us - 0x04, mkLdarg 2us - 0x05, mkLdarg 3us - 0x2a, I_ret - 0x58, AI_add - 0xd6, AI_add_ovf - 0xd7, AI_add_ovf_un - 0x5f, AI_and - 0x5b, AI_div - 0x5c, AI_div_un - 0xfe01, AI_ceq - 0xfe02, AI_cgt - 0xfe03, AI_cgt_un - 0xfe04, AI_clt - 0xfe05, AI_clt_un - 0x67, AI_conv DT_I1 - 0x68, AI_conv DT_I2 - 0x69, AI_conv DT_I4 - 0x6a, AI_conv DT_I8 - 0xd3, AI_conv DT_I - 0x6b, AI_conv DT_R4 - 0x6c, AI_conv DT_R8 - 0xd2, AI_conv DT_U1 - 0xd1, AI_conv DT_U2 - 0x6d, AI_conv DT_U4 - 0x6e, AI_conv DT_U8 - 0xe0, AI_conv DT_U - 0x76, AI_conv DT_R - 0xb3, AI_conv_ovf DT_I1 - 0xb5, AI_conv_ovf DT_I2 - 0xb7, AI_conv_ovf DT_I4 - 0xb9, AI_conv_ovf DT_I8 - 0xd4, AI_conv_ovf DT_I - 0xb4, AI_conv_ovf DT_U1 - 0xb6, AI_conv_ovf DT_U2 - 0xb8, AI_conv_ovf DT_U4 - 0xba, AI_conv_ovf DT_U8 - 0xd5, AI_conv_ovf DT_U - 0x82, AI_conv_ovf_un DT_I1 - 0x83, AI_conv_ovf_un DT_I2 - 0x84, AI_conv_ovf_un DT_I4 - 0x85, AI_conv_ovf_un DT_I8 - 0x8a, AI_conv_ovf_un DT_I - 0x86, AI_conv_ovf_un DT_U1 - 0x87, AI_conv_ovf_un DT_U2 - 0x88, AI_conv_ovf_un DT_U4 - 0x89, AI_conv_ovf_un DT_U8 - 0x8b, AI_conv_ovf_un DT_U - 0x9c, I_stelem DT_I1 - 0x9d, I_stelem DT_I2 - 0x9e, I_stelem DT_I4 - 0x9f, I_stelem DT_I8 - 0xa0, I_stelem DT_R4 - 0xa1, I_stelem DT_R8 - 0x9b, I_stelem DT_I - 0xa2, I_stelem DT_REF - 0x90, I_ldelem DT_I1 - 0x92, I_ldelem DT_I2 - 0x94, I_ldelem DT_I4 - 0x96, I_ldelem DT_I8 - 0x91, I_ldelem DT_U1 - 0x93, I_ldelem DT_U2 - 0x95, I_ldelem DT_U4 - 0x98, I_ldelem DT_R4 - 0x99, I_ldelem DT_R8 - 0x97, I_ldelem DT_I - 0x9a, I_ldelem DT_REF - 0x5a, AI_mul - 0xd8, AI_mul_ovf - 0xd9, AI_mul_ovf_un - 0x5d, AI_rem - 0x5e, AI_rem_un - 0x62, AI_shl - 0x63, AI_shr - 0x64, AI_shr_un - 0x59, AI_sub - 0xda, AI_sub_ovf - 0xdb, AI_sub_ovf_un - 0x61, AI_xor - 0x60, AI_or - 0x65, AI_neg - 0x66, AI_not - i_ldnull, AI_ldnull - i_dup, AI_dup - i_pop, AI_pop - i_ckfinite, AI_ckfinite - i_nop, AI_nop - i_break, I_break - i_arglist, I_arglist - i_endfilter, I_endfilter + lazy [ i_ldc_i4_0, mk_ldc 0 + i_ldc_i4_1, mk_ldc 1 + i_ldc_i4_2, mk_ldc 2 + i_ldc_i4_3, mk_ldc 3 + i_ldc_i4_4, mk_ldc 4 + i_ldc_i4_5, mk_ldc 5 + i_ldc_i4_6, mk_ldc 6 + i_ldc_i4_7, mk_ldc 7 + i_ldc_i4_8, mk_ldc 8 + i_ldc_i4_m1, mk_ldc -1 + 0x0a, mkStloc 0us + 0x0b, mkStloc 1us + 0x0c, mkStloc 2us + 0x0d, mkStloc 3us + 0x06, mkLdloc 0us + 0x07, mkLdloc 1us + 0x08, mkLdloc 2us + 0x09, mkLdloc 3us + 0x02, mkLdarg 0us + 0x03, mkLdarg 1us + 0x04, mkLdarg 2us + 0x05, mkLdarg 3us + 0x2a, I_ret + 0x58, AI_add + 0xd6, AI_add_ovf + 0xd7, AI_add_ovf_un + 0x5f, AI_and + 0x5b, AI_div + 0x5c, AI_div_un + 0xfe01, AI_ceq + 0xfe02, AI_cgt + 0xfe03, AI_cgt_un + 0xfe04, AI_clt + 0xfe05, AI_clt_un + 0x67, AI_conv DT_I1 + 0x68, AI_conv DT_I2 + 0x69, AI_conv DT_I4 + 0x6a, AI_conv DT_I8 + 0xd3, AI_conv DT_I + 0x6b, AI_conv DT_R4 + 0x6c, AI_conv DT_R8 + 0xd2, AI_conv DT_U1 + 0xd1, AI_conv DT_U2 + 0x6d, AI_conv DT_U4 + 0x6e, AI_conv DT_U8 + 0xe0, AI_conv DT_U + 0x76, AI_conv DT_R + 0xb3, AI_conv_ovf DT_I1 + 0xb5, AI_conv_ovf DT_I2 + 0xb7, AI_conv_ovf DT_I4 + 0xb9, AI_conv_ovf DT_I8 + 0xd4, AI_conv_ovf DT_I + 0xb4, AI_conv_ovf DT_U1 + 0xb6, AI_conv_ovf DT_U2 + 0xb8, AI_conv_ovf DT_U4 + 0xba, AI_conv_ovf DT_U8 + 0xd5, AI_conv_ovf DT_U + 0x82, AI_conv_ovf_un DT_I1 + 0x83, AI_conv_ovf_un DT_I2 + 0x84, AI_conv_ovf_un DT_I4 + 0x85, AI_conv_ovf_un DT_I8 + 0x8a, AI_conv_ovf_un DT_I + 0x86, AI_conv_ovf_un DT_U1 + 0x87, AI_conv_ovf_un DT_U2 + 0x88, AI_conv_ovf_un DT_U4 + 0x89, AI_conv_ovf_un DT_U8 + 0x8b, AI_conv_ovf_un DT_U + 0x9c, I_stelem DT_I1 + 0x9d, I_stelem DT_I2 + 0x9e, I_stelem DT_I4 + 0x9f, I_stelem DT_I8 + 0xa0, I_stelem DT_R4 + 0xa1, I_stelem DT_R8 + 0x9b, I_stelem DT_I + 0xa2, I_stelem DT_REF + 0x90, I_ldelem DT_I1 + 0x92, I_ldelem DT_I2 + 0x94, I_ldelem DT_I4 + 0x96, I_ldelem DT_I8 + 0x91, I_ldelem DT_U1 + 0x93, I_ldelem DT_U2 + 0x95, I_ldelem DT_U4 + 0x98, I_ldelem DT_R4 + 0x99, I_ldelem DT_R8 + 0x97, I_ldelem DT_I + 0x9a, I_ldelem DT_REF + 0x5a, AI_mul + 0xd8, AI_mul_ovf + 0xd9, AI_mul_ovf_un + 0x5d, AI_rem + 0x5e, AI_rem_un + 0x62, AI_shl + 0x63, AI_shr + 0x64, AI_shr_un + 0x59, AI_sub + 0xda, AI_sub_ovf + 0xdb, AI_sub_ovf_un + 0x61, AI_xor + 0x60, AI_or + 0x65, AI_neg + 0x66, AI_not + i_ldnull, AI_ldnull + i_dup, AI_dup + i_pop, AI_pop + i_ckfinite, AI_ckfinite + i_nop, AI_nop + i_break, I_break + i_arglist, I_arglist + i_endfilter, I_endfilter i_endfinally, I_endfinally i_refanytype, I_refanytype - i_localloc, I_localloc - i_throw, I_throw - i_ldlen, I_ldlen - i_rethrow, I_rethrow ] + i_localloc, I_localloc + i_throw, I_throw + i_ldlen, I_ldlen + i_rethrow, I_rethrow ] let isNoArgInstr i = match i with @@ -760,36 +760,36 @@ let isNoArgInstr i = let ILCmpInstrMap = lazy ( let dict = Dictionary.newWithSize 12 - dict.Add (BI_beq , i_beq ) - dict.Add (BI_bgt , i_bgt ) - dict.Add (BI_bgt_un , i_bgt_un ) - dict.Add (BI_bge , i_bge ) - dict.Add (BI_bge_un , i_bge_un ) - dict.Add (BI_ble , i_ble ) - dict.Add (BI_ble_un , i_ble_un ) - dict.Add (BI_blt , i_blt ) - dict.Add (BI_blt_un , i_blt_un ) - dict.Add (BI_bne_un , i_bne_un ) - dict.Add (BI_brfalse , i_brfalse ) - dict.Add (BI_brtrue , i_brtrue ) + dict.Add (BI_beq, i_beq ) + dict.Add (BI_bgt, i_bgt ) + dict.Add (BI_bgt_un, i_bgt_un ) + dict.Add (BI_bge, i_bge ) + dict.Add (BI_bge_un, i_bge_un ) + dict.Add (BI_ble, i_ble ) + dict.Add (BI_ble_un, i_ble_un ) + dict.Add (BI_blt, i_blt ) + dict.Add (BI_blt_un, i_blt_un ) + dict.Add (BI_bne_un, i_bne_un ) + dict.Add (BI_brfalse, i_brfalse ) + dict.Add (BI_brtrue, i_brtrue ) dict ) let ILCmpInstrRevMap = lazy ( let dict = Dictionary.newWithSize 12 - dict.Add ( BI_beq , i_beq_s ) - dict.Add ( BI_bgt , i_bgt_s ) - dict.Add ( BI_bgt_un , i_bgt_un_s ) - dict.Add ( BI_bge , i_bge_s ) - dict.Add ( BI_bge_un , i_bge_un_s ) - dict.Add ( BI_ble , i_ble_s ) - dict.Add ( BI_ble_un , i_ble_un_s ) - dict.Add ( BI_blt , i_blt_s ) - dict.Add ( BI_blt_un , i_blt_un_s ) - dict.Add ( BI_bne_un , i_bne_un_s ) - dict.Add ( BI_brfalse , i_brfalse_s ) - dict.Add ( BI_brtrue , i_brtrue_s ) + dict.Add ( BI_beq, i_beq_s ) + dict.Add ( BI_bgt, i_bgt_s ) + dict.Add ( BI_bgt_un, i_bgt_un_s ) + dict.Add ( BI_bge, i_bge_s ) + dict.Add ( BI_bge_un, i_bge_un_s ) + dict.Add ( BI_ble, i_ble_s ) + dict.Add ( BI_ble_un, i_ble_un_s ) + dict.Add ( BI_blt, i_blt_s ) + dict.Add ( BI_blt_un, i_blt_un_s ) + dict.Add ( BI_bne_un, i_bne_un_s ) + dict.Add ( BI_brfalse, i_brfalse_s ) + dict.Add ( BI_brtrue, i_brtrue_s ) dict ) @@ -890,106 +890,106 @@ let vt_BYREF = 0x4000 let ILNativeTypeMap = - lazy [ nt_CURRENCY , ILNativeType.Currency - nt_BSTR , (* COM interop *) ILNativeType.BSTR - nt_LPSTR , ILNativeType.LPSTR - nt_LPWSTR , ILNativeType.LPWSTR + lazy [ nt_CURRENCY, ILNativeType.Currency + nt_BSTR, (* COM interop *) ILNativeType.BSTR + nt_LPSTR, ILNativeType.LPSTR + nt_LPWSTR, ILNativeType.LPWSTR nt_LPTSTR, ILNativeType.LPTSTR nt_LPUTF8STR, ILNativeType.LPUTF8STR - nt_IUNKNOWN , (* COM interop *) ILNativeType.IUnknown - nt_IDISPATCH , (* COM interop *) ILNativeType.IDispatch - nt_BYVALSTR , ILNativeType.ByValStr - nt_TBSTR , ILNativeType.TBSTR - nt_LPSTRUCT , ILNativeType.LPSTRUCT - nt_INTF , (* COM interop *) ILNativeType.Interface - nt_STRUCT , ILNativeType.Struct - nt_ERROR , (* COM interop *) ILNativeType.Error - nt_VOID , ILNativeType.Void - nt_BOOLEAN , ILNativeType.Bool - nt_I1 , ILNativeType.Int8 - nt_I2 , ILNativeType.Int16 - nt_I4 , ILNativeType.Int32 + nt_IUNKNOWN, (* COM interop *) ILNativeType.IUnknown + nt_IDISPATCH, (* COM interop *) ILNativeType.IDispatch + nt_BYVALSTR, ILNativeType.ByValStr + nt_TBSTR, ILNativeType.TBSTR + nt_LPSTRUCT, ILNativeType.LPSTRUCT + nt_INTF, (* COM interop *) ILNativeType.Interface + nt_STRUCT, ILNativeType.Struct + nt_ERROR, (* COM interop *) ILNativeType.Error + nt_VOID, ILNativeType.Void + nt_BOOLEAN, ILNativeType.Bool + nt_I1, ILNativeType.Int8 + nt_I2, ILNativeType.Int16 + nt_I4, ILNativeType.Int32 nt_I8, ILNativeType.Int64 - nt_R4 , ILNativeType.Single - nt_R8 , ILNativeType.Double - nt_U1 , ILNativeType.Byte - nt_U2 , ILNativeType.UInt16 - nt_U4 , ILNativeType.UInt32 + nt_R4, ILNativeType.Single + nt_R8, ILNativeType.Double + nt_U1, ILNativeType.Byte + nt_U2, ILNativeType.UInt16 + nt_U4, ILNativeType.UInt32 nt_U8, ILNativeType.UInt64 - nt_INT , ILNativeType.Int + nt_INT, ILNativeType.Int nt_UINT, ILNativeType.UInt nt_ANSIBSTR, (* COM interop *) ILNativeType.ANSIBSTR nt_VARIANTBOOL, (* COM interop *) ILNativeType.VariantBool - nt_FUNC , ILNativeType.Method + nt_FUNC, ILNativeType.Method nt_ASANY, ILNativeType.AsAny ] let ILNativeTypeRevMap = lazy (List.map (fun (x,y) -> (y,x)) (Lazy.force ILNativeTypeMap)) let ILVariantTypeMap = - lazy [ ILNativeVariant.Empty , vt_EMPTY - ILNativeVariant.Null , vt_NULL - ILNativeVariant.Variant , vt_VARIANT - ILNativeVariant.Currency , vt_CY - ILNativeVariant.Decimal , vt_DECIMAL - ILNativeVariant.Date , vt_DATE - ILNativeVariant.BSTR , vt_BSTR - ILNativeVariant.LPSTR , vt_LPSTR - ILNativeVariant.LPWSTR , vt_LPWSTR - ILNativeVariant.IUnknown , vt_UNKNOWN - ILNativeVariant.IDispatch , vt_DISPATCH - ILNativeVariant.SafeArray , vt_SAFEARRAY - ILNativeVariant.Error , vt_ERROR - ILNativeVariant.HRESULT , vt_HRESULT - ILNativeVariant.CArray , vt_CARRAY - ILNativeVariant.UserDefined , vt_USERDEFINED - ILNativeVariant.Record , vt_RECORD - ILNativeVariant.FileTime , vt_FILETIME - ILNativeVariant.Blob , vt_BLOB - ILNativeVariant.Stream , vt_STREAM - ILNativeVariant.Storage , vt_STORAGE - ILNativeVariant.StreamedObject , vt_STREAMED_OBJECT - ILNativeVariant.StoredObject , vt_STORED_OBJECT - ILNativeVariant.BlobObject , vt_BLOB_OBJECT - ILNativeVariant.CF , vt_CF - ILNativeVariant.CLSID , vt_CLSID - ILNativeVariant.Void , vt_VOID - ILNativeVariant.Bool , vt_BOOL - ILNativeVariant.Int8 , vt_I1 - ILNativeVariant.Int16 , vt_I2 - ILNativeVariant.Int32 , vt_I4 - ILNativeVariant.Int64 , vt_I8 - ILNativeVariant.Single , vt_R4 - ILNativeVariant.Double , vt_R8 - ILNativeVariant.UInt8 , vt_UI1 - ILNativeVariant.UInt16 , vt_UI2 - ILNativeVariant.UInt32 , vt_UI4 - ILNativeVariant.UInt64 , vt_UI8 - ILNativeVariant.PTR , vt_PTR - ILNativeVariant.Int , vt_INT - ILNativeVariant.UInt , vt_UINT ] + lazy [ ILNativeVariant.Empty, vt_EMPTY + ILNativeVariant.Null, vt_NULL + ILNativeVariant.Variant, vt_VARIANT + ILNativeVariant.Currency, vt_CY + ILNativeVariant.Decimal, vt_DECIMAL + ILNativeVariant.Date, vt_DATE + ILNativeVariant.BSTR, vt_BSTR + ILNativeVariant.LPSTR, vt_LPSTR + ILNativeVariant.LPWSTR, vt_LPWSTR + ILNativeVariant.IUnknown, vt_UNKNOWN + ILNativeVariant.IDispatch, vt_DISPATCH + ILNativeVariant.SafeArray, vt_SAFEARRAY + ILNativeVariant.Error, vt_ERROR + ILNativeVariant.HRESULT, vt_HRESULT + ILNativeVariant.CArray, vt_CARRAY + ILNativeVariant.UserDefined, vt_USERDEFINED + ILNativeVariant.Record, vt_RECORD + ILNativeVariant.FileTime, vt_FILETIME + ILNativeVariant.Blob, vt_BLOB + ILNativeVariant.Stream, vt_STREAM + ILNativeVariant.Storage, vt_STORAGE + ILNativeVariant.StreamedObject, vt_STREAMED_OBJECT + ILNativeVariant.StoredObject, vt_STORED_OBJECT + ILNativeVariant.BlobObject, vt_BLOB_OBJECT + ILNativeVariant.CF, vt_CF + ILNativeVariant.CLSID, vt_CLSID + ILNativeVariant.Void, vt_VOID + ILNativeVariant.Bool, vt_BOOL + ILNativeVariant.Int8, vt_I1 + ILNativeVariant.Int16, vt_I2 + ILNativeVariant.Int32, vt_I4 + ILNativeVariant.Int64, vt_I8 + ILNativeVariant.Single, vt_R4 + ILNativeVariant.Double, vt_R8 + ILNativeVariant.UInt8, vt_UI1 + ILNativeVariant.UInt16, vt_UI2 + ILNativeVariant.UInt32, vt_UI4 + ILNativeVariant.UInt64, vt_UI8 + ILNativeVariant.PTR, vt_PTR + ILNativeVariant.Int, vt_INT + ILNativeVariant.UInt, vt_UINT ] let ILVariantTypeRevMap = lazy (List.map (fun (x,y) -> (y,x)) (Lazy.force ILVariantTypeMap)) let ILSecurityActionMap = lazy - [ ILSecurityAction.Request , 0x0001 - ILSecurityAction.Demand , 0x0002 - ILSecurityAction.Assert , 0x0003 - ILSecurityAction.Deny , 0x0004 - ILSecurityAction.PermitOnly , 0x0005 - ILSecurityAction.LinkCheck , 0x0006 - ILSecurityAction.InheritCheck , 0x0007 - ILSecurityAction.ReqMin , 0x0008 - ILSecurityAction.ReqOpt , 0x0009 - ILSecurityAction.ReqRefuse , 0x000a - ILSecurityAction.PreJitGrant , 0x000b - ILSecurityAction.PreJitDeny , 0x000c - ILSecurityAction.NonCasDemand , 0x000d - ILSecurityAction.NonCasLinkDemand , 0x000e - ILSecurityAction.NonCasInheritance , 0x000f - ILSecurityAction.LinkDemandChoice , 0x0010 - ILSecurityAction.InheritanceDemandChoice , 0x0011 - ILSecurityAction.DemandChoice , 0x0012 ] + [ ILSecurityAction.Request, 0x0001 + ILSecurityAction.Demand, 0x0002 + ILSecurityAction.Assert, 0x0003 + ILSecurityAction.Deny, 0x0004 + ILSecurityAction.PermitOnly, 0x0005 + ILSecurityAction.LinkCheck, 0x0006 + ILSecurityAction.InheritCheck, 0x0007 + ILSecurityAction.ReqMin, 0x0008 + ILSecurityAction.ReqOpt, 0x0009 + ILSecurityAction.ReqRefuse, 0x000a + ILSecurityAction.PreJitGrant, 0x000b + ILSecurityAction.PreJitDeny, 0x000c + ILSecurityAction.NonCasDemand, 0x000d + ILSecurityAction.NonCasLinkDemand, 0x000e + ILSecurityAction.NonCasInheritance, 0x000f + ILSecurityAction.LinkDemandChoice, 0x0010 + ILSecurityAction.InheritanceDemandChoice, 0x0011 + ILSecurityAction.DemandChoice, 0x0012 ] let ILSecurityActionRevMap = lazy (List.map (fun (x,y) -> (y,x)) (Lazy.force ILSecurityActionMap)) diff --git a/src/absil/illib.fs b/src/absil/illib.fs index 71946a24910..da0b39dfb1c 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -1348,9 +1348,9 @@ module Shim = member __.FileStreamReadShim (fileName: string) = new FileStream(fileName, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) :> Stream - member __.FileStreamCreateShim (fileName: string) = new FileStream(fileName, FileMode.Create, FileAccess.Write, FileShare.Read , 0x1000, false) :> Stream + member __.FileStreamCreateShim (fileName: string) = new FileStream(fileName, FileMode.Create, FileAccess.Write, FileShare.Read, 0x1000, false) :> Stream - member __.FileStreamWriteExistingShim (fileName: string) = new FileStream(fileName, FileMode.Open, FileAccess.Write, FileShare.Read , 0x1000, false) :> Stream + member __.FileStreamWriteExistingShim (fileName: string) = new FileStream(fileName, FileMode.Open, FileAccess.Write, FileShare.Read, 0x1000, false) :> Stream member __.GetFullPathShim (fileName: string) = System.IO.Path.GetFullPath fileName diff --git a/src/absil/ilmorph.fs b/src/absil/ilmorph.fs index 1281007041a..ffd86aa504b 100644 --- a/src/absil/ilmorph.fs +++ b/src/absil/ilmorph.fs @@ -113,7 +113,7 @@ let mref_ty2ty (f: ILType -> ILType) (x:ILMethodRef) = type formal_scopeCtxt = Choice -let mspec_ty2ty (((factualty : ILType -> ILType) , (fformalty: formal_scopeCtxt -> ILType -> ILType))) (x: ILMethodSpec) = +let mspec_ty2ty (((factualty : ILType -> ILType), (fformalty: formal_scopeCtxt -> ILType -> ILType))) (x: ILMethodSpec) = mkILMethSpecForMethRefInTy(mref_ty2ty (fformalty (Choice1Of2 x)) x.MethodRef, factualty x.DeclaringType, tys_ty2ty factualty x.GenericArgs) diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index 7bb25a58363..165f97948dd 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. //--------------------------------------------------------------------- // The big binary reader @@ -50,7 +50,7 @@ let align alignment n = ((n + alignment - 0x1) / alignment) * alignment let uncodedToken (tab: TableName) idx = ((tab.Index <<< 24) ||| idx) -let i32ToUncodedToken tok = +let i32ToUncodedToken tok = let idx = tok &&& 0xffffff let tab = tok >>>& 24 (TableName.FromIndex tab, idx) @@ -107,8 +107,8 @@ let stats = let GetStatistics() = stats [] -/// An abstraction over how we access the contents of .NET binaries. May be backed by managed or unmanaged memory, -/// memory mapped file or by on-disk resources. These objects should never need explicit disposal - they must either +/// An abstraction over how we access the contents of .NET binaries. May be backed by managed or unmanaged memory, +/// memory mapped file or by on-disk resources. These objects should never need explicit disposal - they must either /// not hold resources of clean up after themselves when collected. type BinaryView() = @@ -130,11 +130,11 @@ type BinaryView() = /// Read a UTF8 string from the file abstract ReadUTF8String: addr: int -> string -/// An abstraction over how we access the contents of .NET binaries. May be backed by managed or unmanaged memory, +/// An abstraction over how we access the contents of .NET binaries. May be backed by managed or unmanaged memory, /// memory mapped file or by on-disk resources. type BinaryFile = /// Return a BinaryView for temporary use which eagerly holds any necessary memory resources for the duration of its lifetime, - /// and is faster to access byte-by-byte. The returned BinaryView should _not_ be captured in a closure that outlives the + /// and is faster to access byte-by-byte. The returned BinaryView should _not_ be captured in a closure that outlives the /// desired lifetime. abstract GetView: unit -> BinaryView @@ -191,7 +191,7 @@ type RawMemoryFile(fileName: string, obj: obj, addr: nativeint, length: int) = module MemoryMapping = type HANDLE = nativeint - type ADDR = nativeint + type ADDR = nativeint type SIZE_T = nativeint [] @@ -216,25 +216,25 @@ module MemoryMapping = [] extern ADDR MapViewOfFile (HANDLE _hFileMappingObject, - int _dwDesiredAccess, - int _dwFileOffsetHigh, - int _dwFileOffsetLow, + int _dwDesiredAccess, + int _dwFileOffsetHigh, + int _dwFileOffsetLow, SIZE_T _dwNumBytesToMap) [] extern bool UnmapViewOfFile (ADDR _lpBaseAddress) let INVALID_HANDLE = new IntPtr(-1) - let MAP_READ = 0x0004 + let MAP_READ = 0x0004 let GENERIC_READ = 0x80000000 let NULL_HANDLE = IntPtr.Zero let FILE_SHARE_NONE = 0x0000 let FILE_SHARE_READ = 0x0001 let FILE_SHARE_WRITE = 0x0002 let FILE_SHARE_READ_WRITE = 0x0003 - let CREATE_ALWAYS = 0x0002 - let OPEN_EXISTING = 0x0003 - let OPEN_ALWAYS = 0x0004 + let CREATE_ALWAYS = 0x0002 + let OPEN_EXISTING = 0x0003 + let OPEN_ALWAYS = 0x0004 /// A view over a raw pointer to memory given by a memory mapped file. /// NOTE: we should do more checking of validity here. @@ -274,8 +274,8 @@ type MemoryMapFile(fileName: string, view: MemoryMapView, hMap: MemoryMapping.HA do stats.memoryMapFileOpenedCount <- stats.memoryMapFileOpenedCount + 1 let mutable closed = false - static member Create fileName = - let hFile = MemoryMapping.CreateFile (fileName, MemoryMapping.GENERIC_READ, MemoryMapping.FILE_SHARE_READ_WRITE, IntPtr.Zero, MemoryMapping.OPEN_EXISTING, 0, IntPtr.Zero ) + static member Create fileName = + let hFile = MemoryMapping.CreateFile (fileName, MemoryMapping.GENERIC_READ, MemoryMapping.FILE_SHARE_READ_WRITE, IntPtr.Zero, MemoryMapping.OPEN_EXISTING, 0, IntPtr.Zero ) if hFile.Equals(MemoryMapping.INVALID_HANDLE) then failwithf "CreateFile(0x%08x)" (Marshal.GetHRForLastWin32Error()) let protection = 0x00000002 @@ -345,7 +345,7 @@ type ByteFile(fileName: string, bytes: byte[]) = override bf.GetView() = view :> BinaryView /// Same as ByteFile but holds the bytes weakly. The bytes will be re-read from the backing file when a view is requested. -/// This is the default implementation used by F# Compiler Services when accessing "stable" binaries. It is not used +/// This is the default implementation used by F# Compiler Services when accessing "stable" binaries. It is not used /// by Visual Studio, where tryGetMetadataSnapshot provides a RawMemoryFile backed by Roslyn data. [] type WeakByteFile(fileName: string, chunk: (int * int) option) = @@ -442,14 +442,14 @@ let seekReadUserString mdv addr = let bytes = seekReadBytes mdv addr (len - 1) Encoding.Unicode.GetString(bytes, 0, bytes.Length) -let seekReadGuid mdv addr = seekReadBytes mdv addr 0x10 +let seekReadGuid mdv addr = seekReadBytes mdv addr 0x10 -let seekReadUncodedToken mdv addr = +let seekReadUncodedToken mdv addr = i32ToUncodedToken (seekReadInt32 mdv addr) //--------------------------------------------------------------------- -// Primitives to help read signatures. These do not use the file cursor +// Primitives to help read signatures. These do not use the file cursor //--------------------------------------------------------------------- let sigptrCheck (bytes: byte[]) sigptr = @@ -467,7 +467,7 @@ let sigptrGetByte (bytes: byte[]) sigptr = let sigptrGetBool bytes sigptr = let b0, sigptr = sigptrGetByte bytes sigptr - (b0 = 0x01uy) , sigptr + (b0 = 0x01uy), sigptr let sigptrGetSByte bytes sigptr = let i, sigptr = sigptrGetByte bytes sigptr @@ -524,7 +524,7 @@ let sigptrGetZInt32 bytes sigptr = let b1, sigptr = sigptrGetByte bytes sigptr let b2, sigptr = sigptrGetByte bytes sigptr let b3, sigptr = sigptrGetByte bytes sigptr - (int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, sigptr + (int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, sigptr let rec sigptrFoldAcc f n (bytes: byte[]) (sigptr: int) i acc = if i < n then @@ -618,8 +618,8 @@ type ILInstrDecoder = | I_r8_instr of (ILInstrPrefixesRegister -> double -> ILInstr) | I_field_instr of (ILInstrPrefixesRegister -> ILFieldSpec -> ILInstr) | I_method_instr of (ILInstrPrefixesRegister -> ILMethodSpec * ILVarArgs -> ILInstr) - | I_unconditional_i32_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr) - | I_unconditional_i8_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr) + | I_unconditional_i32_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr) + | I_unconditional_i8_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr) | I_conditional_i32_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr) | I_conditional_i8_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr) | I_string_instr of (ILInstrPrefixesRegister -> string -> ILInstr) @@ -633,19 +633,19 @@ let mkStind dt = volatileOrUnalignedPrefix (fun (x, y) -> I_stind(x, y, dt)) let mkLdind dt = volatileOrUnalignedPrefix (fun (x, y) -> I_ldind(x, y, dt)) let instrs () = - [ i_ldarg_s, I_u16_u8_instr (noPrefixes mkLdarg) - i_starg_s, I_u16_u8_instr (noPrefixes I_starg) + [ i_ldarg_s, I_u16_u8_instr (noPrefixes mkLdarg) + i_starg_s, I_u16_u8_instr (noPrefixes I_starg) i_ldarga_s, I_u16_u8_instr (noPrefixes I_ldarga) - i_stloc_s, I_u16_u8_instr (noPrefixes mkStloc) - i_ldloc_s, I_u16_u8_instr (noPrefixes mkLdloc) + i_stloc_s, I_u16_u8_instr (noPrefixes mkStloc) + i_ldloc_s, I_u16_u8_instr (noPrefixes mkLdloc) i_ldloca_s, I_u16_u8_instr (noPrefixes I_ldloca) - i_ldarg, I_u16_u16_instr (noPrefixes mkLdarg) - i_starg, I_u16_u16_instr (noPrefixes I_starg) - i_ldarga, I_u16_u16_instr (noPrefixes I_ldarga) - i_stloc, I_u16_u16_instr (noPrefixes mkStloc) - i_ldloc, I_u16_u16_instr (noPrefixes mkLdloc) - i_ldloca, I_u16_u16_instr (noPrefixes I_ldloca) - i_stind_i, I_none_instr (mkStind DT_I) + i_ldarg, I_u16_u16_instr (noPrefixes mkLdarg) + i_starg, I_u16_u16_instr (noPrefixes I_starg) + i_ldarga, I_u16_u16_instr (noPrefixes I_ldarga) + i_stloc, I_u16_u16_instr (noPrefixes mkStloc) + i_ldloc, I_u16_u16_instr (noPrefixes mkLdloc) + i_ldloca, I_u16_u16_instr (noPrefixes I_ldloca) + i_stind_i, I_none_instr (mkStind DT_I) i_stind_i1, I_none_instr (mkStind DT_I1) i_stind_i2, I_none_instr (mkStind DT_I2) i_stind_i4, I_none_instr (mkStind DT_I4) @@ -653,7 +653,7 @@ let instrs () = i_stind_r4, I_none_instr (mkStind DT_R4) i_stind_r8, I_none_instr (mkStind DT_R8) i_stind_ref, I_none_instr (mkStind DT_REF) - i_ldind_i, I_none_instr (mkLdind DT_I) + i_ldind_i, I_none_instr (mkLdind DT_I) i_ldind_i1, I_none_instr (mkLdind DT_I1) i_ldind_i2, I_none_instr (mkLdind DT_I2) i_ldind_i4, I_none_instr (mkLdind DT_I4) @@ -672,7 +672,7 @@ let instrs () = 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_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) @@ -741,7 +741,7 @@ let fillInstrs () = let addInstr (i, f) = if i > 0xff then assert (i >>>& 8 = 0xfe) - let i = (i &&& 0xff) + let i = (i &&& 0xff) match twoByteInstrTable.[i] with | I_invalid_instr -> () | _ -> dprintn ("warning: duplicate decode entries for "+string i) @@ -773,7 +773,7 @@ let rec getTwoByteInstr i = type ImageChunk = { size: int32; addr: int32 } let chunk sz next = ({addr=next; size=sz}, next + sz) -let nochunk next = ({addr= 0x0;size= 0x0; } , next) +let nochunk next = ({addr= 0x0;size= 0x0; }, next) type RowElementKind = | UShort @@ -800,47 +800,47 @@ type RowElementKind = type RowKind = RowKind of RowElementKind list -let kindAssemblyRef = RowKind [ UShort; UShort; UShort; UShort; ULong; Blob; SString; SString; Blob; ] -let kindModuleRef = RowKind [ SString ] -let kindFileRef = RowKind [ ULong; SString; Blob ] -let kindTypeRef = RowKind [ ResolutionScope; SString; SString ] -let kindTypeSpec = RowKind [ Blob ] -let kindTypeDef = RowKind [ ULong; SString; SString; TypeDefOrRefOrSpec; SimpleIndex TableNames.Field; SimpleIndex TableNames.Method ] -let kindPropertyMap = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.Property ] -let kindEventMap = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.Event ] -let kindInterfaceImpl = RowKind [ SimpleIndex TableNames.TypeDef; TypeDefOrRefOrSpec ] -let kindNested = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.TypeDef ] -let kindCustomAttribute = RowKind [ HasCustomAttribute; CustomAttributeType; Blob ] -let kindDeclSecurity = RowKind [ UShort; HasDeclSecurity; Blob ] -let kindMemberRef = RowKind [ MemberRefParent; SString; Blob ] -let kindStandAloneSig = RowKind [ Blob ] -let kindFieldDef = RowKind [ UShort; SString; Blob ] -let kindFieldRVA = RowKind [ Data; SimpleIndex TableNames.Field ] -let kindFieldMarshal = RowKind [ HasFieldMarshal; Blob ] -let kindConstant = RowKind [ UShort;HasConstant; Blob ] -let kindFieldLayout = RowKind [ ULong; SimpleIndex TableNames.Field ] -let kindParam = RowKind [ UShort; UShort; SString ] -let kindMethodDef = RowKind [ ULong; UShort; UShort; SString; Blob; SimpleIndex TableNames.Param ] -let kindMethodImpl = RowKind [ SimpleIndex TableNames.TypeDef; MethodDefOrRef; MethodDefOrRef ] -let kindImplMap = RowKind [ UShort; MemberForwarded; SString; SimpleIndex TableNames.ModuleRef ] -let kindMethodSemantics = RowKind [ UShort; SimpleIndex TableNames.Method; HasSemantics ] -let kindProperty = RowKind [ UShort; SString; Blob ] -let kindEvent = RowKind [ UShort; SString; TypeDefOrRefOrSpec ] -let kindManifestResource = RowKind [ ULong; ULong; SString; Implementation ] -let kindClassLayout = RowKind [ UShort; ULong; SimpleIndex TableNames.TypeDef ] -let kindExportedType = RowKind [ ULong; ULong; SString; SString; Implementation ] -let kindAssembly = RowKind [ ULong; UShort; UShort; UShort; UShort; ULong; Blob; SString; SString ] -let kindGenericParam_v1_1 = RowKind [ UShort; UShort; TypeOrMethodDef; SString; TypeDefOrRefOrSpec ] -let kindGenericParam_v2_0 = RowKind [ UShort; UShort; TypeOrMethodDef; SString ] -let kindMethodSpec = RowKind [ MethodDefOrRef; Blob ] +let kindAssemblyRef = RowKind [ UShort; UShort; UShort; UShort; ULong; Blob; SString; SString; Blob; ] +let kindModuleRef = RowKind [ SString ] +let kindFileRef = RowKind [ ULong; SString; Blob ] +let kindTypeRef = RowKind [ ResolutionScope; SString; SString ] +let kindTypeSpec = RowKind [ Blob ] +let kindTypeDef = RowKind [ ULong; SString; SString; TypeDefOrRefOrSpec; SimpleIndex TableNames.Field; SimpleIndex TableNames.Method ] +let kindPropertyMap = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.Property ] +let kindEventMap = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.Event ] +let kindInterfaceImpl = RowKind [ SimpleIndex TableNames.TypeDef; TypeDefOrRefOrSpec ] +let kindNested = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.TypeDef ] +let kindCustomAttribute = RowKind [ HasCustomAttribute; CustomAttributeType; Blob ] +let kindDeclSecurity = RowKind [ UShort; HasDeclSecurity; Blob ] +let kindMemberRef = RowKind [ MemberRefParent; SString; Blob ] +let kindStandAloneSig = RowKind [ Blob ] +let kindFieldDef = RowKind [ UShort; SString; Blob ] +let kindFieldRVA = RowKind [ Data; SimpleIndex TableNames.Field ] +let kindFieldMarshal = RowKind [ HasFieldMarshal; Blob ] +let kindConstant = RowKind [ UShort;HasConstant; Blob ] +let kindFieldLayout = RowKind [ ULong; SimpleIndex TableNames.Field ] +let kindParam = RowKind [ UShort; UShort; SString ] +let kindMethodDef = RowKind [ ULong; UShort; UShort; SString; Blob; SimpleIndex TableNames.Param ] +let kindMethodImpl = RowKind [ SimpleIndex TableNames.TypeDef; MethodDefOrRef; MethodDefOrRef ] +let kindImplMap = RowKind [ UShort; MemberForwarded; SString; SimpleIndex TableNames.ModuleRef ] +let kindMethodSemantics = RowKind [ UShort; SimpleIndex TableNames.Method; HasSemantics ] +let kindProperty = RowKind [ UShort; SString; Blob ] +let kindEvent = RowKind [ UShort; SString; TypeDefOrRefOrSpec ] +let kindManifestResource = RowKind [ ULong; ULong; SString; Implementation ] +let kindClassLayout = RowKind [ UShort; ULong; SimpleIndex TableNames.TypeDef ] +let kindExportedType = RowKind [ ULong; ULong; SString; SString; Implementation ] +let kindAssembly = RowKind [ ULong; UShort; UShort; UShort; UShort; ULong; Blob; SString; SString ] +let kindGenericParam_v1_1 = RowKind [ UShort; UShort; TypeOrMethodDef; SString; TypeDefOrRefOrSpec ] +let kindGenericParam_v2_0 = RowKind [ UShort; UShort; TypeOrMethodDef; SString ] +let kindMethodSpec = RowKind [ MethodDefOrRef; Blob ] let kindGenericParamConstraint = RowKind [ SimpleIndex TableNames.GenericParam; TypeDefOrRefOrSpec ] -let kindModule = RowKind [ UShort; SString; GGuid; GGuid; GGuid ] -let kindIllegal = RowKind [ ] +let kindModule = RowKind [ UShort; SString; GGuid; GGuid; GGuid ] +let kindIllegal = RowKind [ ] //--------------------------------------------------------------------- -// Used for binary searches of sorted tables. Each function that reads +// Used for binary searches of sorted tables. Each function that reads // a table row returns a tuple that contains the elements of the row. -// One of these elements may be a key for a sorted table. These +// One of these elements may be a key for a sorted table. These // keys can be compared using the functions below depending on the // kind of element in that column. //--------------------------------------------------------------------- @@ -879,8 +879,8 @@ type BlobAsMethodSigIdx = BlobAsMethodSigIdx of int * int32 type BlobAsFieldSigIdx = BlobAsFieldSigIdx of int * int32 type BlobAsPropSigIdx = BlobAsPropSigIdx of int * int32 type BlobAsLocalSigIdx = BlobAsLocalSigIdx of int * int32 -type MemberRefAsMspecIdx = MemberRefAsMspecIdx of int * int -type MethodSpecAsMspecIdx = MethodSpecAsMspecIdx of int * int +type MemberRefAsMspecIdx = MemberRefAsMspecIdx of int * int +type MethodSpecAsMspecIdx = MethodSpecAsMspecIdx of int * int type MemberRefAsFspecIdx = MemberRefAsFspecIdx of int * int type CustomAttrIdx = CustomAttrIdx of CustomAttributeTypeTag * int * int32 type GenericParamsIdx = GenericParamsIdx of int * TypeOrMethodDefTag * int @@ -889,7 +889,7 @@ type GenericParamsIdx = GenericParamsIdx of int * TypeOrMethodDefTag * int // Polymorphic caches for row and heap readers //--------------------------------------------------------------------- -let mkCacheInt32 lowMem _inbase _nm _sz = +let mkCacheInt32 lowMem _inbase _nm _sz = if lowMem then (fun f x -> f x) else let cache = ref null let count = ref 0 @@ -899,7 +899,7 @@ let mkCacheInt32 lowMem _inbase _nm _sz = fun f (idx: int32) -> let cache = match !cache with - | null -> cache := new Dictionary(11) + | null -> cache := new Dictionary(11) | _ -> () !cache let mutable res = Unchecked.defaultof<_> @@ -912,7 +912,7 @@ let mkCacheInt32 lowMem _inbase _nm _sz = cache.[idx] <- res res -let mkCacheGeneric lowMem _inbase _nm _sz = +let mkCacheGeneric lowMem _inbase _nm _sz = if lowMem then (fun f x -> f x) else let cache = ref null let count = ref 0 @@ -940,7 +940,7 @@ let mkCacheGeneric lowMem _inbase _nm _sz = let seekFindRow numRows rowChooser = let mutable i = 1 - while (i <= numRows && not (rowChooser i)) do + while (i <= numRows && not (rowChooser i)) do i <- i + 1 if i > numRows then dprintn "warning: seekFindRow: row not found" i @@ -953,7 +953,7 @@ let seekReadIndexedRows (numRows, rowReader, keyFunc, keyComparer, binaryChop, r begin let mutable fin = false while not fin do - if high - low <= 1 then + if high - low <= 1 then fin <- true else let mid = (low + high) / 2 @@ -1169,18 +1169,18 @@ let seekReadUntaggedIdx (tab: TableName) (ctxt: ILMetadataReader) mdv (addr: byr seekReadIdx ctxt.tableBigness.[tab.Index] mdv &addr -let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv &addr -let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv &addr -let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv &addr -let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv &addr -let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv &addr -let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv &addr -let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv &addr -let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv &addr -let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv &addr -let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv &addr -let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv &addr -let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv &addr +let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv &addr +let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv &addr +let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv &addr +let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv &addr +let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv &addr +let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv &addr +let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv &addr +let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv &addr +let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv &addr +let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv &addr +let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv &addr +let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv &addr let seekReadCustomAttributeTypeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkILCustomAttributeTypeTag 3 ctxt.catBigness mdv &addr let seekReadStringIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadIdx ctxt.stringsBigness mdv &addr let seekReadGuidIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadIdx ctxt.guidsBigness mdv &addr @@ -1205,7 +1205,7 @@ let seekReadTypeRefRow (ctxt: ILMetadataReader) mdv idx = (scopeIdx, nameIdx, namespaceIdx) /// Read Table ILTypeDef. -let seekReadTypeDefRow (ctxt: ILMetadataReader) idx = ctxt.seekReadTypeDefRow idx +let seekReadTypeDefRow (ctxt: ILMetadataReader) idx = ctxt.seekReadTypeDefRow idx let seekReadTypeDefRowUncached ctxtH idx = let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() @@ -1219,7 +1219,7 @@ let seekReadTypeDefRowUncached ctxtH idx = (flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) /// Read Table Field. -let seekReadFieldRow (ctxt: ILMetadataReader) mdv idx = +let seekReadFieldRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.Field idx let flags = seekReadUInt16AsInt32Adv mdv &addr let nameIdx = seekReadStringIdx ctxt mdv &addr @@ -1227,7 +1227,7 @@ let seekReadFieldRow (ctxt: ILMetadataReader) mdv idx = (flags, nameIdx, typeIdx) /// Read Table Method. -let seekReadMethodRow (ctxt: ILMetadataReader) mdv idx = +let seekReadMethodRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.Method idx let codeRVA = seekReadInt32Adv mdv &addr let implflags = seekReadUInt16AsInt32Adv mdv &addr @@ -1238,22 +1238,22 @@ let seekReadMethodRow (ctxt: ILMetadataReader) mdv idx = (codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) /// Read Table Param. -let seekReadParamRow (ctxt: ILMetadataReader) mdv idx = +let seekReadParamRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.Param idx let flags = seekReadUInt16AsInt32Adv mdv &addr - let seq = seekReadUInt16AsInt32Adv mdv &addr + let seq = seekReadUInt16AsInt32Adv mdv &addr let nameIdx = seekReadStringIdx ctxt mdv &addr (flags, seq, nameIdx) /// Read Table InterfaceImpl. -let seekReadInterfaceImplRow (ctxt: ILMetadataReader) mdv idx = +let seekReadInterfaceImplRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr let intfIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr (tidx, intfIdx) /// Read Table MemberRef. -let seekReadMemberRefRow (ctxt: ILMetadataReader) mdv idx = +let seekReadMemberRefRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.MemberRef idx let mrpIdx = seekReadMemberRefParentIdx ctxt mdv &addr let nameIdx = seekReadStringIdx ctxt mdv &addr @@ -1261,9 +1261,9 @@ let seekReadMemberRefRow (ctxt: ILMetadataReader) mdv idx = (mrpIdx, nameIdx, typeIdx) /// Read Table Constant. -let seekReadConstantRow (ctxt: ILMetadataReader) idx = ctxt.seekReadConstantRow idx +let seekReadConstantRow (ctxt: ILMetadataReader) idx = ctxt.seekReadConstantRow idx let seekReadConstantRowUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let mutable addr = ctxt.rowAddr TableNames.Constant idx let kind = seekReadUInt16Adv mdv &addr @@ -1272,7 +1272,7 @@ let seekReadConstantRowUncached ctxtH idx = (kind, parentIdx, valIdx) /// Read Table CustomAttribute. -let seekReadCustomAttributeRow (ctxt: ILMetadataReader) idx = +let seekReadCustomAttributeRow (ctxt: ILMetadataReader) idx = let mdv = ctxt.mdfile.GetView() let mutable addr = ctxt.rowAddr TableNames.CustomAttribute idx let parentIdx = seekReadHasCustomAttributeIdx ctxt mdv &addr @@ -1281,14 +1281,14 @@ let seekReadCustomAttributeRow (ctxt: ILMetadataReader) idx = (parentIdx, typeIdx, valIdx) /// Read Table FieldMarshal. -let seekReadFieldMarshalRow (ctxt: ILMetadataReader) mdv idx = +let seekReadFieldMarshalRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.FieldMarshal idx let parentIdx = seekReadHasFieldMarshalIdx ctxt mdv &addr let typeIdx = seekReadBlobIdx ctxt mdv &addr (parentIdx, typeIdx) /// Read Table Permission. -let seekReadPermissionRow (ctxt: ILMetadataReader) mdv idx = +let seekReadPermissionRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.Permission idx let action = seekReadUInt16Adv mdv &addr let parentIdx = seekReadHasDeclSecurityIdx ctxt mdv &addr @@ -1296,7 +1296,7 @@ let seekReadPermissionRow (ctxt: ILMetadataReader) mdv idx = (action, parentIdx, typeIdx) /// Read Table ClassLayout. -let seekReadClassLayoutRow (ctxt: ILMetadataReader) mdv idx = +let seekReadClassLayoutRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.ClassLayout idx let pack = seekReadUInt16Adv mdv &addr let size = seekReadInt32Adv mdv &addr @@ -1304,27 +1304,27 @@ let seekReadClassLayoutRow (ctxt: ILMetadataReader) mdv idx = (pack, size, tidx) /// Read Table FieldLayout. -let seekReadFieldLayoutRow (ctxt: ILMetadataReader) mdv idx = +let seekReadFieldLayoutRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.FieldLayout idx let offset = seekReadInt32Adv mdv &addr let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr (offset, fidx) //// Read Table StandAloneSig. -let seekReadStandAloneSigRow (ctxt: ILMetadataReader) mdv idx = +let seekReadStandAloneSigRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.StandAloneSig idx let sigIdx = seekReadBlobIdx ctxt mdv &addr sigIdx /// Read Table EventMap. -let seekReadEventMapRow (ctxt: ILMetadataReader) mdv idx = +let seekReadEventMapRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.EventMap idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr let eventsIdx = seekReadUntaggedIdx TableNames.Event ctxt mdv &addr (tidx, eventsIdx) /// Read Table Event. -let seekReadEventRow (ctxt: ILMetadataReader) mdv idx = +let seekReadEventRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.Event idx let flags = seekReadUInt16AsInt32Adv mdv &addr let nameIdx = seekReadStringIdx ctxt mdv &addr @@ -1332,14 +1332,14 @@ let seekReadEventRow (ctxt: ILMetadataReader) mdv idx = (flags, nameIdx, typIdx) /// Read Table PropertyMap. -let seekReadPropertyMapRow (ctxt: ILMetadataReader) mdv idx = +let seekReadPropertyMapRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.PropertyMap idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr let propsIdx = seekReadUntaggedIdx TableNames.Property ctxt mdv &addr (tidx, propsIdx) /// Read Table Property. -let seekReadPropertyRow (ctxt: ILMetadataReader) mdv idx = +let seekReadPropertyRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.Property idx let flags = seekReadUInt16AsInt32Adv mdv &addr let nameIdx = seekReadStringIdx ctxt mdv &addr @@ -1347,9 +1347,9 @@ let seekReadPropertyRow (ctxt: ILMetadataReader) mdv idx = (flags, nameIdx, typIdx) /// Read Table MethodSemantics. -let seekReadMethodSemanticsRow (ctxt: ILMetadataReader) idx = ctxt.seekReadMethodSemanticsRow idx +let seekReadMethodSemanticsRow (ctxt: ILMetadataReader) idx = ctxt.seekReadMethodSemanticsRow idx let seekReadMethodSemanticsRowUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let mutable addr = ctxt.rowAddr TableNames.MethodSemantics idx let flags = seekReadUInt16AsInt32Adv mdv &addr @@ -1358,7 +1358,7 @@ let seekReadMethodSemanticsRowUncached ctxtH idx = (flags, midx, assocIdx) /// Read Table MethodImpl. -let seekReadMethodImplRow (ctxt: ILMetadataReader) mdv idx = +let seekReadMethodImplRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.MethodImpl idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr let mbodyIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr @@ -1366,19 +1366,19 @@ let seekReadMethodImplRow (ctxt: ILMetadataReader) mdv idx = (tidx, mbodyIdx, mdeclIdx) /// Read Table ILModuleRef. -let seekReadModuleRefRow (ctxt: ILMetadataReader) mdv idx = +let seekReadModuleRefRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.ModuleRef idx let nameIdx = seekReadStringIdx ctxt mdv &addr nameIdx /// Read Table ILTypeSpec. -let seekReadTypeSpecRow (ctxt: ILMetadataReader) mdv idx = +let seekReadTypeSpecRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.TypeSpec idx let blobIdx = seekReadBlobIdx ctxt mdv &addr blobIdx /// Read Table ImplMap. -let seekReadImplMapRow (ctxt: ILMetadataReader) mdv idx = +let seekReadImplMapRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.ImplMap idx let flags = seekReadUInt16AsInt32Adv mdv &addr let forwrdedIdx = seekReadMemberForwardedIdx ctxt mdv &addr @@ -1387,14 +1387,14 @@ let seekReadImplMapRow (ctxt: ILMetadataReader) mdv idx = (flags, forwrdedIdx, nameIdx, scopeIdx) /// Read Table FieldRVA. -let seekReadFieldRVARow (ctxt: ILMetadataReader) mdv idx = +let seekReadFieldRVARow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.FieldRVA idx let rva = seekReadInt32Adv mdv &addr let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr (rva, fidx) /// Read Table Assembly. -let seekReadAssemblyRow (ctxt: ILMetadataReader) mdv idx = +let seekReadAssemblyRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.Assembly idx let hash = seekReadInt32Adv mdv &addr let v1 = seekReadUInt16Adv mdv &addr @@ -1408,7 +1408,7 @@ let seekReadAssemblyRow (ctxt: ILMetadataReader) mdv idx = (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) /// Read Table ILAssemblyRef. -let seekReadAssemblyRefRow (ctxt: ILMetadataReader) mdv idx = +let seekReadAssemblyRefRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.AssemblyRef idx let v1 = seekReadUInt16Adv mdv &addr let v2 = seekReadUInt16Adv mdv &addr @@ -1422,7 +1422,7 @@ let seekReadAssemblyRefRow (ctxt: ILMetadataReader) mdv idx = (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) /// Read Table File. -let seekReadFileRow (ctxt: ILMetadataReader) mdv idx = +let seekReadFileRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.File idx let flags = seekReadInt32Adv mdv &addr let nameIdx = seekReadStringIdx ctxt mdv &addr @@ -1430,7 +1430,7 @@ let seekReadFileRow (ctxt: ILMetadataReader) mdv idx = (flags, nameIdx, hashValueIdx) /// Read Table ILExportedTypeOrForwarder. -let seekReadExportedTypeRow (ctxt: ILMetadataReader) mdv idx = +let seekReadExportedTypeRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.ExportedType idx let flags = seekReadInt32Adv mdv &addr let tok = seekReadInt32Adv mdv &addr @@ -1440,7 +1440,7 @@ let seekReadExportedTypeRow (ctxt: ILMetadataReader) mdv idx = (flags, tok, nameIdx, namespaceIdx, implIdx) /// Read Table ManifestResource. -let seekReadManifestResourceRow (ctxt: ILMetadataReader) mdv idx = +let seekReadManifestResourceRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.ManifestResource idx let offset = seekReadInt32Adv mdv &addr let flags = seekReadInt32Adv mdv &addr @@ -1449,9 +1449,9 @@ let seekReadManifestResourceRow (ctxt: ILMetadataReader) mdv idx = (offset, flags, nameIdx, implIdx) /// Read Table Nested. -let seekReadNestedRow (ctxt: ILMetadataReader) idx = ctxt.seekReadNestedRow idx +let seekReadNestedRow (ctxt: ILMetadataReader) idx = ctxt.seekReadNestedRow idx let seekReadNestedRowUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let mutable addr = ctxt.rowAddr TableNames.Nested idx let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr @@ -1459,7 +1459,7 @@ let seekReadNestedRowUncached ctxtH idx = (nestedIdx, enclIdx) /// Read Table GenericParam. -let seekReadGenericParamRow (ctxt: ILMetadataReader) mdv idx = +let seekReadGenericParamRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.GenericParam idx let seq = seekReadUInt16Adv mdv &addr let flags = seekReadUInt16Adv mdv &addr @@ -1468,14 +1468,14 @@ let seekReadGenericParamRow (ctxt: ILMetadataReader) mdv idx = (idx, seq, flags, ownerIdx, nameIdx) // Read Table GenericParamConstraint. -let seekReadGenericParamConstraintRow (ctxt: ILMetadataReader) mdv idx = +let seekReadGenericParamConstraintRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.GenericParamConstraint idx let pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt mdv &addr let constraintIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr (pidx, constraintIdx) /// Read Table ILMethodSpec. -let seekReadMethodSpecRow (ctxt: ILMetadataReader) mdv idx = +let seekReadMethodSpecRow (ctxt: ILMetadataReader) mdv idx = let mutable addr = ctxt.rowAddr TableNames.MethodSpec idx let mdorIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr let instIdx = seekReadBlobIdx ctxt mdv &addr @@ -1483,44 +1483,44 @@ let seekReadMethodSpecRow (ctxt: ILMetadataReader) mdv idx = let readUserStringHeapUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() seekReadUserString mdv (ctxt.userStringsStreamPhysicalLoc + idx) -let readUserStringHeap (ctxt: ILMetadataReader) idx = ctxt.readUserStringHeap idx +let readUserStringHeap (ctxt: ILMetadataReader) idx = ctxt.readUserStringHeap idx let readStringHeapUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() seekReadUTF8String mdv (ctxt.stringsStreamPhysicalLoc + idx) -let readStringHeap (ctxt: ILMetadataReader) idx = ctxt.readStringHeap idx +let readStringHeap (ctxt: ILMetadataReader) idx = ctxt.readStringHeap idx -let readStringHeapOption (ctxt: ILMetadataReader) idx = if idx = 0 then None else Some (readStringHeap ctxt idx) +let readStringHeapOption (ctxt: ILMetadataReader) idx = if idx = 0 then None else Some (readStringHeap ctxt idx) let emptyByteArray: byte[] = [||] let readBlobHeapUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() // valid index lies in range [1..streamSize) // NOTE: idx cannot be 0 - Blob\String heap has first empty element that mdv one byte 0 if idx <= 0 || idx >= ctxt.blobsStreamSize then emptyByteArray else seekReadBlob mdv (ctxt.blobsStreamPhysicalLoc + idx) -let readBlobHeap (ctxt: ILMetadataReader) idx = ctxt.readBlobHeap idx +let readBlobHeap (ctxt: ILMetadataReader) idx = ctxt.readBlobHeap idx let readBlobHeapOption ctxt idx = if idx = 0 then None else Some (readBlobHeap ctxt idx) //let readGuidHeap ctxt idx = seekReadGuid ctxt.mdv (ctxt.guidsStreamPhysicalLoc + idx) // read a single value out of a blob heap using the given function -let readBlobHeapAsBool ctxt vidx = fst (sigptrGetBool (readBlobHeap ctxt vidx) 0) -let readBlobHeapAsSByte ctxt vidx = fst (sigptrGetSByte (readBlobHeap ctxt vidx) 0) -let readBlobHeapAsInt16 ctxt vidx = fst (sigptrGetInt16 (readBlobHeap ctxt vidx) 0) -let readBlobHeapAsInt32 ctxt vidx = fst (sigptrGetInt32 (readBlobHeap ctxt vidx) 0) -let readBlobHeapAsInt64 ctxt vidx = fst (sigptrGetInt64 (readBlobHeap ctxt vidx) 0) -let readBlobHeapAsByte ctxt vidx = fst (sigptrGetByte (readBlobHeap ctxt vidx) 0) +let readBlobHeapAsBool ctxt vidx = fst (sigptrGetBool (readBlobHeap ctxt vidx) 0) +let readBlobHeapAsSByte ctxt vidx = fst (sigptrGetSByte (readBlobHeap ctxt vidx) 0) +let readBlobHeapAsInt16 ctxt vidx = fst (sigptrGetInt16 (readBlobHeap ctxt vidx) 0) +let readBlobHeapAsInt32 ctxt vidx = fst (sigptrGetInt32 (readBlobHeap ctxt vidx) 0) +let readBlobHeapAsInt64 ctxt vidx = fst (sigptrGetInt64 (readBlobHeap ctxt vidx) 0) +let readBlobHeapAsByte ctxt vidx = fst (sigptrGetByte (readBlobHeap ctxt vidx) 0) let readBlobHeapAsUInt16 ctxt vidx = fst (sigptrGetUInt16 (readBlobHeap ctxt vidx) 0) let readBlobHeapAsUInt32 ctxt vidx = fst (sigptrGetUInt32 (readBlobHeap ctxt vidx) 0) let readBlobHeapAsUInt64 ctxt vidx = fst (sigptrGetUInt64 (readBlobHeap ctxt vidx) 0) @@ -1529,8 +1529,8 @@ let readBlobHeapAsDouble ctxt vidx = fst (sigptrGetDouble (readBlobHeap ctxt vid //----------------------------------------------------------------------- // Some binaries have raw data embedded their text sections, e.g. mscorlib, for -// field inits. And there is no information that definitively tells us the extent of -// the text section that may be interesting data. But we certainly don't want to duplicate +// field inits. And there is no information that definitively tells us the extent of +// the text section that may be interesting data. But we certainly don't want to duplicate // the entire text section as data! // // So, we assume: @@ -1548,7 +1548,7 @@ let readBlobHeapAsDouble ctxt vidx = fst (sigptrGetDouble (readBlobHeap ctxt vid // For example the assembly came from a type provider // In this case we eagerly read the native resources into memory let readNativeResources (pectxt: PEReader) = - [ if pectxt.nativeResourcesSize <> 0x0 && pectxt.nativeResourcesAddr <> 0x0 then + [ if pectxt.nativeResourcesSize <> 0x0 && pectxt.nativeResourcesAddr <> 0x0 then let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr) if pectxt.noFileOnDisk then #if !FX_NO_LINKEDRESOURCES @@ -1565,7 +1565,7 @@ let readNativeResources (pectxt: PEReader) = let getDataEndPointsDelayed (pectxt: PEReader) ctxtH = lazy - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let dataStartPoints = let res = ref [] @@ -1688,9 +1688,9 @@ and seekReadAssemblyManifest (ctxt: ILMetadataReader) pectxt idx = JitTracking = 0 <> (flags &&& 0x8000) IgnoreSymbolStoreSequencePoints = 0 <> (flags &&& 0x2000) } -and seekReadAssemblyRef (ctxt: ILMetadataReader) idx = ctxt.seekReadAssemblyRef idx +and seekReadAssemblyRef (ctxt: ILMetadataReader) idx = ctxt.seekReadAssemblyRef idx and seekReadAssemblyRefUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) = seekReadAssemblyRefRow ctxt mdv idx let nm = readStringHeap ctxt nameIdx @@ -1707,15 +1707,15 @@ and seekReadAssemblyRefUncached ctxtH idx = version=Some(v1, v2, v3, v4), locale=readStringHeapOption ctxt localeIdx) -and seekReadModuleRef (ctxt: ILMetadataReader) mdv idx = +and seekReadModuleRef (ctxt: ILMetadataReader) mdv idx = let (nameIdx) = seekReadModuleRefRow ctxt mdv idx - ILModuleRef.Create(name = readStringHeap ctxt nameIdx, hasMetadata=true, hash=None) + ILModuleRef.Create(name = readStringHeap ctxt nameIdx, hasMetadata=true, hash=None) -and seekReadFile (ctxt: ILMetadataReader) mdv idx = +and seekReadFile (ctxt: ILMetadataReader) mdv idx = let (flags, nameIdx, hashValueIdx) = seekReadFileRow ctxt mdv idx - ILModuleRef.Create(name = readStringHeap ctxt nameIdx, hasMetadata= ((flags &&& 0x0001) = 0x0), hash= readBlobHeapOption ctxt hashValueIdx) + ILModuleRef.Create(name = readStringHeap ctxt nameIdx, hasMetadata= ((flags &&& 0x0001) = 0x0), hash= readBlobHeapOption ctxt hashValueIdx) -and seekReadClassLayout (ctxt: ILMetadataReader) mdv idx = +and seekReadClassLayout (ctxt: ILMetadataReader) mdv idx = match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.ClassLayout, seekReadClassLayoutRow ctxt mdv, (fun (_, _, tidx) -> tidx), simpleIndexCompare idx, isSorted ctxt TableNames.ClassLayout, (fun (pack, size, _) -> pack, size)) with | None -> { Size = None; Pack = None } | Some (pack, size) -> { Size = Some size; Pack = Some pack } @@ -1731,15 +1731,15 @@ and typeAccessOfFlags flags = elif f = 0x00000005 then ILTypeDefAccess.Nested ILMemberAccess.Assembly else ILTypeDefAccess.Private -and typeLayoutOfFlags (ctxt: ILMetadataReader) mdv flags tidx = +and typeLayoutOfFlags (ctxt: ILMetadataReader) mdv flags tidx = let f = (flags &&& 0x00000018) if f = 0x00000008 then ILTypeDefLayout.Sequential (seekReadClassLayout ctxt mdv tidx) - elif f = 0x00000010 then ILTypeDefLayout.Explicit (seekReadClassLayout ctxt mdv tidx) + elif f = 0x00000010 then ILTypeDefLayout.Explicit (seekReadClassLayout ctxt mdv tidx) else ILTypeDefLayout.Auto and isTopTypeDef flags = - (typeAccessOfFlags flags = ILTypeDefAccess.Private) || - typeAccessOfFlags flags = ILTypeDefAccess.Public + (typeAccessOfFlags flags = ILTypeDefAccess.Private) || + typeAccessOfFlags flags = ILTypeDefAccess.Public and seekIsTopTypeDefOfIdx ctxt idx = let (flags, _, _, _, _, _) = seekReadTypeDefRow ctxt idx @@ -1759,7 +1759,7 @@ and readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) = | None -> name | Some ns -> ctxt.memoizeString (ns+"."+name) -and seekReadTypeDefRowExtents (ctxt: ILMetadataReader) _info (idx: int) = +and seekReadTypeDefRowExtents (ctxt: ILMetadataReader) _info (idx: int) = if idx >= ctxt.getNumRows TableNames.TypeDef then ctxt.getNumRows TableNames.Field + 1, ctxt.getNumRows TableNames.Method + 1 @@ -1798,12 +1798,12 @@ and typeDefReader ctxtH: ILTypeDefStored = let mdefs = seekReadMethods ctxt numtypars methodsIdx endMethodsIdx let fdefs = seekReadFields ctxt (numtypars, hasLayout) fieldsIdx endFieldsIdx let nested = seekReadNestedTypeDefs ctxt idx - let impls = seekReadInterfaceImpls ctxt mdv numtypars idx + let impls = seekReadInterfaceImpls ctxt mdv numtypars idx let mimpls = seekReadMethodImpls ctxt numtypars idx - let props = seekReadProperties ctxt numtypars idx + let props = seekReadProperties ctxt numtypars idx let events = seekReadEvents ctxt numtypars idx ILTypeDef(name=nm, - genericParams=typars , + genericParams=typars, attributes= enum(flags), layout = layout, nestedTypes= nested, @@ -1819,13 +1819,13 @@ and typeDefReader ctxtH: ILTypeDefStored = metadataIndex=idx) ) -and seekReadTopTypeDefs (ctxt: ILMetadataReader) = +and seekReadTopTypeDefs (ctxt: ILMetadataReader) = [| for i = 1 to ctxt.getNumRows TableNames.TypeDef do - match seekReadPreTypeDef ctxt true i with + match seekReadPreTypeDef ctxt true i with | None -> () | Some td -> yield td |] -and seekReadNestedTypeDefs (ctxt: ILMetadataReader) tidx = +and seekReadNestedTypeDefs (ctxt: ILMetadataReader) tidx = mkILTypeDefsComputed (fun () -> let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, snd, simpleIndexCompare tidx, false, fst) [| for i in nestedIdxs do @@ -1833,7 +1833,7 @@ and seekReadNestedTypeDefs (ctxt: ILMetadataReader) tidx = | None -> () | Some td -> yield td |]) -and seekReadInterfaceImpls (ctxt: ILMetadataReader) mdv numtypars tidx = +and seekReadInterfaceImpls (ctxt: ILMetadataReader) mdv numtypars tidx = seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl, seekReadInterfaceImplRow ctxt mdv, fst, @@ -1845,7 +1845,7 @@ and seekReadGenericParams ctxt numtypars (a, b): ILGenericParameterDefs = ctxt.seekReadGenericParams (GenericParamsIdx(numtypars, a, b)) and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars, a, b)) = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let pars = seekReadIndexedRows @@ -1872,23 +1872,23 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars, a, b)) = HasDefaultConstructorConstraint=(flags &&& 0x0010) <> 0 })) pars |> List.sortBy fst |> List.map snd -and seekReadGenericParamConstraints (ctxt: ILMetadataReader) mdv numtypars gpidx = +and seekReadGenericParamConstraints (ctxt: ILMetadataReader) mdv numtypars gpidx = seekReadIndexedRows (ctxt.getNumRows TableNames.GenericParamConstraint, seekReadGenericParamConstraintRow ctxt mdv, fst, simpleIndexCompare gpidx, isSorted ctxt TableNames.GenericParamConstraint, - (snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty)) + (snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty)) -and seekReadTypeDefAsType (ctxt: ILMetadataReader) boxity (ginst: ILTypes) idx = +and seekReadTypeDefAsType (ctxt: ILMetadataReader) boxity (ginst: ILTypes) idx = ctxt.seekReadTypeDefAsType (TypeDefAsTypIdx (boxity, ginst, idx)) and seekReadTypeDefAsTypeUncached ctxtH (TypeDefAsTypIdx (boxity, ginst, idx)) = let ctxt = getHole ctxtH mkILTy boxity (ILTypeSpec.Create(seekReadTypeDefAsTypeRef ctxt idx, ginst)) -and seekReadTypeDefAsTypeRef (ctxt: ILMetadataReader) idx = +and seekReadTypeDefAsTypeRef (ctxt: ILMetadataReader) idx = let enc = if seekIsTopTypeDefOfIdx ctxt idx then [] else @@ -1899,21 +1899,21 @@ and seekReadTypeDefAsTypeRef (ctxt: ILMetadataReader) idx = let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) ILTypeRef.Create(scope=ILScopeRef.Local, enclosing=enc, name = nm ) -and seekReadTypeRef (ctxt: ILMetadataReader) idx = ctxt.seekReadTypeRef idx +and seekReadTypeRef (ctxt: ILMetadataReader) idx = ctxt.seekReadTypeRef idx and seekReadTypeRefUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let scopeIdx, nameIdx, namespaceIdx = seekReadTypeRefRow ctxt mdv idx let scope, enc = seekReadTypeRefScope ctxt mdv scopeIdx let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) ILTypeRef.Create(scope=scope, enclosing=enc, name = nm) -and seekReadTypeRefAsType (ctxt: ILMetadataReader) boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx (boxity, ginst, idx)) +and seekReadTypeRefAsType (ctxt: ILMetadataReader) boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx (boxity, ginst, idx)) and seekReadTypeRefAsTypeUncached ctxtH (TypeRefAsTypIdx (boxity, ginst, idx)) = let ctxt = getHole ctxtH mkILTy boxity (ILTypeSpec.Create(seekReadTypeRef ctxt idx, ginst)) -and seekReadTypeDefOrRef (ctxt: ILMetadataReader) numtypars boxity (ginst: ILTypes) (TaggedIndex(tag, idx) ) = +and seekReadTypeDefOrRef (ctxt: ILMetadataReader) numtypars boxity (ginst: ILTypes) (TaggedIndex(tag, idx) ) = let mdv = ctxt.mdfile.GetView() match tag with | tag when tag = tdor_TypeDef -> seekReadTypeDefAsType ctxt boxity ginst idx @@ -1923,7 +1923,7 @@ and seekReadTypeDefOrRef (ctxt: ILMetadataReader) numtypars boxity (ginst: ILTy readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt mdv idx) | _ -> failwith "seekReadTypeDefOrRef ctxt" -and seekReadTypeDefOrRefAsTypeRef (ctxt: ILMetadataReader) (TaggedIndex(tag, idx) ) = +and seekReadTypeDefOrRefAsTypeRef (ctxt: ILMetadataReader) (TaggedIndex(tag, idx) ) = match tag with | tag when tag = tdor_TypeDef -> seekReadTypeDefAsTypeRef ctxt idx | tag when tag = tdor_TypeRef -> seekReadTypeRef ctxt idx @@ -1932,7 +1932,7 @@ and seekReadTypeDefOrRefAsTypeRef (ctxt: ILMetadataReader) (TaggedIndex(tag, id ctxt.ilg.typ_Object.TypeRef | _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec" -and seekReadMethodRefParent (ctxt: ILMetadataReader) mdv numtypars (TaggedIndex(tag, idx)) = +and seekReadMethodRefParent (ctxt: ILMetadataReader) mdv numtypars (TaggedIndex(tag, idx)) = match tag with | tag when tag = mrp_TypeRef -> seekReadTypeRefAsType ctxt AsObject (* not ok - no way to tell if a member ref parent is a value type or not *) List.empty idx | tag when tag = mrp_ModuleRef -> mkILTypeForGlobalFunctions (ILScopeRef.Module (seekReadModuleRef ctxt mdv idx)) @@ -1943,7 +1943,7 @@ and seekReadMethodRefParent (ctxt: ILMetadataReader) mdv numtypars (TaggedIndex | tag when tag = mrp_TypeSpec -> readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt mdv idx) | _ -> failwith "seekReadMethodRefParent" -and seekReadMethodDefOrRef (ctxt: ILMetadataReader) numtypars (TaggedIndex(tag, idx)) = +and seekReadMethodDefOrRef (ctxt: ILMetadataReader) numtypars (TaggedIndex(tag, idx)) = match tag with | tag when tag = mdor_MethodDef -> let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx @@ -1952,12 +1952,12 @@ and seekReadMethodDefOrRef (ctxt: ILMetadataReader) numtypars (TaggedIndex(tag, seekReadMemberRefAsMethodData ctxt numtypars idx | _ -> failwith "seekReadMethodDefOrRef" -and seekReadMethodDefOrRefNoVarargs (ctxt: ILMetadataReader) numtypars x = - let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) = seekReadMethodDefOrRef ctxt numtypars x +and seekReadMethodDefOrRefNoVarargs (ctxt: ILMetadataReader) numtypars x = + let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) = seekReadMethodDefOrRef ctxt numtypars x if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" MethodData(enclTy, cc, nm, argtys, retty, minst) -and seekReadCustomAttrType (ctxt: ILMetadataReader) (TaggedIndex(tag, idx) ) = +and seekReadCustomAttrType (ctxt: ILMetadataReader) (TaggedIndex(tag, idx) ) = match tag with | tag when tag = cat_MethodDef -> let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx @@ -1967,7 +1967,7 @@ and seekReadCustomAttrType (ctxt: ILMetadataReader) (TaggedIndex(tag, idx) ) = mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst) | _ -> failwith "seekReadCustomAttrType ctxt" -and seekReadImplAsScopeRef (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx) ) = +and seekReadImplAsScopeRef (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx) ) = if idx = 0 then ILScopeRef.Local else match tag with @@ -1976,7 +1976,7 @@ and seekReadImplAsScopeRef (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx) | tag when tag = i_ExportedType -> failwith "seekReadImplAsScopeRef" | _ -> failwith "seekReadImplAsScopeRef" -and seekReadTypeRefScope (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx) ) = +and seekReadTypeRefScope (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx) ) = match tag with | tag when tag = rs_Module -> ILScopeRef.Local, [] | tag when tag = rs_ModuleRef -> ILScopeRef.Module (seekReadModuleRef ctxt mdv idx), [] @@ -1986,7 +1986,7 @@ and seekReadTypeRefScope (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx) ) tref.Scope, (tref.Enclosing@[tref.Name]) | _ -> failwith "seekReadTypeRefScope" -and seekReadOptionalTypeDefOrRef (ctxt: ILMetadataReader) numtypars boxity idx = +and seekReadOptionalTypeDefOrRef (ctxt: ILMetadataReader) numtypars boxity idx = if idx = TaggedIndex(tdor_TypeDef, 0) then None else Some (seekReadTypeDefOrRef ctxt numtypars boxity List.empty idx) @@ -2023,14 +2023,14 @@ and seekReadField ctxt mdv (numtypars, hasLayout) (idx: int) = customAttrsStored=ctxt.customAttrsReader_FieldDef, metadataIndex = idx) -and seekReadFields (ctxt: ILMetadataReader) (numtypars, hasLayout) fidx1 fidx2 = +and seekReadFields (ctxt: ILMetadataReader) (numtypars, hasLayout) fidx1 fidx2 = mkILFieldsLazy (lazy let mdv = ctxt.mdfile.GetView() [ for i = fidx1 to fidx2 - 1 do yield seekReadField ctxt mdv (numtypars, hasLayout) i ]) -and seekReadMethods (ctxt: ILMetadataReader) numtypars midx1 midx2 = +and seekReadMethods (ctxt: ILMetadataReader) numtypars midx1 midx2 = mkILMethodsComputed (fun () -> let mdv = ctxt.mdfile.GetView() [| for i = midx1 to midx2 - 1 do @@ -2043,9 +2043,9 @@ and sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr = else (* Type Ref *) TaggedIndex(tdor_TypeRef, (n >>>& 2)), sigptr -and sigptrGetTy (ctxt: ILMetadataReader) numtypars bytes sigptr = +and sigptrGetTy (ctxt: ILMetadataReader) numtypars bytes sigptr = let b0, sigptr = sigptrGetByte bytes sigptr - if b0 = et_OBJECT then ctxt.ilg.typ_Object , sigptr + if b0 = et_OBJECT then ctxt.ilg.typ_Object, sigptr elif b0 = et_STRING then ctxt.ilg.typ_String, sigptr elif b0 = et_I1 then ctxt.ilg.typ_SByte, sigptr elif b0 = et_I2 then ctxt.ilg.typ_Int16, sigptr @@ -2099,8 +2099,8 @@ and sigptrGetTy (ctxt: ILMetadataReader) numtypars bytes sigptr = let lobounds, sigptr = sigptrFold sigptrGetZInt32 numLoBounded bytes sigptr let shape = let dim i = - (if i < numLoBounded then Some (List.item i lobounds) else None), - (if i < numSized then Some (List.item i sizes) else None) + (if i < numLoBounded then Some (List.item i lobounds) else None), + (if i < numSized then Some (List.item i sizes) else None) ILArrayShape (List.init rank dim) mkILArrTy (ty, shape), sigptr @@ -2108,7 +2108,7 @@ and sigptrGetTy (ctxt: ILMetadataReader) numtypars bytes sigptr = elif b0 = et_TYPEDBYREF then let t = mkILNonGenericValueTy(mkILTyRef(ctxt.ilg.primaryAssemblyScopeRef, "System.TypedReference")) t, sigptr - elif b0 = et_CMOD_REQD || b0 = et_CMOD_OPT then + elif b0 = et_CMOD_REQD || b0 = et_CMOD_OPT then let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr let ty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr ILType.Modified((b0 = et_CMOD_REQD), seekReadTypeDefOrRefAsTypeRef ctxt tdorIdx, ty), sigptr @@ -2119,18 +2119,19 @@ and sigptrGetTy (ctxt: ILMetadataReader) numtypars bytes sigptr = let numparams, sigptr = sigptrGetZInt32 bytes sigptr let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr let argtys, sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr - ILType.FunctionPointer - { CallingConv=cc - ArgTypes = argtys - ReturnType=retty } - , sigptr + let typ = + ILType.FunctionPointer + { CallingConv=cc + ArgTypes = argtys + ReturnType=retty } + typ, sigptr elif b0 = et_SENTINEL then failwith "varargs NYI" - else ILType.Void , sigptr + else ILType.Void, sigptr -and sigptrGetVarArgTys (ctxt: ILMetadataReader) n numtypars bytes sigptr = +and sigptrGetVarArgTys (ctxt: ILMetadataReader) n numtypars bytes sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr -and sigptrGetArgTys (ctxt: ILMetadataReader) n numtypars bytes sigptr acc = +and sigptrGetArgTys (ctxt: ILMetadataReader) n numtypars bytes sigptr acc = if n <= 0 then (List.rev acc, None), sigptr else let b0, sigptr2 = sigptrGetByte bytes sigptr @@ -2141,7 +2142,7 @@ and sigptrGetArgTys (ctxt: ILMetadataReader) n numtypars bytes sigptr acc = let x, sigptr = sigptrGetTy ctxt numtypars bytes sigptr sigptrGetArgTys ctxt (n-1) numtypars bytes sigptr (x::acc) -and sigptrGetLocal (ctxt: ILMetadataReader) numtypars bytes sigptr = +and sigptrGetLocal (ctxt: ILMetadataReader) numtypars bytes sigptr = let pinned, sigptr = let b0, sigptr' = sigptrGetByte bytes sigptr if b0 = et_PINNED then @@ -2152,11 +2153,11 @@ and sigptrGetLocal (ctxt: ILMetadataReader) numtypars bytes sigptr = let loc: ILLocal = { IsPinned = pinned; Type = ty; DebugInfo = None } loc, sigptr -and readBlobHeapAsMethodSig (ctxt: ILMetadataReader) numtypars blobIdx = +and readBlobHeapAsMethodSig (ctxt: ILMetadataReader) numtypars blobIdx = ctxt.readBlobHeapAsMethodSig (BlobAsMethodSigIdx (numtypars, blobIdx)) and readBlobHeapAsMethodSigUncached ctxtH (BlobAsMethodSigIdx (numtypars, blobIdx)) = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 let ccByte, sigptr = sigptrGetByte bytes sigptr @@ -2172,7 +2173,7 @@ and readBlobHeapAsType ctxt numtypars blobIdx = let ty, _sigptr = sigptrGetTy ctxt numtypars bytes 0 ty -and readBlobHeapAsFieldSig ctxt numtypars blobIdx = +and readBlobHeapAsFieldSig ctxt numtypars blobIdx = ctxt.readBlobHeapAsFieldSig (BlobAsFieldSigIdx (numtypars, blobIdx)) and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars, blobIdx)) = @@ -2185,10 +2186,10 @@ and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars, blobIdx) retty -and readBlobHeapAsPropertySig (ctxt: ILMetadataReader) numtypars blobIdx = +and readBlobHeapAsPropertySig (ctxt: ILMetadataReader) numtypars blobIdx = ctxt.readBlobHeapAsPropertySig (BlobAsPropSigIdx (numtypars, blobIdx)) -and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars, blobIdx)) = +and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 @@ -2201,7 +2202,7 @@ and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars, blobId let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr hasthis, retty, argtys -and readBlobHeapAsLocalsSig (ctxt: ILMetadataReader) numtypars blobIdx = +and readBlobHeapAsLocalsSig (ctxt: ILMetadataReader) numtypars blobIdx = ctxt.readBlobHeapAsLocalsSig (BlobAsLocalSigIdx (numtypars, blobIdx)) and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars, blobIdx)) = @@ -2223,12 +2224,12 @@ and byteAsHasThis b = and byteAsCallConv b = let cc = let ccMaxked = b &&& 0x0Fuy - if ccMaxked = e_IMAGE_CEE_CS_CALLCONV_FASTCALL then ILArgConvention.FastCall + if ccMaxked = e_IMAGE_CEE_CS_CALLCONV_FASTCALL then ILArgConvention.FastCall elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_STDCALL then ILArgConvention.StdCall elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_THISCALL then ILArgConvention.ThisCall elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_CDECL then ILArgConvention.CDecl elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_VARARG then ILArgConvention.VarArg - else ILArgConvention.Default + else ILArgConvention.Default let generic = (b &&& e_IMAGE_CEE_CS_CALLCONV_GENERIC) <> 0x0uy generic, Callconv (byteAsHasThis b, cc) @@ -2236,17 +2237,17 @@ and seekReadMemberRefAsMethodData ctxt numtypars idx: VarArgMethodData = ctxt.seekReadMemberRefAsMethodData (MemberRefAsMspecIdx (numtypars, idx)) and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars, idx)) = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt mdv idx let nm = readStringHeap ctxt nameIdx let enclTy = seekReadMethodRefParent ctxt mdv numtypars mrpIdx let _generic, genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt enclTy.GenericArgs.Length typeIdx - let minst = List.init genarity (fun n -> mkILTyvarTy (uint16 (numtypars+n))) + let minst = List.init genarity (fun n -> mkILTyvarTy (uint16 (numtypars+n))) (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx: MethodData = - let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) = seekReadMemberRefAsMethodData ctxt numtypars idx + let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) = seekReadMemberRefAsMethodData ctxt numtypars idx if Option.isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" (MethodData(enclTy, cc, nm, argtys, retty, minst)) @@ -2254,7 +2255,7 @@ and seekReadMethodSpecAsMethodData (ctxt: ILMetadataReader) numtypars idx = ctxt.seekReadMethodSpecAsMethodData (MethodSpecAsMspecIdx (numtypars, idx)) and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypars, idx)) = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let (mdorIdx, instIdx) = seekReadMethodSpecRow ctxt mdv idx let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, _)) = seekReadMethodDefOrRef ctxt numtypars mdorIdx @@ -2268,11 +2269,11 @@ and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypar argtys VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst) -and seekReadMemberRefAsFieldSpec (ctxt: ILMetadataReader) numtypars idx = +and seekReadMemberRefAsFieldSpec (ctxt: ILMetadataReader) numtypars idx = ctxt.seekReadMemberRefAsFieldSpec (MemberRefAsFspecIdx (numtypars, idx)) and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars, idx)) = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt mdv idx let nm = readStringHeap ctxt nameIdx @@ -2282,7 +2283,7 @@ and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars, // One extremely annoying aspect of the MD format is that given a // ILMethodDef token it is non-trivial to find which ILTypeDef it belongs -// to. So we do a binary chop through the ILTypeDef table +// to. So we do a binary chop through the ILTypeDef table // looking for which ILTypeDef has the ILMethodDef within its range. // Although the ILTypeDef table is not "sorted", it is effectively sorted by // method-range and field-range start/finish indexes @@ -2290,7 +2291,7 @@ and seekReadMethodDefAsMethodData ctxt idx = ctxt.seekReadMethodDefAsMethodData idx and seekReadMethodDefAsMethodDataUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() // Look for the method def parent. let tidx = @@ -2298,7 +2299,7 @@ and seekReadMethodDefAsMethodDataUncached ctxtH idx = (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), (fun r -> r), (fun (_, ((_, _, _, _, _, methodsIdx), - (_, endMethodsIdx))) -> + (_, endMethodsIdx))) -> if endMethodsIdx <= idx then 1 elif methodsIdx <= idx && idx < endMethodsIdx then 0 else -1), @@ -2326,11 +2327,11 @@ and seekReadMethodDefAsMethodDataUncached ctxtH idx = MethodData(enclTy, cc, nm, argtys, retty, minst) -and seekReadFieldDefAsFieldSpec (ctxt: ILMetadataReader) idx = +and seekReadFieldDefAsFieldSpec (ctxt: ILMetadataReader) idx = ctxt.seekReadFieldDefAsFieldSpec idx and seekReadFieldDefAsFieldSpecUncached ctxtH idx = - let (ctxt: ILMetadataReader) = getHole ctxtH + let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() let (_flags, nameIdx, typeIdx) = seekReadFieldRow ctxt mdv idx let nm = readStringHeap ctxt nameIdx @@ -2339,7 +2340,7 @@ and seekReadFieldDefAsFieldSpecUncached ctxtH idx = seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), (fun r -> r), - (fun (_, ((_, _, _, _, fieldsIdx, _), (endFieldsIdx, _))) -> + (fun (_, ((_, _, _, _, fieldsIdx, _), (endFieldsIdx, _))) -> if endFieldsIdx <= idx then 1 elif fieldsIdx <= idx && idx < endFieldsIdx then 0 else -1), @@ -2356,7 +2357,7 @@ and seekReadFieldDefAsFieldSpecUncached ctxtH idx = // Put it together. mkILFieldSpecInTy(enclTy, nm, retty) -and seekReadMethod (ctxt: ILMetadataReader) mdv numtypars (idx: int) = +and seekReadMethod (ctxt: ILMetadataReader) mdv numtypars (idx: int) = let (codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) = seekReadMethodRow ctxt mdv idx let nm = readStringHeap ctxt nameIdx let abstr = (flags &&& 0x0400) <> 0x0 @@ -2408,14 +2409,14 @@ and seekReadMethod (ctxt: ILMetadataReader) mdv numtypars (idx: int) = metadataIndex=idx) -and seekReadParams (ctxt: ILMetadataReader) mdv (retty, argtys) pidx1 pidx2 = +and seekReadParams (ctxt: ILMetadataReader) mdv (retty, argtys) pidx1 pidx2 = let retRes = ref (mkILReturn retty) let paramsRes = argtys |> List.toArray |> Array.map mkILParamAnon for i = pidx1 to pidx2 - 1 do seekReadParamExtras ctxt mdv (retRes, paramsRes) i !retRes, List.ofArray paramsRes -and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes, paramsRes) (idx: int) = +and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes, paramsRes) (idx: int) = let (flags, seq, nameIdx) = seekReadParamRow ctxt mdv idx let inOutMasked = (flags &&& 0x00FF) let hasMarshal = (flags &&& 0x2000) <> 0x0 @@ -2439,7 +2440,7 @@ and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes, paramsRes) (idx: CustomAttrsStored = ctxt.customAttrsReader_ParamDef MetadataIndex = idx } -and seekReadMethodImpls (ctxt: ILMetadataReader) numtypars tidx = +and seekReadMethodImpls (ctxt: ILMetadataReader) numtypars tidx = mkILMethodImplsLazy (lazy let mdv = ctxt.mdfile.GetView() @@ -2453,9 +2454,9 @@ and seekReadMethodImpls (ctxt: ILMetadataReader) numtypars tidx = let mspec = mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst) OverridesSpec(mspec.MethodRef, mspec.DeclaringType) })) -and seekReadMultipleMethodSemantics (ctxt: ILMetadataReader) (flags, id) = +and seekReadMultipleMethodSemantics (ctxt: ILMetadataReader) (flags, id) = seekReadIndexedRows - (ctxt.getNumRows TableNames.MethodSemantics , + (ctxt.getNumRows TableNames.MethodSemantics, seekReadMethodSemanticsRow ctxt, (fun (_flags, _, c) -> c), hsCompare id, @@ -2491,7 +2492,7 @@ and seekReadEvent ctxt mdv numtypars idx = metadataIndex = idx ) (* REVIEW: can substantially reduce numbers of EventMap and PropertyMap reads by first checking if the whole table mdv sorted according to ILTypeDef tokens and then doing a binary chop *) -and seekReadEvents (ctxt: ILMetadataReader) numtypars tidx = +and seekReadEvents (ctxt: ILMetadataReader) numtypars tidx = mkILEventsLazy (lazy let mdv = ctxt.mdfile.GetView() @@ -2520,7 +2521,7 @@ and seekReadProperty ctxt mdv numtypars idx = | Some mref -> mref.CallingConv.ThisConv | None -> match setter with - | Some mref -> mref.CallingConv .ThisConv + | Some mref -> mref.CallingConv .ThisConv | None -> cc ILPropertyDef(name=readStringHeap ctxt nameIdx, @@ -2534,7 +2535,7 @@ and seekReadProperty ctxt mdv numtypars idx = customAttrsStored=ctxt.customAttrsReader_Property, metadataIndex = idx ) -and seekReadProperties (ctxt: ILMetadataReader) numtypars tidx = +and seekReadProperties (ctxt: ILMetadataReader) numtypars tidx = mkILPropertiesLazy (lazy let mdv = ctxt.mdfile.GetView() @@ -2592,7 +2593,7 @@ and seekReadSecurityDecl ctxt (act, ty) = ILSecurityDecl ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"), readBlobHeap ctxt ty) -and seekReadConstant (ctxt: ILMetadataReader) idx = +and seekReadConstant (ctxt: ILMetadataReader) idx = let kind, vidx = seekReadIndexedRow (ctxt.getNumRows TableNames.Constant, seekReadConstantRow ctxt, (fun (_, key, _) -> key), @@ -2614,10 +2615,10 @@ and seekReadConstant (ctxt: ILMetadataReader) idx = | x when x = uint16 et_U8 -> ILFieldInit.UInt64 (readBlobHeapAsUInt64 ctxt vidx) | x when x = uint16 et_R4 -> ILFieldInit.Single (readBlobHeapAsSingle ctxt vidx) | x when x = uint16 et_R8 -> ILFieldInit.Double (readBlobHeapAsDouble ctxt vidx) - | x when x = uint16 et_CLASS || x = uint16 et_OBJECT -> ILFieldInit.Null + | x when x = uint16 et_CLASS || x = uint16 et_OBJECT -> ILFieldInit.Null | _ -> ILFieldInit.Null -and seekReadImplMap (ctxt: ILMetadataReader) nm midx = +and seekReadImplMap (ctxt: ILMetadataReader) nm midx = mkMethBodyLazyAux (lazy let mdv = ctxt.mdfile.GetView() @@ -2671,7 +2672,7 @@ and seekReadImplMap (ctxt: ILMetadataReader) nm midx = | Some nm2 -> nm2) Where = seekReadModuleRef ctxt mdv scopeIdx }) -and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start seqpoints = +and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start seqpoints = let labelsOfRawOffsets = new Dictionary<_, _>(sz/2) let ilOffsetsOfLabels = new Dictionary<_, _>(sz/2) let tryRawToLabel rawOffset = @@ -2717,7 +2718,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start // Insert any sequence points into the instruction sequence while (match !seqPointsRemaining with - | (i, _tag) :: _rest when i <= !curr -> true + | (i, _tag) :: _rest when i <= !curr -> true | _ -> false) do // Emitting one sequence point @@ -2725,7 +2726,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start seqPointsRemaining := List.tail !seqPointsRemaining ibuf.Add (I_seqpoint tag) - // Read the prefixes. Leave lastb and lastb2 holding the instruction byte(s) + // Read the prefixes. Leave lastb and lastb2 holding the instruction byte(s) begin prefixes.al <- Aligned prefixes.tl <- Normalcall @@ -2748,7 +2749,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start if unal = 0x1 then Unaligned1 elif unal = 0x2 then Unaligned2 elif unal = 0x4 then Unaligned4 - else (dprintn "bad alignment for unaligned"; Aligned) + else (dprintn "bad alignment for unaligned"; Aligned) elif !b = (i_volatile &&& 0xff) then prefixes.vol <- Volatile elif !b = (i_readonly &&& 0xff) then prefixes.ro <- ReadonlyAddress elif !b = (i_constrained &&& 0xff) then @@ -2814,7 +2815,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start let (tab, idx) = seekReadUncodedToken pev (start + (!curr)) curr := !curr + 4 - let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) = + let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) = if tab = TableNames.Method then seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(mdor_MethodDef, idx)) elif tab = TableNames.MemberRef then @@ -2826,9 +2827,9 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start | ILType.Array (shape, ty) -> match nm with | "Get" -> I_ldelem_any(shape, ty) - | "Set" -> I_stelem_any(shape, ty) - | "Address" -> I_ldelema(prefixes.ro, false, shape, ty) - | ".ctor" -> I_newarr(shape, ty) + | "Set" -> I_stelem_any(shape, ty) + | "Address" -> I_ldelema(prefixes.ro, false, shape, ty) + | ".ctor" -> I_newarr(shape, ty) | _ -> failwith "bad method on array type" | _ -> let mspec = mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst) @@ -2845,7 +2846,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start f prefixes (readUserStringHeap ctxt (idx)) | I_conditional_i32_instr f -> - let offsDest = (seekReadInt32 pev (start + (!curr))) + let offsDest = (seekReadInt32 pev (start + (!curr))) curr := !curr + 4 let dest = !curr + offsDest f prefixes (rawToLabel dest) @@ -2855,7 +2856,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start let dest = !curr + offsDest f prefixes (rawToLabel dest) | I_unconditional_i32_instr f -> - let offsDest = (seekReadInt32 pev (start + (!curr))) + let offsDest = (seekReadInt32 pev (start + (!curr))) curr := !curr + 4 let dest = !curr + offsDest f prefixes (rawToLabel dest) @@ -2877,7 +2878,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start ILToken.ILMethod (mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)) elif tab = TableNames.Field then ILToken.ILField (seekReadFieldDefAsFieldSpec ctxt idx) - elif tab = TableNames.TypeDef || tab = TableNames.TypeRef || tab = TableNames.TypeSpec then + elif tab = TableNames.TypeDef || tab = TableNames.TypeRef || tab = TableNames.TypeSpec then ILToken.ILType (seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec (tab, idx))) else failwith "bad token for ldtoken" f prefixes token_info @@ -2889,11 +2890,11 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start if generic then failwith "bad image: a generic method signature is begin used at a calli instruction" f prefixes (mkILCallSig (cc, argtys, retty), varargs) | I_switch_instr f -> - let n = (seekReadInt32 pev (start + (!curr))) + let n = (seekReadInt32 pev (start + (!curr))) curr := !curr + 4 let offsets = List.init n (fun _ -> - let i = (seekReadInt32 pev (start + (!curr))) + let i = (seekReadInt32 pev (start + (!curr))) curr := !curr + 4 i) let dests = List.map (fun offs -> rawToLabel (!curr + offs)) offsets @@ -2906,16 +2907,16 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz: int) start let lab2pc = ilOffsetsOfLabels // Some offsets used in debug info refer to the end of an instruction, rather than the - // start of the subsequent instruction. But all labels refer to instruction starts, - // apart from a final label which refers to the end of the method. This function finds + // start of the subsequent instruction. But all labels refer to instruction starts, + // apart from a final label which refers to the end of the method. This function finds // the start of the next instruction referred to by the raw offset. let raw2nextLab rawOffset = let isInstrStart x = match tryRawToLabel x with | None -> false | Some lab -> ilOffsetsOfLabels.ContainsKey lab - if isInstrStart rawOffset then rawToLabel rawOffset - elif isInstrStart (rawOffset+1) then rawToLabel (rawOffset+1) + if isInstrStart rawOffset then rawToLabel rawOffset + elif isInstrStart (rawOffset+1) then rawToLabel (rawOffset+1) else failwith ("the bytecode raw offset "+string rawOffset+" did not refer either to the start or end of an instruction") let instrs = ibuf.ToArray() instrs, rawToLabel, lab2pc, raw2nextLab @@ -2946,12 +2947,12 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int let pdbm = pdbReaderGetMethod pdbr (uncodedToken TableNames.Method idx) let sps = pdbMethodGetSequencePoints pdbm - (*dprintf "#sps for 0x%x = %d\n" (uncodedToken TableNames.Method idx) (Array.length sps) *) - (* let roota, rootb = pdbScopeGetOffsets rootScope in *) + (*dprintf "#sps for 0x%x = %d\n" (uncodedToken TableNames.Method idx) (Array.length sps) *) + (* let roota, rootb = pdbScopeGetOffsets rootScope in *) let seqpoints = let arr = sps |> Array.map (fun sp -> - (* It is VERY annoying to have to call GetURL for the document for each sequence point. This appears to be a short coming of the PDB reader API. They should return an index into the array of documents for the reader *) + (* It is VERY annoying to have to call GetURL for the document for each sequence point. This appears to be a short coming of the PDB reader API. They should return an index into the array of documents for the reader *) let sourcedoc = get_doc (pdbDocumentGetURL sp.pdbSeqPointDocument) let source = ILSourceMarker.Create(document = sourcedoc, @@ -2966,7 +2967,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int Array.toList arr let rec scopes scp = let a, b = pdbScopeGetOffsets scp - let lvs = pdbScopeGetLocals scp + let lvs = pdbScopeGetLocals scp let ilvs = lvs |> Array.toList @@ -2977,7 +2978,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int ilvs |> List.map (fun ilv -> let _k, idx = pdbVariableGetAddressAttributes ilv let n = pdbVariableGetName ilv - { LocalIndex= idx + { LocalIndex= idx LocalName=n}) let thisOne = @@ -2986,8 +2987,8 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int DebugMappings = ilinfos }: ILLocalDebugInfo ) let others = List.foldBack (scopes >> (@)) (Array.toList (pdbScopeGetChildren scp)) [] thisOne :: others - let localPdbInfos = [] (* scopes fail for mscorlib scopes rootScope *) - // REVIEW: look through sps to get ranges? Use GetRanges?? Change AbsIL?? + let localPdbInfos = [] (* scopes fail for mscorlib scopes rootScope *) + // REVIEW: look through sps to get ranges? Use GetRanges?? Change AbsIL?? (localPdbInfos, None, seqpoints) with e -> // "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message @@ -2999,7 +3000,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int let b = seekReadByte pev baseRVA if (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_TinyFormat then let codeBase = baseRVA + 1 - let codeSize = (int32 b >>>& 2) + let codeSize = (int32 b >>>& 2) // tiny format for "+nm+", code size = " + string codeSize) let instrs, _, lab2pc, raw2nextLab = seekReadTopCode ctxt pev mdv numtypars codeSize codeBase seqpoints (* Convert the linear code format to the nested code format *) @@ -3048,9 +3049,9 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int let clauses = if (sectionFlag &&& e_CorILMethod_Sect_EHTable) <> 0x0uy then // WORKAROUND: The ECMA spec says this should be - // let numClauses = ((bigSize - 4) / 24) in + // let numClauses = ((bigSize - 4) / 24) in // but the CCI IL generator generates multiples of 24 - let numClauses = (bigSize / 24) + let numClauses = (bigSize / 24) List.init numClauses (fun i -> let clauseBase = sectionBase + 4 + (i * 24) @@ -3068,9 +3069,9 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int let clauses = if (sectionFlag &&& e_CorILMethod_Sect_EHTable) <> 0x0uy then // WORKAROUND: The ECMA spec says this should be - // let numClauses = ((smallSize - 4) / 12) in + // let numClauses = ((smallSize - 4) / 12) in // but the C# compiler (or some IL generator) generates multiples of 12 - let numClauses = (smallSize / 12) + let numClauses = (smallSize / 12) // dprintn (nm+" has " + string numClauses + " tiny seh clauses") List.init numClauses (fun i -> let clauseBase = sectionBase + 4 + (i * 12) @@ -3112,12 +3113,12 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int ILExceptionClause.Finally(handlerStart, handlerFinish) end - let key = (tryStart, tryFinish) + let key = (tryStart, tryFinish) match sehMap.TryGetValue(key) with | true, prev -> sehMap.[key] <- prev @ [clause] | _ -> sehMap.[key] <- [clause]) clauses - ([], sehMap) ||> Seq.fold (fun acc (KeyValue(key, bs)) -> [ for b in bs -> {Range=key; Clause=b}: ILExceptionSpec ] @ acc) + ([], sehMap) ||> Seq.fold (fun acc (KeyValue(key, bs)) -> [ for b in bs -> {Range=key; Clause=b}: ILExceptionSpec ] @ acc) seh := sehClauses moreSections := (sectionFlag &&& e_CorILMethod_Sect_MoreSects) <> 0x0uy nextSectionBase := sectionBase + sectionSize @@ -3141,7 +3142,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int if logging then failwith "unknown format" MethodBody.Abstract) -and int32AsILVariantType (ctxt: ILMetadataReader) (n: int32) = +and int32AsILVariantType (ctxt: ILMetadataReader) (n: int32) = if List.memAssoc n (Lazy.force ILVariantTypeRevMap) then List.assoc n (Lazy.force ILVariantTypeRevMap) elif (n &&& vt_ARRAY) <> 0x0 then ILNativeVariant.Array (int32AsILVariantType ctxt (n &&& (~~~ vt_ARRAY))) @@ -3162,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 @@ -3265,10 +3266,10 @@ and seekReadNestedExportedTypes ctxt (exported: _ []) (nested: Lazy<_ []>) paren | _ -> failwith "non-nested access for a nested type described as being in an auxiliary module") Nested = seekReadNestedExportedTypes ctxt exported nested i CustomAttrsStored = ctxt.customAttrsReader_ExportedType - MetadataIndex = i } + MetadataIndex = i } )) -and seekReadTopExportedTypes (ctxt: ILMetadataReader) = +and seekReadTopExportedTypes (ctxt: ILMetadataReader) = mkILExportedTypesLazy (lazy let mdv = ctxt.mdfile.GetView() @@ -3310,7 +3311,7 @@ let getPdbReader pdbDirPath fileName = let pdbdocs = pdbReaderGetDocuments pdbr let tab = new Dictionary<_, _>(Array.length pdbdocs) - pdbdocs |> Array.iter (fun pdbdoc -> + pdbdocs |> Array.iter (fun pdbdoc -> let url = pdbDocumentGetURL pdbdoc tab.[url] <- ILSourceDocument.Create(language=Some (pdbDocumentGetLanguage pdbdoc), @@ -3366,13 +3367,13 @@ let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, p let findStream name = match tryFindStream name with | None -> (0x0, 0x0) - | Some positions -> positions + | Some positions -> positions let (tablesStreamPhysLoc, _tablesStreamSize) = match tryFindStream [| 0x23; 0x7e |] (* #~ *) with | Some res -> res | None -> - match tryFindStream [| 0x23; 0x2d |] (* #-: at least one DLL I've seen uses this! *) with + match tryFindStream [| 0x23; 0x2d |] (* #-: at least one DLL I've seen uses this! *) with | Some res -> res | None -> let firstStreamOffset = seekReadInt32 mdv (streamHeadersStart + 0) @@ -3385,70 +3386,70 @@ let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, p let (blobsStreamPhysicalLoc, blobsStreamSize) = findStream [| 0x23; 0x42; 0x6c; 0x6f; 0x62; |] (* #Blob *) let tableKinds = - [|kindModule (* Table 0 *) - kindTypeRef (* Table 1 *) - kindTypeDef (* Table 2 *) - kindIllegal (* kindFieldPtr *) (* Table 3 *) - kindFieldDef (* Table 4 *) - kindIllegal (* kindMethodPtr *) (* Table 5 *) - kindMethodDef (* Table 6 *) - kindIllegal (* kindParamPtr *) (* Table 7 *) - kindParam (* Table 8 *) - kindInterfaceImpl (* Table 9 *) - kindMemberRef (* Table 10 *) - kindConstant (* Table 11 *) - kindCustomAttribute (* Table 12 *) - kindFieldMarshal (* Table 13 *) - kindDeclSecurity (* Table 14 *) - kindClassLayout (* Table 15 *) - kindFieldLayout (* Table 16 *) - kindStandAloneSig (* Table 17 *) - kindEventMap (* Table 18 *) - kindIllegal (* kindEventPtr *) (* Table 19 *) - kindEvent (* Table 20 *) - kindPropertyMap (* Table 21 *) - kindIllegal (* kindPropertyPtr *) (* Table 22 *) - kindProperty (* Table 23 *) - kindMethodSemantics (* Table 24 *) - kindMethodImpl (* Table 25 *) - kindModuleRef (* Table 26 *) - kindTypeSpec (* Table 27 *) - kindImplMap (* Table 28 *) - kindFieldRVA (* Table 29 *) - kindIllegal (* kindENCLog *) (* Table 30 *) - kindIllegal (* kindENCMap *) (* Table 31 *) - kindAssembly (* Table 32 *) - kindIllegal (* kindAssemblyProcessor *) (* Table 33 *) - kindIllegal (* kindAssemblyOS *) (* Table 34 *) - kindAssemblyRef (* Table 35 *) + [|kindModule (* Table 0 *) + kindTypeRef (* Table 1 *) + kindTypeDef (* Table 2 *) + kindIllegal (* kindFieldPtr *) (* Table 3 *) + kindFieldDef (* Table 4 *) + kindIllegal (* kindMethodPtr *) (* Table 5 *) + kindMethodDef (* Table 6 *) + kindIllegal (* kindParamPtr *) (* Table 7 *) + kindParam (* Table 8 *) + kindInterfaceImpl (* Table 9 *) + kindMemberRef (* Table 10 *) + kindConstant (* Table 11 *) + kindCustomAttribute (* Table 12 *) + kindFieldMarshal (* Table 13 *) + kindDeclSecurity (* Table 14 *) + kindClassLayout (* Table 15 *) + kindFieldLayout (* Table 16 *) + kindStandAloneSig (* Table 17 *) + kindEventMap (* Table 18 *) + kindIllegal (* kindEventPtr *) (* Table 19 *) + kindEvent (* Table 20 *) + kindPropertyMap (* Table 21 *) + kindIllegal (* kindPropertyPtr *) (* Table 22 *) + kindProperty (* Table 23 *) + kindMethodSemantics (* Table 24 *) + kindMethodImpl (* Table 25 *) + kindModuleRef (* Table 26 *) + kindTypeSpec (* Table 27 *) + kindImplMap (* Table 28 *) + kindFieldRVA (* Table 29 *) + kindIllegal (* kindENCLog *) (* Table 30 *) + kindIllegal (* kindENCMap *) (* Table 31 *) + kindAssembly (* Table 32 *) + kindIllegal (* kindAssemblyProcessor *) (* Table 33 *) + kindIllegal (* kindAssemblyOS *) (* Table 34 *) + kindAssemblyRef (* Table 35 *) kindIllegal (* kindAssemblyRefProcessor *) (* Table 36 *) - kindIllegal (* kindAssemblyRefOS *) (* Table 37 *) - kindFileRef (* Table 38 *) - kindExportedType (* Table 39 *) - kindManifestResource (* Table 40 *) - kindNested (* Table 41 *) - kindGenericParam_v2_0 (* Table 42 *) - kindMethodSpec (* Table 43 *) - kindGenericParamConstraint (* Table 44 *) - kindIllegal (* Table 45 *) - kindIllegal (* Table 46 *) - kindIllegal (* Table 47 *) - kindIllegal (* Table 48 *) - kindIllegal (* Table 49 *) - kindIllegal (* Table 50 *) - kindIllegal (* Table 51 *) - kindIllegal (* Table 52 *) - kindIllegal (* Table 53 *) - kindIllegal (* Table 54 *) - kindIllegal (* Table 55 *) - kindIllegal (* Table 56 *) - kindIllegal (* Table 57 *) - kindIllegal (* Table 58 *) - kindIllegal (* Table 59 *) - kindIllegal (* Table 60 *) - kindIllegal (* Table 61 *) - kindIllegal (* Table 62 *) - kindIllegal (* Table 63 *) + kindIllegal (* kindAssemblyRefOS *) (* Table 37 *) + kindFileRef (* Table 38 *) + kindExportedType (* Table 39 *) + kindManifestResource (* Table 40 *) + kindNested (* Table 41 *) + kindGenericParam_v2_0 (* Table 42 *) + kindMethodSpec (* Table 43 *) + kindGenericParamConstraint (* Table 44 *) + kindIllegal (* Table 45 *) + kindIllegal (* Table 46 *) + kindIllegal (* Table 47 *) + kindIllegal (* Table 48 *) + kindIllegal (* Table 49 *) + kindIllegal (* Table 50 *) + kindIllegal (* Table 51 *) + kindIllegal (* Table 52 *) + kindIllegal (* Table 53 *) + kindIllegal (* Table 54 *) + kindIllegal (* Table 55 *) + kindIllegal (* Table 56 *) + kindIllegal (* Table 57 *) + kindIllegal (* Table 58 *) + kindIllegal (* Table 59 *) + kindIllegal (* Table 60 *) + kindIllegal (* Table 61 *) + kindIllegal (* Table 62 *) + kindIllegal (* Table 63 *) |] let heapSizes = seekReadByteAsInt32 mdv (tablesStreamPhysLoc + 6) @@ -3459,9 +3460,9 @@ let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, p let numRows = Array.create 64 0 let prevNumRowIdx = ref (tablesStreamPhysLoc + 24) for i = 0 to 63 do - if (valid &&& (int64 1 <<< i)) <> int64 0 then + if (valid &&& (int64 1 <<< i)) <> int64 0 then present := i :: !present - numRows.[i] <- (seekReadInt32 mdv !prevNumRowIdx) + numRows.[i] <- (seekReadInt32 mdv !prevNumRowIdx) prevNumRowIdx := !prevNumRowIdx + 4 List.rev !present, numRows, !prevNumRowIdx @@ -3498,7 +3499,7 @@ let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, p let hcaBigness = codedBigness 5 TableNames.Method || codedBigness 5 TableNames.Field || - codedBigness 5 TableNames.TypeRef || + codedBigness 5 TableNames.TypeRef || codedBigness 5 TableNames.TypeDef || codedBigness 5 TableNames.Param || codedBigness 5 TableNames.InterfaceImpl || @@ -3559,7 +3560,7 @@ let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, p let rsBigness = codedBigness 2 TableNames.Module || codedBigness 2 TableNames.ModuleRef || - codedBigness 2 TableNames.AssemblyRef || + codedBigness 2 TableNames.AssemblyRef || codedBigness 2 TableNames.TypeRef let rowKindSize (RowKind kinds) = @@ -3570,20 +3571,20 @@ let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, p | Byte -> 1 | Data -> 4 | GGuid -> (if guidsBigness then 4 else 2) - | Blob -> (if blobsBigness then 4 else 2) - | SString -> (if stringsBigness then 4 else 2) + | Blob -> (if blobsBigness then 4 else 2) + | SString -> (if stringsBigness then 4 else 2) | SimpleIndex tab -> (if tableBigness.[tab.Index] then 4 else 2) | TypeDefOrRefOrSpec -> (if tdorBigness then 4 else 2) | TypeOrMethodDef -> (if tomdBigness then 4 else 2) - | HasConstant -> (if hcBigness then 4 else 2) + | HasConstant -> (if hcBigness then 4 else 2) | HasCustomAttribute -> (if hcaBigness then 4 else 2) - | HasFieldMarshal -> (if hfmBigness then 4 else 2) - | HasDeclSecurity -> (if hdsBigness then 4 else 2) - | MemberRefParent -> (if mrpBigness then 4 else 2) - | HasSemantics -> (if hsBigness then 4 else 2) + | HasFieldMarshal -> (if hfmBigness then 4 else 2) + | HasDeclSecurity -> (if hdsBigness then 4 else 2) + | MemberRefParent -> (if mrpBigness then 4 else 2) + | HasSemantics -> (if hsBigness then 4 else 2) | MethodDefOrRef -> (if mdorBigness then 4 else 2) | MemberForwarded -> (if mfBigness then 4 else 2) - | Implementation -> (if iBigness then 4 else 2) + | Implementation -> (if iBigness then 4 else 2) | CustomAttributeType -> (if catBigness then 4 else 2) | ResolutionScope -> (if rsBigness then 4 else 2)) @@ -3599,33 +3600,33 @@ let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, p let inbase = Filename.fileNameOfPath fileName + ": " - // All the caches. The sizes are guesstimates for the rough sharing-density of the assembly - let cacheAssemblyRef = mkCacheInt32 reduceMemoryUsage inbase "ILAssemblyRef" (getNumRows TableNames.AssemblyRef) - let cacheMethodSpecAsMethodData = mkCacheGeneric reduceMemoryUsage inbase "MethodSpecAsMethodData" (getNumRows TableNames.MethodSpec / 20 + 1) - let cacheMemberRefAsMemberData = mkCacheGeneric reduceMemoryUsage inbase "MemberRefAsMemberData" (getNumRows TableNames.MemberRef / 20 + 1) - let cacheCustomAttr = mkCacheGeneric reduceMemoryUsage inbase "CustomAttr" (getNumRows TableNames.CustomAttribute / 50 + 1) - let cacheTypeRef = mkCacheInt32 reduceMemoryUsage inbase "ILTypeRef" (getNumRows TableNames.TypeRef / 20 + 1) - let cacheTypeRefAsType = mkCacheGeneric reduceMemoryUsage inbase "TypeRefAsType" (getNumRows TableNames.TypeRef / 20 + 1) - let cacheBlobHeapAsPropertySig = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsPropertySig" (getNumRows TableNames.Property / 20 + 1) - let cacheBlobHeapAsFieldSig = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsFieldSig" (getNumRows TableNames.Field / 20 + 1) - let cacheBlobHeapAsMethodSig = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsMethodSig" (getNumRows TableNames.Method / 20 + 1) - let cacheTypeDefAsType = mkCacheGeneric reduceMemoryUsage inbase "TypeDefAsType" (getNumRows TableNames.TypeDef / 20 + 1) - let cacheMethodDefAsMethodData = mkCacheInt32 reduceMemoryUsage inbase "MethodDefAsMethodData" (getNumRows TableNames.Method / 20 + 1) - let cacheGenericParams = mkCacheGeneric reduceMemoryUsage inbase "GenericParams" (getNumRows TableNames.GenericParam / 20 + 1) - let cacheFieldDefAsFieldSpec = mkCacheInt32 reduceMemoryUsage inbase "FieldDefAsFieldSpec" (getNumRows TableNames.Field / 20 + 1) - let cacheUserStringHeap = mkCacheInt32 reduceMemoryUsage inbase "UserStringHeap" ( userStringsStreamSize / 20 + 1) + // All the caches. The sizes are guesstimates for the rough sharing-density of the assembly + let cacheAssemblyRef = mkCacheInt32 reduceMemoryUsage inbase "ILAssemblyRef" (getNumRows TableNames.AssemblyRef) + let cacheMethodSpecAsMethodData = mkCacheGeneric reduceMemoryUsage inbase "MethodSpecAsMethodData" (getNumRows TableNames.MethodSpec / 20 + 1) + let cacheMemberRefAsMemberData = mkCacheGeneric reduceMemoryUsage inbase "MemberRefAsMemberData" (getNumRows TableNames.MemberRef / 20 + 1) + let cacheCustomAttr = mkCacheGeneric reduceMemoryUsage inbase "CustomAttr" (getNumRows TableNames.CustomAttribute / 50 + 1) + let cacheTypeRef = mkCacheInt32 reduceMemoryUsage inbase "ILTypeRef" (getNumRows TableNames.TypeRef / 20 + 1) + let cacheTypeRefAsType = mkCacheGeneric reduceMemoryUsage inbase "TypeRefAsType" (getNumRows TableNames.TypeRef / 20 + 1) + let cacheBlobHeapAsPropertySig = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsPropertySig" (getNumRows TableNames.Property / 20 + 1) + let cacheBlobHeapAsFieldSig = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsFieldSig" (getNumRows TableNames.Field / 20 + 1) + let cacheBlobHeapAsMethodSig = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsMethodSig" (getNumRows TableNames.Method / 20 + 1) + let cacheTypeDefAsType = mkCacheGeneric reduceMemoryUsage inbase "TypeDefAsType" (getNumRows TableNames.TypeDef / 20 + 1) + let cacheMethodDefAsMethodData = mkCacheInt32 reduceMemoryUsage inbase "MethodDefAsMethodData" (getNumRows TableNames.Method / 20 + 1) + let cacheGenericParams = mkCacheGeneric reduceMemoryUsage inbase "GenericParams" (getNumRows TableNames.GenericParam / 20 + 1) + let cacheFieldDefAsFieldSpec = mkCacheInt32 reduceMemoryUsage inbase "FieldDefAsFieldSpec" (getNumRows TableNames.Field / 20 + 1) + let cacheUserStringHeap = mkCacheInt32 reduceMemoryUsage inbase "UserStringHeap" ( userStringsStreamSize / 20 + 1) // nb. Lots and lots of cache hits on this cache, hence never optimize cache away - let cacheStringHeap = mkCacheInt32 false inbase "string heap" ( stringsStreamSize / 50 + 1) - let cacheBlobHeap = mkCacheInt32 reduceMemoryUsage inbase "blob heap" ( blobsStreamSize / 50 + 1) + let cacheStringHeap = mkCacheInt32 false inbase "string heap" ( stringsStreamSize / 50 + 1) + let cacheBlobHeap = mkCacheInt32 reduceMemoryUsage inbase "blob heap" ( blobsStreamSize / 50 + 1) // These tables are not required to enforce sharing fo the final data // structure, but are very useful as searching these tables gives rise to many reads // in standard applications. - let cacheNestedRow = mkCacheInt32 reduceMemoryUsage inbase "Nested Table Rows" (getNumRows TableNames.Nested / 20 + 1) - let cacheConstantRow = mkCacheInt32 reduceMemoryUsage inbase "Constant Rows" (getNumRows TableNames.Constant / 20 + 1) + let cacheNestedRow = mkCacheInt32 reduceMemoryUsage inbase "Nested Table Rows" (getNumRows TableNames.Nested / 20 + 1) + let cacheConstantRow = mkCacheInt32 reduceMemoryUsage inbase "Constant Rows" (getNumRows TableNames.Constant / 20 + 1) let cacheMethodSemanticsRow = mkCacheInt32 reduceMemoryUsage inbase "MethodSemantics Rows" (getNumRows TableNames.MethodSemantics / 20 + 1) - let cacheTypeDefRow = mkCacheInt32 reduceMemoryUsage inbase "ILTypeDef Rows" (getNumRows TableNames.TypeDef / 20 + 1) + let cacheTypeDefRow = mkCacheInt32 reduceMemoryUsage inbase "ILTypeDef Rows" (getNumRows TableNames.TypeDef / 20 + 1) let rowAddr (tab: TableName) idx = tablePhysLocations.[tab.Index] + (idx - 1) * tableRowSizes.[tab.Index] @@ -3641,33 +3642,33 @@ let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, p pectxtCaptured=pectxtCaptured entryPointToken=pectxtEager.entryPointToken fileName=fileName - userStringsStreamPhysicalLoc = userStringsStreamPhysicalLoc - stringsStreamPhysicalLoc = stringsStreamPhysicalLoc - blobsStreamPhysicalLoc = blobsStreamPhysicalLoc - blobsStreamSize = blobsStreamSize - memoizeString = Tables.memoize id - readUserStringHeap = cacheUserStringHeap (readUserStringHeapUncached ctxtH) - readStringHeap = cacheStringHeap (readStringHeapUncached ctxtH) - readBlobHeap = cacheBlobHeap (readBlobHeapUncached ctxtH) - seekReadNestedRow = cacheNestedRow (seekReadNestedRowUncached ctxtH) - seekReadConstantRow = cacheConstantRow (seekReadConstantRowUncached ctxtH) - seekReadMethodSemanticsRow = cacheMethodSemanticsRow (seekReadMethodSemanticsRowUncached ctxtH) - seekReadTypeDefRow = cacheTypeDefRow (seekReadTypeDefRowUncached ctxtH) - seekReadAssemblyRef = cacheAssemblyRef (seekReadAssemblyRefUncached ctxtH) - seekReadMethodSpecAsMethodData = cacheMethodSpecAsMethodData (seekReadMethodSpecAsMethodDataUncached ctxtH) - seekReadMemberRefAsMethodData = cacheMemberRefAsMemberData (seekReadMemberRefAsMethodDataUncached ctxtH) - seekReadMemberRefAsFieldSpec = seekReadMemberRefAsFieldSpecUncached ctxtH - seekReadCustomAttr = cacheCustomAttr (seekReadCustomAttrUncached ctxtH) - seekReadTypeRef = cacheTypeRef (seekReadTypeRefUncached ctxtH) - readBlobHeapAsPropertySig = cacheBlobHeapAsPropertySig (readBlobHeapAsPropertySigUncached ctxtH) - readBlobHeapAsFieldSig = cacheBlobHeapAsFieldSig (readBlobHeapAsFieldSigUncached ctxtH) - readBlobHeapAsMethodSig = cacheBlobHeapAsMethodSig (readBlobHeapAsMethodSigUncached ctxtH) - readBlobHeapAsLocalsSig = readBlobHeapAsLocalsSigUncached ctxtH - seekReadTypeDefAsType = cacheTypeDefAsType (seekReadTypeDefAsTypeUncached ctxtH) - seekReadTypeRefAsType = cacheTypeRefAsType (seekReadTypeRefAsTypeUncached ctxtH) - seekReadMethodDefAsMethodData = cacheMethodDefAsMethodData (seekReadMethodDefAsMethodDataUncached ctxtH) - seekReadGenericParams = cacheGenericParams (seekReadGenericParamsUncached ctxtH) - seekReadFieldDefAsFieldSpec = cacheFieldDefAsFieldSpec (seekReadFieldDefAsFieldSpecUncached ctxtH) + userStringsStreamPhysicalLoc = userStringsStreamPhysicalLoc + stringsStreamPhysicalLoc = stringsStreamPhysicalLoc + blobsStreamPhysicalLoc = blobsStreamPhysicalLoc + blobsStreamSize = blobsStreamSize + memoizeString = Tables.memoize id + readUserStringHeap = cacheUserStringHeap (readUserStringHeapUncached ctxtH) + readStringHeap = cacheStringHeap (readStringHeapUncached ctxtH) + readBlobHeap = cacheBlobHeap (readBlobHeapUncached ctxtH) + seekReadNestedRow = cacheNestedRow (seekReadNestedRowUncached ctxtH) + seekReadConstantRow = cacheConstantRow (seekReadConstantRowUncached ctxtH) + seekReadMethodSemanticsRow = cacheMethodSemanticsRow (seekReadMethodSemanticsRowUncached ctxtH) + seekReadTypeDefRow = cacheTypeDefRow (seekReadTypeDefRowUncached ctxtH) + seekReadAssemblyRef = cacheAssemblyRef (seekReadAssemblyRefUncached ctxtH) + seekReadMethodSpecAsMethodData = cacheMethodSpecAsMethodData (seekReadMethodSpecAsMethodDataUncached ctxtH) + seekReadMemberRefAsMethodData = cacheMemberRefAsMemberData (seekReadMemberRefAsMethodDataUncached ctxtH) + seekReadMemberRefAsFieldSpec = seekReadMemberRefAsFieldSpecUncached ctxtH + seekReadCustomAttr = cacheCustomAttr (seekReadCustomAttrUncached ctxtH) + seekReadTypeRef = cacheTypeRef (seekReadTypeRefUncached ctxtH) + readBlobHeapAsPropertySig = cacheBlobHeapAsPropertySig (readBlobHeapAsPropertySigUncached ctxtH) + readBlobHeapAsFieldSig = cacheBlobHeapAsFieldSig (readBlobHeapAsFieldSigUncached ctxtH) + readBlobHeapAsMethodSig = cacheBlobHeapAsMethodSig (readBlobHeapAsMethodSigUncached ctxtH) + readBlobHeapAsLocalsSig = readBlobHeapAsLocalsSigUncached ctxtH + seekReadTypeDefAsType = cacheTypeDefAsType (seekReadTypeDefAsTypeUncached ctxtH) + seekReadTypeRefAsType = cacheTypeRefAsType (seekReadTypeRefAsTypeUncached ctxtH) + seekReadMethodDefAsMethodData = cacheMethodDefAsMethodData (seekReadMethodDefAsMethodDataUncached ctxtH) + seekReadGenericParams = cacheGenericParams (seekReadGenericParamsUncached ctxtH) + seekReadFieldDefAsFieldSpec = cacheFieldDefAsFieldSpec (seekReadFieldDefAsFieldSpecUncached ctxtH) customAttrsReader_Module = customAttrsReader ctxtH hca_Module customAttrsReader_Assembly = customAttrsReader ctxtH hca_Assembly customAttrsReader_TypeDef = customAttrsReader ctxtH hca_TypeDef @@ -3723,17 +3724,17 @@ let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) = let peFileHeaderPhysLoc = peSignaturePhysLoc + 0x04 let peOptionalHeaderPhysLoc = peFileHeaderPhysLoc + 0x14 let peSignature = seekReadInt32 pev (peSignaturePhysLoc + 0) - if peSignature <> 0x4550 then failwithf "not a PE file - bad magic PE number 0x%08x, is = %A" peSignature pev + if peSignature <> 0x4550 then failwithf "not a PE file - bad magic PE number 0x%08x, is = %A" peSignature pev (* PE SIGNATURE *) let machine = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 0) let numSections = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 2) let optHeaderSize = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 16) - if optHeaderSize <> 0xe0 && + if optHeaderSize <> 0xe0 && 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 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 sectionHeadersStartPhysLoc = peOptionalHeaderPhysLoc + optHeaderSize @@ -3741,30 +3742,30 @@ let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) = let isDll = (flags &&& 0x2000) <> 0x0 (* OPTIONAL PE HEADER *) - let _textPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 4) (* Size of the code (text) section, or the sum of all code sections if there are multiple sections. *) + let _textPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 4) (* Size of the code (text) section, or the sum of all code sections if there are multiple sections. *) (* x86: 000000a0 *) - let _initdataPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 8) (* Size of the initialized data section, or the sum of all such sections if there are multiple data sections. *) + let _initdataPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 8) (* Size of the initialized data section, or the sum of all such sections if there are multiple data sections. *) let _uninitdataPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 12) (* Size of the uninitialized data section, or the sum of all such sections if there are multiple data sections. *) - let _entrypointAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 16) (* RVA of entry point , needs to point to bytes 0xFF 0x25 followed by the RVA+!0x4000000 in a section marked execute/read for EXEs or 0 for DLLs e.g. 0x0000b57e *) - let _textAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 20) (* e.g. 0x0002000 *) + let _entrypointAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 16) (* RVA of entry point, needs to point to bytes 0xFF 0x25 followed by the RVA+!0x4000000 in a section marked execute/read for EXEs or 0 for DLLs e.g. 0x0000b57e *) + let _textAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 20) (* e.g. 0x0002000 *) (* x86: 000000b0 *) - let dataSegmentAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 24) (* e.g. 0x0000c000 *) - (* REVIEW: For now, we'll use the DWORD at offset 24 for x64. This currently ok since fsc doesn't support true 64-bit image bases, + let dataSegmentAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 24) (* e.g. 0x0000c000 *) + (* REVIEW: For now, we'll use the DWORD at offset 24 for x64. This currently ok since fsc doesn't support true 64-bit image bases, but we'll have to fix this up when such support is added. *) let imageBaseReal = if only64 then dataSegmentAddr else seekReadInt32 pev (peOptionalHeaderPhysLoc + 28) // Image Base Always 0x400000 (see Section 23.1). - let alignVirt = seekReadInt32 pev (peOptionalHeaderPhysLoc + 32) // Section Alignment Always 0x2000 (see Section 23.1). - let alignPhys = seekReadInt32 pev (peOptionalHeaderPhysLoc + 36) // File Alignment Either 0x200 or 0x1000. + let alignVirt = seekReadInt32 pev (peOptionalHeaderPhysLoc + 32) // Section Alignment Always 0x2000 (see Section 23.1). + let alignPhys = seekReadInt32 pev (peOptionalHeaderPhysLoc + 36) // File Alignment Either 0x200 or 0x1000. (* x86: 000000c0 *) - let _osMajor = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 40) // OS Major Always 4 (see Section 23.1). - let _osMinor = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 42) // OS Minor Always 0 (see Section 23.1). - let _userMajor = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 44) // User Major Always 0 (see Section 23.1). - let _userMinor = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 46) // User Minor Always 0 (see Section 23.1). + let _osMajor = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 40) // OS Major Always 4 (see Section 23.1). + let _osMinor = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 42) // OS Minor Always 0 (see Section 23.1). + let _userMajor = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 44) // User Major Always 0 (see Section 23.1). + let _userMinor = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 46) // User Minor Always 0 (see Section 23.1). let subsysMajor = seekReadUInt16AsInt32 pev (peOptionalHeaderPhysLoc + 48) // SubSys Major Always 4 (see Section 23.1). let subsysMinor = seekReadUInt16AsInt32 pev (peOptionalHeaderPhysLoc + 50) // SubSys Minor Always 0 (see Section 23.1). (* x86: 000000d0 *) - let _imageEndAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 56) // Image Size: Size, in bytes, of image, including all headers and padding + let _imageEndAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 56) // Image Size: Size, in bytes, of image, including all headers and padding let _headerPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 60) // Header Size Combined size of MS-DOS Header, PE Header, PE Optional Header and padding - let subsys = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 68) // SubSystem Subsystem required to run this image. + let subsys = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 68) // SubSystem Subsystem required to run this image. let useHighEnthropyVA = let n = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 70) let highEnthropyVA = 0x20us @@ -3773,29 +3774,29 @@ let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) = (* x86: 000000e0 *) (* WARNING: THESE ARE 64 bit ON x64/ia64 *) - (* REVIEW: If we ever decide that we need these values for x64, we'll have to read them in as 64bit and fix up the rest of the offsets. + (* REVIEW: If we ever decide that we need these values for x64, we'll have to read them in as 64bit and fix up the rest of the offsets. Then again, it should suffice to just use the defaults, and still not bother... *) - (* let stackReserve = seekReadInt32 is (peOptionalHeaderPhysLoc + 72) in *) (* Stack Reserve Size Always 0x100000 (1Mb) (see Section 23.1). *) - (* let stackCommit = seekReadInt32 is (peOptionalHeaderPhysLoc + 76) in *) (* Stack Commit Size Always 0x1000 (4Kb) (see Section 23.1). *) - (* let heapReserve = seekReadInt32 is (peOptionalHeaderPhysLoc + 80) in *) (* Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). *) - (* let heapCommit = seekReadInt32 is (peOptionalHeaderPhysLoc + 84) in *) (* Heap Commit Size Always 0x1000 (4Kb) (see Section 23.1). *) + (* let stackReserve = seekReadInt32 is (peOptionalHeaderPhysLoc + 72) in *) (* Stack Reserve Size Always 0x100000 (1Mb) (see Section 23.1). *) + (* let stackCommit = seekReadInt32 is (peOptionalHeaderPhysLoc + 76) in *) (* Stack Commit Size Always 0x1000 (4Kb) (see Section 23.1). *) + (* let heapReserve = seekReadInt32 is (peOptionalHeaderPhysLoc + 80) in *) (* Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). *) + (* let heapCommit = seekReadInt32 is (peOptionalHeaderPhysLoc + 84) in *) (* Heap Commit Size Always 0x1000 (4Kb) (see Section 23.1). *) (* x86: 000000f0, x64: 00000100 *) - let _numDataDirectories = seekReadInt32 pev (peOptionalHeaderPhysLoc + 92 + x64adjust) (* Number of Data Directories: Always 0x10 (see Section 23.1). *) + let _numDataDirectories = seekReadInt32 pev (peOptionalHeaderPhysLoc + 92 + x64adjust) (* Number of Data Directories: Always 0x10 (see Section 23.1). *) (* 00000100 - these addresses are for x86 - for the x64 location, add x64adjust (0x10) *) - let _importTableAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 104 + x64adjust) (* Import Table RVA of Import Table, (see clause 24.3.1). e.g. 0000b530 *) - let _importTableSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 108 + x64adjust) (* Size of Import Table, (see clause 24.3.1). *) + let _importTableAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 104 + x64adjust) (* Import Table RVA of Import Table, (see clause 24.3.1). e.g. 0000b530 *) + let _importTableSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 108 + x64adjust) (* Size of Import Table, (see clause 24.3.1). *) let nativeResourcesAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 112 + x64adjust) let nativeResourcesSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 116 + x64adjust) (* 00000110 *) (* 00000120 *) - (* let base_relocTableNames.addr = seekReadInt32 is (peOptionalHeaderPhysLoc + 136) - let base_relocTableNames.size = seekReadInt32 is (peOptionalHeaderPhysLoc + 140) in *) + (* let base_relocTableNames.addr = seekReadInt32 is (peOptionalHeaderPhysLoc + 136) + let base_relocTableNames.size = seekReadInt32 is (peOptionalHeaderPhysLoc + 140) in *) (* 00000130 *) (* 00000140 *) (* 00000150 *) - let _importAddrTableAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 192 + x64adjust) (* RVA of Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 *) - let _importAddrTableSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 196 + x64adjust) (* Size of Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 *) + let _importAddrTableAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 192 + x64adjust) (* RVA of Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 *) + let _importAddrTableSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 196 + x64adjust) (* Size of Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 *) (* 00000160 *) let cliHeaderAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 208 + x64adjust) let _cliHeaderSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 212 + x64adjust) @@ -3824,7 +3825,7 @@ let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) = let textHeaderStart = findSectionHeader cliHeaderAddr let dataHeaderStart = findSectionHeader dataSegmentAddr - (* let relocHeaderStart = findSectionHeader base_relocTableNames.addr in *) + (* let relocHeaderStart = findSectionHeader base_relocTableNames.addr in *) let _textSize = if textHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (textHeaderStart + 8) let _textAddr = if textHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (textHeaderStart + 12) @@ -3852,21 +3853,21 @@ let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) = let _majorRuntimeVersion = seekReadUInt16 pev (cliHeaderPhysLoc + 4) let _minorRuntimeVersion = seekReadUInt16 pev (cliHeaderPhysLoc + 6) - let metadataAddr = seekReadInt32 pev (cliHeaderPhysLoc + 8) - let metadataSize = seekReadInt32 pev (cliHeaderPhysLoc + 12) - let cliFlags = seekReadInt32 pev (cliHeaderPhysLoc + 16) + let metadataAddr = seekReadInt32 pev (cliHeaderPhysLoc + 8) + let metadataSize = seekReadInt32 pev (cliHeaderPhysLoc + 12) + let cliFlags = seekReadInt32 pev (cliHeaderPhysLoc + 16) - let ilOnly = (cliFlags &&& 0x01) <> 0x00 - let only32 = (cliFlags &&& 0x02) <> 0x00 - let is32bitpreferred = (cliFlags &&& 0x00020003) <> 0x00 - let _strongnameSigned = (cliFlags &&& 0x08) <> 0x00 - let _trackdebugdata = (cliFlags &&& 0x010000) <> 0x00 + let ilOnly = (cliFlags &&& 0x01) <> 0x00 + let only32 = (cliFlags &&& 0x02) <> 0x00 + let is32bitpreferred = (cliFlags &&& 0x00020003) <> 0x00 + let _strongnameSigned = (cliFlags &&& 0x08) <> 0x00 + let _trackdebugdata = (cliFlags &&& 0x010000) <> 0x00 let entryPointToken = seekReadUncodedToken pev (cliHeaderPhysLoc + 20) - let resourcesAddr = seekReadInt32 pev (cliHeaderPhysLoc + 24) - let resourcesSize = seekReadInt32 pev (cliHeaderPhysLoc + 28) - let strongnameAddr = seekReadInt32 pev (cliHeaderPhysLoc + 32) - let _strongnameSize = seekReadInt32 pev (cliHeaderPhysLoc + 36) + let resourcesAddr = seekReadInt32 pev (cliHeaderPhysLoc + 24) + let resourcesSize = seekReadInt32 pev (cliHeaderPhysLoc + 28) + let strongnameAddr = seekReadInt32 pev (cliHeaderPhysLoc + 32) + let _strongnameSize = seekReadInt32 pev (cliHeaderPhysLoc + 36) let vtableFixupsAddr = seekReadInt32 pev (cliHeaderPhysLoc + 40) let _vtableFixupsSize = seekReadInt32 pev (cliHeaderPhysLoc + 44) @@ -3952,7 +3953,7 @@ type ILModuleReader = abstract ILAssemblyRefs: ILAssemblyRef list /// ILModuleReader objects only need to be explicitly disposed if memory mapping is used, i.e. reduceMemoryUsage = false - inherit System.IDisposable + inherit System.IDisposable [] @@ -4041,7 +4042,7 @@ let OpenILModuleReader fileName opts = let mdfileOpt = match opts.tryGetMetadataSnapshot (fullPath, writeStamp) with | Some (obj, start, len) -> Some (RawMemoryFile(fullPath, obj, start, len) :> BinaryFile) - | None -> None + | None -> None // For metadata-only, always use a temporary, short-lived PE file reader, preferably over a memory mapped file. // Then use the metadata blob as the long-lived memory resource. @@ -4078,7 +4079,7 @@ let OpenILModuleReader fileName opts = // whole binary for the command-line compiler: address space is rarely an issue. // // We do however care about avoiding locks on files that prevent their deletion during a - // multi-proc build. So use memory mapping, but only for stable files. Other files + // multi-proc build. So use memory mapping, but only for stable files. Other files // still use an in-memory ByteFile let _disposer, pefile = if alwaysMemoryMapFSC || stableFileHeuristicApplies fullPath then @@ -4091,7 +4092,7 @@ let OpenILModuleReader fileName opts = let ilModule, ilAssemblyRefs, pdb = openPE (fullPath, pefile, opts.pdbDirPath, reduceMemoryUsage, opts.ilGlobals, false) let ilModuleReader = new ILModuleReaderImpl(ilModule, ilAssemblyRefs, (fun () -> ClosePdbReader pdb)) - // Readers with PDB reader disposal logic don't go in the cache. Note the PDB reader is only used in static linking. + // Readers with PDB reader disposal logic don't go in the cache. Note the PDB reader is only used in static linking. if keyOk && opts.pdbDirPath.IsNone then ilModuleReaderCacheLock.AcquireLock (fun ltok -> ilModuleReaderCache.Put(ltok, key, ilModuleReader)) diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 0ff14a5696e..474997be4e7 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. //---------------------------------------------------------------------------- // Write Abstract IL structures at runtime using Reflection.Emit @@ -53,16 +53,16 @@ type System.Reflection.Emit.AssemblyBuilder with #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) @@ -75,7 +75,7 @@ type System.Reflection.Emit.ModuleBuilder with #if !FX_RESHAPED_REFEMIT 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 + 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) = @@ -92,7 +92,7 @@ type System.Reflection.Emit.ModuleBuilder with 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) @@ -133,7 +133,7 @@ type System.Reflection.Emit.MethodBuilder with 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) @@ -204,7 +204,7 @@ type System.Reflection.Emit.TypeBuilder with type System.Reflection.Emit.OpCode with - member opcode.RefEmitName = (string (System.Char.ToUpper(opcode.Name.[0])) + opcode.Name.[1..]).Replace(".", "_").Replace("_i4", "_I4") + 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) = @@ -233,7 +233,7 @@ type System.Reflection.Emit.ILGenerator with ilG.BeginFinallyBlock() member ilG.BeginCatchBlockAndLog(ty) = - if logRefEmitCalls then printfn "ilg%d.BeginCatchBlock(%A)" (abs <| hash ilG) ty + if logRefEmitCalls then printfn "ilg%d.BeginCatchBlock(%A)" (abs <| hash ilG) ty ilG.BeginCatchBlock(ty) member ilG.BeginExceptFilterBlockAndLog() = @@ -282,7 +282,7 @@ type System.Reflection.Emit.ILGenerator with // misc //---------------------------------------------------------------------------- -let inline flagsIf b x = if b then x else enum 0 +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 @@ -292,7 +292,7 @@ let equalTypeLists ss tt = List.lengthsEqAndForall2 equalTypes ss tt let equalTypeArrays ss tt = Array.lengthsEqAndForall2 equalTypes ss tt let getGenericArgumentsOfType (typT: Type) = - if typT.IsGenericType then typT.GetGenericArguments() else [| |] + if typT.IsGenericType then typT.GetGenericArguments() else [| |] let getGenericArgumentsOfMethod (methI: MethodInfo) = if methI.IsGenericMethod then methI.GetGenericArguments() else [| |] @@ -305,10 +305,10 @@ let getTypeConstructor (ty: Type) = let convAssemblyRef (aref: ILAssemblyRef) = let asmName = new System.Reflection.AssemblyName() - asmName.Name <- aref.Name + asmName.Name <- aref.Name (match aref.PublicKey with | None -> () - | Some (PublicKey bytes) -> asmName.SetPublicKey(bytes) + | Some (PublicKey bytes) -> asmName.SetPublicKey(bytes) | Some (PublicKeyToken bytes) -> asmName.SetPublicKeyToken(bytes)) let setVersion (major, minor, build, rev) = asmName.Version <- System.Version (int32 major, int32 minor, int32 build, int32 rev) @@ -345,7 +345,7 @@ let convTypeRefAux (cenv: cenv) (tref: ILTypeRef) = | Some (Choice2Of2 assembly) -> assembly | None -> - let asmName = convAssemblyRef asmref + let asmName = convAssemblyRef asmref FileSystem.AssemblyLoad(asmName) let typT = assembly.GetType(qualifiedName) match typT with @@ -373,22 +373,22 @@ type emEnv = emLabels: Zmap emTyvars: Type[] list; // stack emEntryPts: (TypeBuilder * string) list - delayedFieldInits: (unit -> unit) list} + delayedFieldInits: (unit -> unit) list} -let orderILTypeRef = ComparisonIdentity.Structural -let orderILMethodRef = ComparisonIdentity.Structural -let orderILFieldRef = ComparisonIdentity.Structural -let orderILPropertyRef = ComparisonIdentity.Structural +let orderILTypeRef = ComparisonIdentity.Structural +let orderILMethodRef = ComparisonIdentity.Structural +let orderILFieldRef = ComparisonIdentity.Structural +let orderILPropertyRef = ComparisonIdentity.Structural let emEnv0 = - { emTypMap = Zmap.empty orderILTypeRef - emConsMap = Zmap.empty orderILMethodRef - emMethMap = Zmap.empty orderILMethodRef + { emTypMap = Zmap.empty orderILTypeRef + emConsMap = Zmap.empty orderILMethodRef + emMethMap = Zmap.empty orderILMethodRef emFieldMap = Zmap.empty orderILFieldRef emPropMap = Zmap.empty orderILPropertyRef - emLocals = [| |] - emLabels = Zmap.empty codeLabelOrder - emTyvars = [] + emLocals = [| |] + emLabels = Zmap.empty codeLabelOrder + emTyvars = [] emEntryPts = [] delayedFieldInits = [] } @@ -427,8 +427,8 @@ let convTypeRef cenv emEnv preferCreated (tref: ILTypeRef) = let res = match Zmap.tryFind tref emEnv.emTypMap with | Some (_typT, _typB, _typeDef, Some createdTy) when preferCreated -> createdTy - | Some (typT, _typB, _typeDef, _) -> typT - | None -> convTypeRefAux cenv tref + | Some (typT, _typB, _typeDef, _) -> typT + | None -> convTypeRefAux cenv tref match res with | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tref.QualifiedName, tref.Scope.QualifiedName), range0)) | _ -> res @@ -467,7 +467,7 @@ let envGetTypeDef emEnv (tref: ILTypeRef) = let envSetLocals emEnv locs = assert (emEnv.emLocals.Length = 0); // check "locals" is not yet set (scopes once only) {emEnv with emLocals = locs} -let envGetLocal emEnv i = emEnv.emLocals.[i] // implicit bounds checking +let envGetLocal emEnv i = emEnv.emLocals.[i] // implicit bounds checking let envSetLabel emEnv name lab = assert (not (Zmap.mem name emEnv.emLabels)) @@ -476,11 +476,11 @@ let envSetLabel emEnv name lab = 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 = +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" + | [] -> failwith "envGetTyvar: not scope of type vars" | tvs::_ -> let i = int32 u16 if i<0 || i>= Array.length tvs then @@ -490,23 +490,29 @@ 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 +let envAddEntryPt emEnv mref = {emEnv with emEntryPts = mref::emEnv.emEntryPts} +let envPopEntryPts emEnv = {emEnv with emEntryPts = []}, emEnv.emEntryPts //---------------------------------------------------------------------------- // convCallConv //---------------------------------------------------------------------------- let convCallConv (Callconv (hasThis, basic)) = - let ccA = match hasThis with ILThisConvention.Static -> CallingConventions.Standard - | ILThisConvention.InstanceExplicit -> CallingConventions.ExplicitThis - | ILThisConvention.Instance -> CallingConventions.HasThis - let ccB = match basic with ILArgConvention.Default -> enum 0 - | ILArgConvention.CDecl -> enum 0 - | ILArgConvention.StdCall -> enum 0 - | ILArgConvention.ThisCall -> enum 0 // XXX: check all these - | ILArgConvention.FastCall -> enum 0 - | ILArgConvention.VarArg -> CallingConventions.VarArgs + let ccA = + match hasThis with + | ILThisConvention.Static -> CallingConventions.Standard + | ILThisConvention.InstanceExplicit -> CallingConventions.ExplicitThis + | ILThisConvention.Instance -> CallingConventions.HasThis + + let ccB = + match basic with + | ILArgConvention.Default -> enum 0 + | ILArgConvention.CDecl -> enum 0 + | ILArgConvention.StdCall -> enum 0 + | ILArgConvention.ThisCall -> enum 0 // XXX: check all these + | ILArgConvention.FastCall -> enum 0 + | ILArgConvention.VarArg -> CallingConventions.VarArgs + ccA ||| ccB @@ -515,24 +521,24 @@ let convCallConv (Callconv (hasThis, basic)) = //---------------------------------------------------------------------------- let rec convTypeSpec cenv emEnv preferCreated (tspec: ILTypeSpec) = - let typT = convTypeRef cenv emEnv preferCreated tspec.TypeRef + let typT = convTypeRef cenv emEnv preferCreated tspec.TypeRef let tyargs = List.map (convTypeAux cenv emEnv preferCreated) tspec.GenericArgs let res = match isNil tyargs, typT.IsGenericType with - | _ , true -> typT.MakeGenericType(List.toArray tyargs) + | _, true -> typT.MakeGenericType(List.toArray tyargs) | true, false -> typT - | _ , false -> null + | _, false -> null match res with | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tspec.TypeRef.QualifiedName, tspec.Scope.QualifiedName), range0)) | _ -> res and convTypeAux cenv emEnv preferCreated ty = match ty with - | ILType.Void -> Type.GetType("System.Void") + | ILType.Void -> Type.GetType("System.Void") | ILType.Array (shape, eltType) -> let baseT = convTypeAux cenv emEnv preferCreated eltType let nDims = shape.Rank - // MakeArrayType() returns "eltType[]" + // MakeArrayType() returns "eltType[]" // MakeArrayType(1) returns "eltType[*]" // MakeArrayType(2) returns "eltType[, ]" // MakeArrayType(3) returns "eltType[, , ]" @@ -540,17 +546,17 @@ and convTypeAux cenv emEnv preferCreated ty = if nDims=1 then baseT.MakeArrayType() else baseT.MakeArrayType shape.Rank - | ILType.Value tspec -> convTypeSpec cenv emEnv preferCreated tspec - | ILType.Boxed tspec -> convTypeSpec cenv emEnv preferCreated tspec - | ILType.Ptr eltType -> + | ILType.Value tspec -> convTypeSpec cenv emEnv preferCreated tspec + | ILType.Boxed tspec -> convTypeSpec cenv emEnv preferCreated tspec + | ILType.Ptr eltType -> let baseT = convTypeAux cenv emEnv preferCreated eltType baseT.MakePointerType() - | ILType.Byref eltType -> + | ILType.Byref eltType -> let baseT = convTypeAux cenv emEnv preferCreated eltType baseT.MakeByRefType() - | ILType.TypeVar tv -> envGetTyvar emEnv tv + | ILType.TypeVar tv -> envGetTyvar emEnv tv // Consider completing the following cases: - | ILType.Modified (_, _, modifiedTy) -> + | ILType.Modified (_, _, modifiedTy) -> // Note, "modreq" are not being emitted. This is convTypeAux cenv emEnv preferCreated modifiedTy @@ -592,7 +598,7 @@ let convCreatedTypeRef cenv emEnv ty = convTypeRef cenv emEnv true ty let rec convParamModifiersOfType cenv emEnv (pty: ILType) = [| match pty with - | ILType.Modified (modreq, ty, modifiedTy) -> + | ILType.Modified (modreq, ty, modifiedTy) -> yield (modreq, convTypeRef cenv emEnv false ty) yield! convParamModifiersOfType cenv emEnv modifiedTy | _ -> () |] @@ -616,27 +622,27 @@ let convReturnModifiers cenv emEnv (p: ILReturn) = let convFieldInit x = match x with - | ILFieldInit.String s -> box s - | ILFieldInit.Bool bool -> box bool - | ILFieldInit.Char u16 -> box (char (int u16)) - | ILFieldInit.Int8 i8 -> box i8 - | ILFieldInit.Int16 i16 -> box i16 - | ILFieldInit.Int32 i32 -> box i32 - | ILFieldInit.Int64 i64 -> box i64 - | ILFieldInit.UInt8 u8 -> box u8 - | ILFieldInit.UInt16 u16 -> box u16 - | ILFieldInit.UInt32 u32 -> box u32 - | ILFieldInit.UInt64 u64 -> box u64 + | ILFieldInit.String s -> box s + | ILFieldInit.Bool bool -> box bool + | ILFieldInit.Char u16 -> box (char (int u16)) + | ILFieldInit.Int8 i8 -> box i8 + | ILFieldInit.Int16 i16 -> box i16 + | ILFieldInit.Int32 i32 -> box i32 + | ILFieldInit.Int64 i64 -> box i64 + | ILFieldInit.UInt8 u8 -> box u8 + | ILFieldInit.UInt16 u16 -> box u16 + | ILFieldInit.UInt32 u32 -> box u32 + | ILFieldInit.UInt64 u64 -> box u64 | ILFieldInit.Single ieee32 -> box ieee32 | ILFieldInit.Double ieee64 -> box ieee64 - | ILFieldInit.Null -> (null :> Object) + | ILFieldInit.Null -> (null :> Object) //---------------------------------------------------------------------------- // Some types require hard work... //---------------------------------------------------------------------------- // This is gross. TypeBuilderInstantiation should really be a public type, since we -// have to use alternative means for various Method/Field/Constructor lookups. However since +// have to use alternative means for various Method/Field/Constructor lookups. However since // it isn't we resort to this technique... let TypeBuilderInstantiationT = let ty = @@ -662,7 +668,7 @@ let typeIsNotQueryable (ty: Type) = // convFieldSpec //---------------------------------------------------------------------------- -let queryableTypeGetField _emEnv (parentT: Type) (fref: ILFieldRef) = +let queryableTypeGetField _emEnv (parentT: Type) (fref: ILFieldRef) = let res = parentT.GetField(fref.Name, BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance ||| BindingFlags.Static ) match res with | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("field", fref.Name, fref.DeclaringTypeRef.FullName, fref.DeclaringTypeRef.Scope.QualifiedName), range0)) @@ -689,7 +695,7 @@ let convFieldSpec cenv emEnv fspec = // Prior type. if typeIsNotQueryable parentTI then let parentT = getTypeConstructor parentTI - let fieldInfo = queryableTypeGetField emEnv parentT fref + let fieldInfo = queryableTypeGetField emEnv parentT fref nonQueryableTypeGetField parentTI fieldInfo else queryableTypeGetField emEnv parentTI fspec.FieldRef @@ -754,17 +760,17 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref: ILMethodRef) = let argTs, resT = let emEnv = envPushTyvars emEnv (Array.append tyargTs mtyargTIs) let argTs = convTypes cenv emEnv mref.ArgTypes - let resT = convType cenv emEnv mref.ReturnType + let resT = convType cenv emEnv mref.ReturnType argTs, resT - let haveResT = methInfo.ReturnType + let haveResT = methInfo.ReturnType (* check for match *) if argTs.Length <> methodParameters.Length then false (* method argument length mismatch *) else let res = equalTypes resT haveResT && equalTypeLists argTs (haveArgTs |> Array.toList) res match List.tryFind select methInfos with - | None -> + | None -> let methNames = methInfos |> List.map (fun m -> m.Name) |> List.distinct failwithf "convMethodRef: could not bind to method '%A' of type '%s'" (System.String.Join(", ", methNames)) parentT.AssemblyQualifiedName | Some methInfo -> methInfo (* return MethodInfo for (generic) type's (generic) method *) @@ -776,7 +782,7 @@ let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) = let argTs, resT = let emEnv = envPushTyvars emEnv tyargTs let argTs = convTypesToArray cenv emEnv mref.ArgTypes - let resT = convType cenv emEnv mref.ReturnType + let resT = convType cenv emEnv mref.ReturnType argTs, resT let stat = mref.CallingConv.IsStatic let cconv = (if stat then BindingFlags.Static else BindingFlags.Instance) @@ -830,13 +836,13 @@ let convMethodRef cenv emEnv (parentTI: Type) (mref: ILMethodRef) = //---------------------------------------------------------------------------- let convMethodSpec cenv emEnv (mspec: ILMethodSpec) = - let typT = convType cenv emEnv mspec.DeclaringType (* (instanced) parent Type *) - let methInfo = convMethodRef cenv emEnv typT mspec.MethodRef (* (generic) method of (generic) parent *) + let typT = convType cenv emEnv mspec.DeclaringType (* (instanced) parent Type *) + let methInfo = convMethodRef cenv emEnv typT mspec.MethodRef (* (generic) method of (generic) parent *) let methInfo = if isNil mspec.GenericArgs then methInfo // non generic else - let minstTs = convTypesToArray cenv emEnv mspec.GenericArgs + let minstTs = convTypesToArray cenv emEnv mspec.GenericArgs let methInfo = methInfo.MakeGenericMethod minstTs // instantiate method methInfo methInfo @@ -845,9 +851,9 @@ let convMethodSpec cenv emEnv (mspec: ILMethodSpec) = // - QueryableTypeGetConstructors: get a constructor on a non-TypeBuilder type //---------------------------------------------------------------------------- -let queryableTypeGetConstructor cenv emEnv (parentT: Type) (mref: ILMethodRef) = - let tyargTs = getGenericArgumentsOfType parentT - let reqArgTs = +let queryableTypeGetConstructor cenv emEnv (parentT: Type) (mref: ILMethodRef) = + let tyargTs = getGenericArgumentsOfType parentT + let reqArgTs = let emEnv = envPushTyvars emEnv tyargTs convTypesToArray cenv emEnv mref.ArgTypes let res = parentT.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance, null, reqArgTs, null) @@ -864,7 +870,7 @@ let nonQueryableTypeGetConstructor (parentTI: Type) (consInfo: ConstructorInfo) //---------------------------------------------------------------------------- let convConstructorSpec cenv emEnv (mspec: ILMethodSpec) = - let mref = mspec.MethodRef + let mref = mspec.MethodRef let parentTI = convType cenv emEnv mspec.DeclaringType let res = if isEmittedTypeRef emEnv mref.DeclaringTypeRef then @@ -873,7 +879,7 @@ let convConstructorSpec cenv emEnv (mspec: ILMethodSpec) = else // Prior type. if typeIsNotQueryable parentTI then - let parentT = getTypeConstructor parentTI + let parentT = getTypeConstructor parentTI let ctorG = queryableTypeGetConstructor cenv emEnv parentT mref nonQueryableTypeGetConstructor parentTI ctorG else @@ -895,30 +901,30 @@ let emitLabelMark emEnv (ilG: ILGenerator) (label: ILCodeLabel) = //---------------------------------------------------------------------------- ///Emit comparison instructions. -let emitInstrCompare emEnv (ilG: ILGenerator) comp targ = +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_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_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 let emitInstrAlign (ilG: ILGenerator) = function - | Aligned -> () + | Aligned -> () | Unaligned1 -> ilG.Emit(OpCodes.Unaligned, 1L) // note: doc says use "long" overload! | Unaligned2 -> ilG.Emit(OpCodes.Unaligned, 2L) | Unaligned4 -> ilG.Emit(OpCodes.Unaligned, 3L) @@ -926,12 +932,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) = @@ -943,7 +949,7 @@ let emitInstrCall cenv emEnv (ilG: ILGenerator) opCall tail (mspec: ILMethodSpec if mspec.MethodRef.Name = ".ctor" || mspec.MethodRef.Name = ".cctor" then let cinfo = convConstructorSpec cenv emEnv mspec match varargs with - | None -> ilG.EmitAndLog (opCall, cinfo) + | None -> ilG.EmitAndLog (opCall, cinfo) | Some _varargTys -> failwith "emitInstrCall: .ctor and varargs" else let minfo = convMethodSpec cenv emEnv mspec @@ -971,7 +977,7 @@ let setArrayMethInfo n ty = | 2 -> getGenericMethodDefinition <@@ LanguagePrimitives.IntrinsicFunctions.SetArray2D null 0 0 0 @@> ty | 3 -> getGenericMethodDefinition <@@ LanguagePrimitives.IntrinsicFunctions.SetArray3D null 0 0 0 0 @@> ty | 4 -> getGenericMethodDefinition <@@ LanguagePrimitives.IntrinsicFunctions.SetArray4D null 0 0 0 0 0 @@> ty - | _ -> invalidArg "n" "not expecting array dimension > 4" + | _ -> invalidArg "n" "not expecting array dimension > 4" //---------------------------------------------------------------------------- @@ -980,142 +986,142 @@ 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 -> + | 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 -> + | 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_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 + | 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 | DT_REF -> failwith "AI_conv_ovf DT_REF?" // XXX - check // conversion - ovf checks and unsigned - | AI_conv_ovf_un dt -> + | 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_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_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_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_ldind (align, vol, dt) -> + | 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_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_R -> failwith "emitInstr cenv: ldind R" - | 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_U8 -> failwith "emitInstr cenv: ldind U8" + | 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_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_U8 -> failwith "emitInstr cenv: ldind U8" | DT_REF -> ilG.EmitAndLog(OpCodes.Ldind_Ref) - | I_ldloc u16 -> ilG.EmitAndLog(OpCodes.Ldloc , int16 u16) + | 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) -> + | 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_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_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_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_call (tail, mspec, varargs) -> + | I_call (tail, mspec, varargs) -> emitSilverlightCheck ilG emitInstrCall cenv emEnv ilG OpCodes.Call tail mspec varargs @@ -1127,7 +1133,7 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = ilG.Emit(OpCodes.Constrained, convType cenv emEnv ty) emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs - | I_calli (tail, callsig, None) -> + | I_calli (tail, callsig, None) -> emitInstrTail ilG tail (fun () -> ilG.EmitCalli(OpCodes.Calli, convCallConv callsig.CallingConv, @@ -1149,49 +1155,49 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = | 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) -> + | I_stsfld (vol, fspec) -> emitInstrVolatile ilG vol ilG.EmitAndLog(OpCodes.Stsfld, convFieldSpec cenv emEnv fspec) - | I_stfld (align, vol, 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_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) + | 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 @@ -1205,55 +1211,55 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = // generalized instruction with the corresponding ILArrayShape // argument. This is done to simplify the IL and make it more uniform. // The IL writer then reverses this when emitting the binary. - | I_ldelem dt -> + | 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_R -> failwith "emitInstr cenv: ldelem R" - | 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_U8 -> failwith "emitInstr cenv: ldelem U8" + | 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_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_U8 -> failwith "emitInstr cenv: ldelem U8" | 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_R -> failwith "emitInstr cenv: stelem R" - | 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_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_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) - | I_ldelema (ro, _isNativePtr, shape, ty) -> + | I_ldelema (ro, _isNativePtr, shape, ty) -> 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 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) - | I_ldelem_any (shape, ty) -> - if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Ldelem, convType cenv emEnv ty) + | I_ldelem_any (shape, 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 aty = convType cenv emEnv (ILType.Array(shape, ty)) let ety = aty.GetElementType() let meth = #if ENABLE_MONO_SUPPORT @@ -1265,10 +1271,10 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = 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) + | I_stelem_any (shape, 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 aty = convType cenv emEnv (ILType.Array(shape, ty)) let ety = aty.GetElementType() let meth = #if ENABLE_MONO_SUPPORT @@ -1280,21 +1286,21 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = 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) -> + | 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 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) - | I_seqpoint src -> + | 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 () @@ -1304,15 +1310,15 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = 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) - | I_initblk (align, vol) -> + | I_initblk (align, vol) -> emitInstrAlign ilG align emitInstrVolatile ilG vol ilG.EmitAndLog(OpCodes.Initblk) @@ -1327,7 +1333,7 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = let emitCode cenv modB emEnv (ilG: ILGenerator) (code: ILCode) = // Pre-define the labels pending determining their actual marks let pc2lab = Dictionary() - let emEnv = + let emEnv = (emEnv, code.Labels) ||> Seq.fold (fun emEnv (KeyValue(label, pc)) -> let lab = ilG.DefineLabelAndLog() pc2lab.[pc] <- @@ -1366,7 +1372,7 @@ let emitCode cenv modB emEnv (ilG: ILGenerator) (code: ILCode) = add endHandler ilG.EndExceptionBlockAndLog | ILExceptionClause.TypeCatch(ty, (startHandler, endHandler)) -> - add startHandler (fun () -> ilG.BeginCatchBlockAndLog (convType cenv emEnv ty)) + add startHandler (fun () -> ilG.BeginCatchBlockAndLog (convType cenv emEnv ty)) add endHandler ilG.EndExceptionBlockAndLog // Emit the instructions @@ -1392,7 +1398,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 ty = convType cenv emEnv local.Type let locBuilder = ilG.DeclareLocalAndLog(ty, local.IsPinned) #if !FX_NO_PDB_WRITER match local.DebugInfo with @@ -1409,11 +1415,11 @@ let emitILMethodBody cenv modB emEnv (ilG: ILGenerator) (ilmbody: ILMethodBody) let emitMethodBody cenv modB emEnv ilG _name (mbody: ILLazyMethodBody) = match mbody.Contents with - | MethodBody.IL ilmbody -> emitILMethodBody cenv modB emEnv (ilG()) ilmbody - | MethodBody.PInvoke _pinvoke -> () - | MethodBody.Abstract -> () - | MethodBody.Native -> failwith "emitMethodBody: native" - | MethodBody.NotAvailable -> failwith "emitMethodBody: metadata only" + | MethodBody.IL ilmbody -> emitILMethodBody cenv modB emEnv (ilG()) ilmbody + | MethodBody.PInvoke _pinvoke -> () + | MethodBody.Abstract -> () + | MethodBody.Native -> failwith "emitMethodBody: native" + | MethodBody.NotAvailable -> failwith "emitMethodBody: metadata only" let convCustomAttr cenv emEnv (cattr: ILAttribute) = let methInfo = @@ -1423,7 +1429,7 @@ let convCustomAttr cenv emEnv (cattr: ILAttribute) = let data = getCustomAttrData cenv.ilg cattr (methInfo, data) -let emitCustomAttr cenv emEnv add cattr = add (convCustomAttr cenv emEnv cattr) +let emitCustomAttr cenv emEnv add cattr = add (convCustomAttr cenv emEnv cattr) let emitCustomAttrs cenv emEnv add (cattrs: ILAttributes) = Array.iter (emitCustomAttr cenv emEnv add) cattrs.AsArray //---------------------------------------------------------------------------- @@ -1435,14 +1441,14 @@ let buildGenParamsPass1 _emEnv defineGenericParameters (gps: ILGenericParameterD | [] -> () | gps -> let gpsNames = gps |> List.map (fun gp -> gp.Name) - defineGenericParameters (Array.ofList gpsNames) |> ignore + defineGenericParameters (Array.ofList gpsNames) |> ignore let buildGenParamsPass1b cenv emEnv (genArgs: Type array) (gps: ILGenericParameterDefs) = #if FX_RESHAPED_REFLECTION - let genpBs = genArgs |> Array.map (fun x -> (x.GetTypeInfo() :?> GenericTypeParameterBuilder)) + let genpBs = genArgs |> Array.map (fun x -> (x.GetTypeInfo() :?> GenericTypeParameterBuilder)) #else - let genpBs = genArgs |> Array.map (fun x -> (x :?> GenericTypeParameterBuilder)) + let genpBs = genArgs |> Array.map (fun x -> (x :?> GenericTypeParameterBuilder)) #endif gps |> List.iteri (fun i (gp: ILGenericParameterDef) -> let gpB = genpBs.[i] @@ -1451,9 +1457,9 @@ let buildGenParamsPass1b cenv emEnv (genArgs: Type array) (gps: ILGenericParamet let interfaceTs, baseTs = List.partition (fun (ty: System.Type) -> ty.IsInterface) constraintTs // set base type constraint (match baseTs with - [ ] -> () // Q: should a baseType be set? It is in some samples. Should this be a failure case? + [ ] -> () // Q: should a baseType be set? It is in some samples. Should this be a failure case? | [ baseT ] -> gpB.SetBaseTypeConstraint(baseT) - | _ -> failwith "buildGenParam: multiple base types" + | _ -> failwith "buildGenParam: multiple base types" ) // set interface constraints (interfaces that instances of gp must meet) gpB.SetInterfaceConstraints(Array.ofList interfaceTs) @@ -1462,13 +1468,13 @@ let buildGenParamsPass1b cenv emEnv (genArgs: Type array) (gps: ILGenericParamet let flags = GenericParameterAttributes.None let flags = match gp.Variance with - | NonVariant -> flags - | CoVariant -> flags ||| GenericParameterAttributes.Covariant + | NonVariant -> flags + | CoVariant -> flags ||| GenericParameterAttributes.Covariant | ContraVariant -> flags ||| GenericParameterAttributes.Contravariant - let flags = if gp.HasReferenceTypeConstraint then flags ||| GenericParameterAttributes.ReferenceTypeConstraint else flags + let flags = if gp.HasReferenceTypeConstraint then flags ||| GenericParameterAttributes.ReferenceTypeConstraint else flags let flags = if gp.HasNotNullableValueTypeConstraint then flags ||| GenericParameterAttributes.NotNullableValueTypeConstraint else flags - let flags = if gp.HasDefaultConstructorConstraint then flags ||| GenericParameterAttributes.DefaultConstructorConstraint else flags + let flags = if gp.HasDefaultConstructorConstraint then flags ||| GenericParameterAttributes.DefaultConstructorConstraint else flags gpB.SetGenericParameterAttributes(flags) ) @@ -1480,13 +1486,13 @@ let emitParameter cenv emEnv (defineParameter: int * ParameterAttributes * strin // -Type: ty // -Default: ILFieldInit option // -Marshal: NativeType option; (* Marshalling map for parameters. COM Interop only. *) - let attrs = flagsIf param.IsIn ParameterAttributes.In ||| - flagsIf param.IsOut ParameterAttributes.Out ||| + let attrs = flagsIf param.IsIn ParameterAttributes.In ||| + flagsIf param.IsOut ParameterAttributes.Out ||| flagsIf param.IsOptional ParameterAttributes.Optional let name = match param.Name with | Some name -> name - | None -> "X" + string(i+1) + | None -> "X" + string(i+1) let parB = defineParameter(i, attrs, name) emitCustomAttrs cenv emEnv (wrapCustomAttr parB.SetCustomAttribute) param.CustomAttrs @@ -1507,9 +1513,9 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) emEnv match mdef.Body.Contents with #if !FX_RESHAPED_REFEMIT - | MethodBody.PInvoke p -> + | MethodBody.PInvoke p -> let argtys = convTypesToArray cenv emEnv mdef.ParameterTypes - let rty = convType cenv emEnv mdef.Return.Type + let rty = convType cenv emEnv mdef.Return.Type let pcc = match p.CallingConv with @@ -1541,7 +1547,7 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) let consB = typB.DefineConstructorAndLog(attrs, cconv, convTypesToArray cenv emEnv mdef.ParameterTypes) consB.SetImplementationFlagsAndLog(implflags) envBindConsRef emEnv mref consB - | _name -> + | _name -> // The return/argument types may involve the generic parameters let methB = typB.DefineMethodAndLog(mdef.Name, attrs, cconv) @@ -1560,7 +1566,7 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) |> Array.unzip let returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers = mdef.Return |> convReturnModifiers cenv emEnv - let returnType = convType cenv emEnv mdef.Return.Type + let returnType = convType cenv emEnv mdef.Return.Type methB.SetSignatureAndLog(returnType, returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers, parameterTypes, parameterTypeRequiredCustomModifiers,parameterTypeOptionalCustomModifiers) @@ -1574,10 +1580,10 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) //---------------------------------------------------------------------------- let rec buildMethodPass3 cenv tref modB (typB: TypeBuilder) emEnv (mdef: ILMethodDef) = - let mref = mkRefToILMethod (tref, mdef) + let mref = mkRefToILMethod (tref, mdef) let isPInvoke = match mdef.Body.Contents with - | MethodBody.PInvoke _p -> true + | MethodBody.PInvoke _p -> true | _ -> false match mdef.Name with | ".cctor" | ".ctor" -> @@ -1618,7 +1624,7 @@ let rec buildMethodPass3 cenv tref modB (typB: TypeBuilder) emEnv (mdef: ILMetho let buildFieldPass2 cenv tref (typB: TypeBuilder) emEnv (fdef: ILFieldDef) = let attrs = fdef.Attributes - let fieldT = convType cenv emEnv fdef.FieldType + let fieldT = convType cenv emEnv fdef.FieldType let fieldB = match fdef.Data with | Some d -> typB.DefineInitializedData(fdef.Name, d, attrs) @@ -1642,7 +1648,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) @@ -1659,9 +1665,9 @@ let buildFieldPass3 cenv tref (_typB: TypeBuilder) emEnv (fdef: ILFieldDef) = let buildPropertyPass2 cenv tref (typB: TypeBuilder) emEnv (prop: ILPropertyDef) = let attrs = flagsIf prop.IsRTSpecialName PropertyAttributes.RTSpecialName ||| - flagsIf prop.IsSpecialName PropertyAttributes.SpecialName + 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)) @@ -1685,7 +1691,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)) @@ -1700,7 +1706,7 @@ let buildEventPass3 cenv (typB: TypeBuilder) emEnv (eventDef: ILEventDef) = let buildMethodImplsPass3 cenv _tref (typB: TypeBuilder) emEnv (mimpl: IL.ILMethodImplDef) = let bodyMethInfo = convMethodRef cenv emEnv (typB.AsType()) mimpl.OverrideBy.MethodRef // doc: must be MethodBuilder let (OverridesSpec (mref, dtyp)) = mimpl.Overrides - let declMethTI = convType cenv emEnv dtyp + let declMethTI = convType cenv emEnv dtyp let declMethInfo = convMethodRef cenv emEnv declMethTI mref typB.DefineMethodOverride(bodyMethInfo, declMethInfo) emEnv @@ -1712,31 +1718,31 @@ let buildMethodImplsPass3 cenv _tref (typB: TypeBuilder) emEnv (mimpl: IL.ILMeth let typeAttrbutesOfTypeDefKind x = match x with // required for a TypeBuilder - | ILTypeDefKind.Class -> TypeAttributes.Class - | ILTypeDefKind.ValueType -> TypeAttributes.Class - | ILTypeDefKind.Interface -> TypeAttributes.Interface - | ILTypeDefKind.Enum -> TypeAttributes.Class - | ILTypeDefKind.Delegate -> TypeAttributes.Class + | ILTypeDefKind.Class -> TypeAttributes.Class + | ILTypeDefKind.ValueType -> TypeAttributes.Class + | ILTypeDefKind.Interface -> TypeAttributes.Interface + | ILTypeDefKind.Enum -> TypeAttributes.Class + | ILTypeDefKind.Delegate -> TypeAttributes.Class let typeAttrbutesOfTypeAccess x = match x with - | ILTypeDefAccess.Public -> TypeAttributes.Public - | ILTypeDefAccess.Private -> TypeAttributes.NotPublic - | ILTypeDefAccess.Nested macc -> + | ILTypeDefAccess.Public -> TypeAttributes.Public + | ILTypeDefAccess.Private -> TypeAttributes.NotPublic + | ILTypeDefAccess.Nested macc -> match macc with - | ILMemberAccess.Assembly -> TypeAttributes.NestedAssembly - | ILMemberAccess.CompilerControlled -> failwith "Nested compiler controled." - | ILMemberAccess.FamilyAndAssembly -> TypeAttributes.NestedFamANDAssem - | ILMemberAccess.FamilyOrAssembly -> TypeAttributes.NestedFamORAssem - | ILMemberAccess.Family -> TypeAttributes.NestedFamily - | ILMemberAccess.Private -> TypeAttributes.NestedPrivate - | ILMemberAccess.Public -> TypeAttributes.NestedPublic + | ILMemberAccess.Assembly -> TypeAttributes.NestedAssembly + | ILMemberAccess.CompilerControlled -> failwith "Nested compiler controled." + | ILMemberAccess.FamilyAndAssembly -> TypeAttributes.NestedFamANDAssem + | ILMemberAccess.FamilyOrAssembly -> TypeAttributes.NestedFamORAssem + | ILMemberAccess.Family -> TypeAttributes.NestedFamily + | ILMemberAccess.Private -> TypeAttributes.NestedPrivate + | ILMemberAccess.Public -> TypeAttributes.NestedPublic let typeAttributesOfTypeEncoding x = match x with - | ILDefaultPInvokeEncoding.Ansi -> TypeAttributes.AnsiClass + | ILDefaultPInvokeEncoding.Ansi -> TypeAttributes.AnsiClass | ILDefaultPInvokeEncoding.Auto -> TypeAttributes.AutoClass - | ILDefaultPInvokeEncoding.Unicode -> TypeAttributes.UnicodeClass + | ILDefaultPInvokeEncoding.Unicode -> TypeAttributes.UnicodeClass let typeAttributesOfTypeLayout cenv emEnv x = @@ -1750,12 +1756,12 @@ let typeAttributesOfTypeLayout cenv emEnv x = (tref1, [mkILNonGenericValueTy tref2 ], [ ILAttribElem.Int32 x ], - (p.Pack |> Option.toList |> List.map (fun x -> ("Pack", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 (int32 x)))) @ + (p.Pack |> Option.toList |> List.map (fun x -> ("Pack", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 (int32 x)))) @ (p.Size |> Option.toList |> List.map (fun x -> ("Size", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 x)))))) | _ -> None match x with - | ILTypeDefLayout.Auto -> None - | ILTypeDefLayout.Explicit p -> (attr 0x02 p) + | ILTypeDefLayout.Auto -> None + | ILTypeDefLayout.Explicit p -> (attr 0x02 p) | ILTypeDefLayout.Sequential p -> (attr 0x00 p) @@ -1773,7 +1779,7 @@ let rec buildTypeDefPass1 cenv emEnv (modB: ModuleBuilder) rootTypeBuilder nesti let attrsType = tdef.Attributes // TypeBuilder from TypeAttributes. - let typB: TypeBuilder = rootTypeBuilder (tdef.Name, attrsType) + let typB: TypeBuilder = rootTypeBuilder (tdef.Name, attrsType) cattrsLayout |> Option.iter typB.SetCustomAttributeAndLog buildGenParamsPass1 emEnv typB.DefineGenericParametersAndLog tdef.GenericParams @@ -1801,12 +1807,12 @@ and buildTypeTypeDef cenv emEnv modB (typB: TypeBuilder) nesting tdef = let rec buildTypeDefPass1b cenv nesting emEnv (tdef: ILTypeDef) = let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) - let typB = envGetTypB emEnv tref + let typB = envGetTypB emEnv tref 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)) - // build constraints on ILGenericParameterDefs. Constraints may reference types being defined, + 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 let emEnv = envPopTyvars emEnv @@ -1819,14 +1825,14 @@ let rec buildTypeDefPass1b cenv nesting emEnv (tdef: ILTypeDef) = let rec buildTypeDefPass2 cenv nesting emEnv (tdef: ILTypeDef) = let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) - let typB = envGetTypB emEnv tref + 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)) // 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 - let emEnv = List.fold (buildPropertyPass2 cenv tref typB) emEnv tdef.Properties.AsList + let emEnv = Array.fold (buildMethodPass2 cenv tref typB) emEnv tdef.Methods.AsArray + let emEnv = List.fold (buildFieldPass2 cenv tref typB) emEnv tdef.Fields.AsList + let emEnv = List.fold (buildPropertyPass2 cenv tref typB) emEnv tdef.Properties.AsList let emEnv = envPopTyvars emEnv // nested types let nesting = nesting @ [tdef] @@ -1861,9 +1867,9 @@ let rec buildTypeDefPass3 cenv nesting modB emEnv (tdef: ILTypeDef) = // The code in this phase is fragile. // // THe background is that System.Reflection.Emit implementations can be finnickity about the -// order that CreateType calls are made when types refer to each other. Some of these restrictions +// order that CreateType calls are made when types refer to each other. Some of these restrictions // are not well documented, or are related to historical bugs where the F# emit code worked around the -// underlying problems. Ideally the SRE implementation would just "work this out as it goes along" but +// underlying problems. Ideally the SRE implementation would just "work this out as it goes along" but // unfortunately that's not been the case. // // Here are some known cases: @@ -1888,7 +1894,7 @@ let rec buildTypeDefPass3 cenv nesting modB emEnv (tdef: ILTypeDef) = // // // There is also a case where generic parameter constraints were being checked before -// a generic method was called. This forced the loading of the types involved in the +// a generic method was called. This forced the loading of the types involved in the // constraints very early. // @@ -1906,7 +1912,7 @@ type CollectTypes = ValueTypesOnly | All let rec getTypeRefsInType (allTypes: CollectTypes) ty acc = match ty with | ILType.Void - | ILType.TypeVar _ -> acc + | ILType.TypeVar _ -> acc | ILType.Ptr eltType | ILType.Byref eltType -> getTypeRefsInType allTypes eltType acc | ILType.Array (_, eltType) -> @@ -1922,7 +1928,7 @@ let rec getTypeRefsInType (allTypes: CollectTypes) ty acc = | CollectTypes.ValueTypesOnly -> acc | CollectTypes.All -> tspec.TypeRef :: List.foldBack (getTypeRefsInType allTypes) tspec.GenericArgs acc | ILType.FunctionPointer _callsig -> failwith "getTypeRefsInType: fptr" - | ILType.Modified _ -> failwith "getTypeRefsInType: modified" + | ILType.Modified _ -> failwith "getTypeRefsInType: modified" let verbose2 = false @@ -1986,11 +1992,11 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t let typeName = r.Name let typeRef = ILTypeRef.Create(ILScopeRef.Local, nestingToProbe, typeName) match emEnv.emTypMap.TryFind typeRef with - | Some(_, tb, _, _) -> + | Some(_, tb, _, _) -> if not (tb.IsCreated()) then tb.CreateTypeAndLog() |> ignore tb.Assembly - | None -> null + | None -> null ) // For some reason, the handler is installed while running 'traverseTypeDef' but not while defining the type // itself. @@ -2001,11 +2007,11 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t System.AppDomain.CurrentDomain.remove_TypeResolve typeCreationHandler #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. + // load of other types. Everything else is up to the implementation of System.Reflection.Emit. 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 @@ -2026,10 +2032,10 @@ let rec buildTypeDefPass4 (visited, created) nesting emEnv (tdef: ILTypeDef) = let buildModuleTypePass1 cenv (modB: ModuleBuilder) emEnv (tdef: ILTypeDef) = buildTypeDefPass1 cenv emEnv modB modB.DefineTypeAndLog [] tdef -let buildModuleTypePass1b cenv emEnv tdef = buildTypeDefPass1b cenv [] emEnv tdef -let buildModuleTypePass2 cenv emEnv tdef = buildTypeDefPass2 cenv [] emEnv tdef +let buildModuleTypePass1b cenv emEnv tdef = buildTypeDefPass1b cenv [] emEnv tdef +let buildModuleTypePass2 cenv emEnv tdef = buildTypeDefPass2 cenv [] emEnv tdef let buildModuleTypePass3 cenv modB emEnv tdef = buildTypeDefPass3 cenv [] modB emEnv tdef -let buildModuleTypePass4 visited emEnv tdef = buildTypeDefPass4 visited [] emEnv tdef +let buildModuleTypePass4 visited emEnv tdef = buildTypeDefPass4 visited [] emEnv tdef //---------------------------------------------------------------------------- // buildModuleFragment - only the types the fragment get written @@ -2050,7 +2056,7 @@ let buildModuleFragment cenv emEnv (asmB: AssemblyBuilder) (modB: ModuleBuilder) let emEnv = (emEnv, tdefs) ||> List.fold (buildModuleTypePass3 cenv modB) let visited = new Dictionary<_, _>(10) let created = new Dictionary<_, _>(10) - tdefs |> List.iter (buildModuleTypePass4 (visited, created) emEnv) + tdefs |> List.iter (buildModuleTypePass4 (visited, created) emEnv) let emEnv = Seq.fold envUpdateCreatedTypeRef emEnv created.Keys // update typT with the created typT emitCustomAttrs cenv emEnv modB.SetCustomAttributeAndLog m.CustomAttrs #if FX_RESHAPED_REFEMIT @@ -2078,7 +2084,7 @@ let defineDynamicAssemblyAndLog(asmName, flags, asmDir: string) = #if FX_NO_APP_DOMAINS let asmB = AssemblyBuilder.DefineDynamicAssembly(asmName, flags) #else - let currentDom = System.AppDomain.CurrentDomain + let currentDom = System.AppDomain.CurrentDomain let asmB = currentDom.DefineDynamicAssembly(asmName, flags, asmDir) #endif if logRefEmitCalls then @@ -2090,7 +2096,7 @@ let defineDynamicAssemblyAndLog(asmName, flags, asmDir: string) = let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) = let filename = assemblyName + ".dll" - let asmDir = "." + let asmDir = "." let asmName = new AssemblyName() asmName.Name <- assemblyName let asmAccess = @@ -2104,7 +2110,7 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) 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 |]) + let daBuilder = new CustomAttributeBuilder(daCtor, [| System.Diagnostics.DebuggableAttribute.DebuggingModes.DisableOptimizations ||| System.Diagnostics.DebuggableAttribute.DebuggingModes.Default |]) asmB.SetCustomAttributeAndLog(daBuilder) let modB = asmB.DefineDynamicModuleAndLog(assemblyName, filename, debugInfo) @@ -2144,10 +2150,10 @@ let emitModuleFragment (ilg, emEnv, asmB: AssemblyBuilder, modB: ModuleBuilder, // The emEnv stores (typT: Type) for each tref. // Once the emitted type is created this typT is updated to ensure it is the Type proper. // So Type lookup will return the proper Type not TypeBuilder. -let LookupTypeRef cenv emEnv tref = convCreatedTypeRef cenv emEnv tref -let LookupType cenv emEnv ty = convCreatedType cenv emEnv ty +let LookupTypeRef cenv emEnv tref = convCreatedTypeRef cenv emEnv tref +let LookupType cenv emEnv ty = convCreatedType cenv emEnv ty // Lookups of ILFieldRef and MethodRef may require a similar non-Builder-fixup post Type-creation. -let LookupFieldRef emEnv fref = Zmap.tryFind fref emEnv.emFieldMap |> Option.map (fun fieldBuilder -> fieldBuilder :> FieldInfo) -let LookupMethodRef emEnv mref = Zmap.tryFind mref emEnv.emMethMap |> Option.map (fun methodBuilder -> methodBuilder :> MethodInfo) +let LookupFieldRef emEnv fref = Zmap.tryFind fref emEnv.emFieldMap |> Option.map (fun fieldBuilder -> fieldBuilder :> FieldInfo) +let LookupMethodRef emEnv mref = Zmap.tryFind mref emEnv.emMethMap |> Option.map (fun methodBuilder -> methodBuilder :> MethodInfo) diff --git a/src/absil/ilsupp.fs b/src/absil/ilsupp.fs index 63ff3211f03..5f9932662d8 100644 --- a/src/absil/ilsupp.fs +++ b/src/absil/ilsupp.fs @@ -45,11 +45,11 @@ let MAX_PATH = 260 let E_FAIL = 0x80004005 -let bytesToWord ((b0: byte) , (b1: byte)) = +let bytesToWord ((b0: byte), (b1: byte)) = (int16)b0 ||| ((int16)b1 <<< 8) -let bytesToDWord ((b0: byte) , (b1: byte) , (b2: byte) , (b3: byte)) = +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)) = +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 diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 74cbc5e43b1..a8b879ce2b4 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. module internal FSharp.Compiler.AbstractIL.ILBinaryWriter @@ -34,10 +34,10 @@ let showEntryLookups = false //--------------------------------------------------------------------- // Little-endian encoding of int32 -let b0 n = byte (n &&& 0xFF) -let b1 n = byte ((n >>> 8) &&& 0xFF) -let b2 n = byte ((n >>> 16) &&& 0xFF) -let b3 n = byte ((n >>> 24) &&& 0xFF) +let b0 n = byte (n &&& 0xFF) +let b1 n = byte ((n >>> 8) &&& 0xFF) +let b2 n = byte ((n >>> 16) &&& 0xFF) +let b3 n = byte ((n >>> 24) &&& 0xFF) // Little-endian encoding of int64 let dw7 n = byte ((n >>> 56) &&& 0xFFL) @@ -46,7 +46,7 @@ let dw5 n = byte ((n >>> 40) &&& 0xFFL) let dw4 n = byte ((n >>> 32) &&& 0xFFL) let dw3 n = byte ((n >>> 24) &&& 0xFFL) let dw2 n = byte ((n >>> 16) &&& 0xFFL) -let dw1 n = byte ((n >>> 8) &&& 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) @@ -71,16 +71,16 @@ type ByteBuffer with /// Emit int32 as compressed unsigned integer member buf.EmitZ32 n = - if n >= 0 && n <= 0x7F then + if n >= 0 && n <= 0x7F then buf.EmitIntAsByte n elif n >= 0x80 && n <= 0x3FFF then buf.EmitIntAsByte (0x80 ||| (n >>> 8)) buf.EmitIntAsByte (n &&& 0xFF) else - buf.EmitIntAsByte (0xc0l ||| ((n >>> 24) &&& 0xFF)) - buf.EmitIntAsByte ( (n >>> 16) &&& 0xFF) - buf.EmitIntAsByte ( (n >>> 8) &&& 0xFF) - buf.EmitIntAsByte ( n &&& 0xFF) + buf.EmitIntAsByte (0xC0 ||| ((n >>> 24) &&& 0xFF)) + buf.EmitIntAsByte ((n >>> 16) &&& 0xFF) + buf.EmitIntAsByte ((n >>> 8) &&& 0xFF) + buf.EmitIntAsByte (n &&& 0xFF) member buf.EmitPadding n = for i = 0 to n-1 do @@ -144,7 +144,7 @@ let checkFixup32 (data: byte[]) offset exp = if data.[offset] <> b0 exp then failwith "fixup sanity check failed" let applyFixup32 (data: byte[]) offset v = - data.[offset] <- b0 v + data.[offset] <- b0 v data.[offset+1] <- b1 v data.[offset+2] <- b2 v data.[offset+3] <- b3 v @@ -222,59 +222,59 @@ module RowElementTags = let [] Blob = 5 let [] String = 6 let [] SimpleIndexMin = 7 - let SimpleIndex (t : TableName) = assert (t.Index <= 112); SimpleIndexMin + t.Index + let SimpleIndex (t : TableName) = assert (t.Index <= 112); SimpleIndexMin + t.Index let [] SimpleIndexMax = 119 let [] TypeDefOrRefOrSpecMin = 120 - let TypeDefOrRefOrSpec (t: TypeDefOrRefTag) = assert (t.Tag <= 2); TypeDefOrRefOrSpecMin + t.Tag (* + 111 + 1 = 0x70 + 1 = max TableName.Tndex + 1 *) + let TypeDefOrRefOrSpec (t: TypeDefOrRefTag) = assert (t.Tag <= 2); TypeDefOrRefOrSpecMin + t.Tag (* + 111 + 1 = 0x70 + 1 = max TableName.Tndex + 1 *) let [] TypeDefOrRefOrSpecMax = 122 let [] TypeOrMethodDefMin = 123 - let TypeOrMethodDef (t: TypeOrMethodDefTag) = assert (t.Tag <= 1); TypeOrMethodDefMin + t.Tag (* + 2 + 1 = max TypeDefOrRefOrSpec.Tag + 1 *) + let TypeOrMethodDef (t: TypeOrMethodDefTag) = assert (t.Tag <= 1); TypeOrMethodDefMin + t.Tag (* + 2 + 1 = max TypeDefOrRefOrSpec.Tag + 1 *) let [] TypeOrMethodDefMax = 124 let [] HasConstantMin = 125 - let HasConstant (t: HasConstantTag) = assert (t.Tag <= 2); HasConstantMin + t.Tag (* + 1 + 1 = max TypeOrMethodDef.Tag + 1 *) + let HasConstant (t: HasConstantTag) = assert (t.Tag <= 2); HasConstantMin + t.Tag (* + 1 + 1 = max TypeOrMethodDef.Tag + 1 *) let [] HasConstantMax = 127 let [] HasCustomAttributeMin = 128 - let HasCustomAttribute (t: HasCustomAttributeTag) = assert (t.Tag <= 21); HasCustomAttributeMin + t.Tag (* + 2 + 1 = max HasConstant.Tag + 1 *) + let HasCustomAttribute (t: HasCustomAttributeTag) = assert (t.Tag <= 21); HasCustomAttributeMin + t.Tag (* + 2 + 1 = max HasConstant.Tag + 1 *) let [] HasCustomAttributeMax = 149 let [] HasFieldMarshalMin = 150 - let HasFieldMarshal (t: HasFieldMarshalTag) = assert (t.Tag <= 1); HasFieldMarshalMin + t.Tag (* + 21 + 1 = max HasCustomAttribute.Tag + 1 *) + let HasFieldMarshal (t: HasFieldMarshalTag) = assert (t.Tag <= 1); HasFieldMarshalMin + t.Tag (* + 21 + 1 = max HasCustomAttribute.Tag + 1 *) let [] HasFieldMarshalMax = 151 let [] HasDeclSecurityMin = 152 - let HasDeclSecurity (t: HasDeclSecurityTag) = assert (t.Tag <= 2); HasDeclSecurityMin + t.Tag (* + 1 + 1 = max HasFieldMarshal.Tag + 1 *) + let HasDeclSecurity (t: HasDeclSecurityTag) = assert (t.Tag <= 2); HasDeclSecurityMin + t.Tag (* + 1 + 1 = max HasFieldMarshal.Tag + 1 *) let [] HasDeclSecurityMax = 154 let [] MemberRefParentMin = 155 - let MemberRefParent (t: MemberRefParentTag) = assert (t.Tag <= 4); MemberRefParentMin + t.Tag (* + 2 + 1 = max HasDeclSecurity.Tag + 1 *) + let MemberRefParent (t: MemberRefParentTag) = assert (t.Tag <= 4); MemberRefParentMin + t.Tag (* + 2 + 1 = max HasDeclSecurity.Tag + 1 *) let [] MemberRefParentMax = 159 let [] HasSemanticsMin = 160 - let HasSemantics (t: HasSemanticsTag) = assert (t.Tag <= 1); HasSemanticsMin + t.Tag (* + 4 + 1 = max MemberRefParent.Tag + 1 *) + let HasSemantics (t: HasSemanticsTag) = assert (t.Tag <= 1); HasSemanticsMin + t.Tag (* + 4 + 1 = max MemberRefParent.Tag + 1 *) let [] HasSemanticsMax = 161 let [] MethodDefOrRefMin = 162 - let MethodDefOrRef (t: MethodDefOrRefTag) = assert (t.Tag <= 2); MethodDefOrRefMin + t.Tag (* + 1 + 1 = max HasSemantics.Tag + 1 *) + let MethodDefOrRef (t: MethodDefOrRefTag) = assert (t.Tag <= 2); MethodDefOrRefMin + t.Tag (* + 1 + 1 = max HasSemantics.Tag + 1 *) let [] MethodDefOrRefMax = 164 let [] MemberForwardedMin = 165 - let MemberForwarded (t: MemberForwardedTag) = assert (t.Tag <= 1); MemberForwardedMin + t.Tag (* + 2 + 1 = max MethodDefOrRef.Tag + 1 *) + let MemberForwarded (t: MemberForwardedTag) = assert (t.Tag <= 1); MemberForwardedMin + t.Tag (* + 2 + 1 = max MethodDefOrRef.Tag + 1 *) let [] MemberForwardedMax = 166 let [] ImplementationMin = 167 - let Implementation (t: ImplementationTag) = assert (t.Tag <= 2); ImplementationMin + t.Tag (* + 1 + 1 = max MemberForwarded.Tag + 1 *) + let Implementation (t: ImplementationTag) = assert (t.Tag <= 2); ImplementationMin + t.Tag (* + 1 + 1 = max MemberForwarded.Tag + 1 *) let [] ImplementationMax = 169 let [] CustomAttributeTypeMin = 170 - let CustomAttributeType (t: CustomAttributeTypeTag) = assert (t.Tag <= 3); CustomAttributeTypeMin + t.Tag (* + 2 + 1 = max Implementation.Tag + 1 *) + let CustomAttributeType (t: CustomAttributeTypeTag) = assert (t.Tag <= 3); CustomAttributeTypeMin + t.Tag (* + 2 + 1 = max Implementation.Tag + 1 *) let [] CustomAttributeTypeMax = 173 let [] ResolutionScopeMin = 174 - let ResolutionScope (t: ResolutionScopeTag) = assert (t.Tag <= 4); ResolutionScopeMin + t.Tag (* + 3 + 1 = max CustomAttributeType.Tag + 1 *) + let ResolutionScope (t: ResolutionScopeTag) = assert (t.Tag <= 4); ResolutionScopeMin + t.Tag (* + 3 + 1 = max CustomAttributeType.Tag + 1 *) let [] ResolutionScopeMax = 178 [] @@ -284,37 +284,37 @@ type RowElement(tag: int32, idx: int32) = member x.Val = idx // These create RowElements -let UShort (x: uint16) = RowElement(RowElementTags.UShort, int32 x) -let ULong (x: int32) = RowElement(RowElementTags.ULong, x) -/// Index into cenv.data or cenv.resources. Gets fixed up later once we known an overall -/// location for the data section. flag indicates if offset is relative to cenv.resources. +let UShort (x: uint16) = RowElement(RowElementTags.UShort, int32 x) +let ULong (x: int32) = RowElement(RowElementTags.ULong, x) +/// Index into cenv.data or cenv.resources. Gets fixed up later once we known an overall +/// location for the data section. flag indicates if offset is relative to cenv.resources. let Data (x: int, k: bool) = RowElement((if k then RowElementTags.DataResources else RowElementTags.Data ), x) /// pos. in guid array -let Guid (x: int) = RowElement(RowElementTags.Guid, x) +let Guid (x: int) = RowElement(RowElementTags.Guid, x) /// pos. in blob array -let Blob (x: int) = RowElement(RowElementTags.Blob, x) +let Blob (x: int) = RowElement(RowElementTags.Blob, x) /// pos. in string array -let StringE (x: int) = RowElement(RowElementTags.String, x) +let StringE (x: int) = RowElement(RowElementTags.String, x) /// pos. in some table -let SimpleIndex (t, x: int) = RowElement(RowElementTags.SimpleIndex t, x) -let TypeDefOrRefOrSpec (t, x: int) = RowElement(RowElementTags.TypeDefOrRefOrSpec t, x) -let TypeOrMethodDef (t, x: int) = RowElement(RowElementTags.TypeOrMethodDef t, x) -let HasConstant (t, x: int) = RowElement(RowElementTags.HasConstant t, x) -let HasCustomAttribute (t, x: int) = RowElement(RowElementTags.HasCustomAttribute t, x) -let HasFieldMarshal (t, x: int) = RowElement(RowElementTags.HasFieldMarshal t, x) -let HasDeclSecurity (t, x: int) = RowElement(RowElementTags.HasDeclSecurity t, x) -let MemberRefParent (t, x: int) = RowElement(RowElementTags.MemberRefParent t, x) -let HasSemantics (t, x: int) = RowElement(RowElementTags.HasSemantics t, x) -let MethodDefOrRef (t, x: int) = RowElement(RowElementTags.MethodDefOrRef t, x) -let MemberForwarded (t, x: int) = RowElement(RowElementTags.MemberForwarded t, x) -let Implementation (t, x: int) = RowElement(RowElementTags.Implementation t, x) +let SimpleIndex (t, x: int) = RowElement(RowElementTags.SimpleIndex t, x) +let TypeDefOrRefOrSpec (t, x: int) = RowElement(RowElementTags.TypeDefOrRefOrSpec t, x) +let TypeOrMethodDef (t, x: int) = RowElement(RowElementTags.TypeOrMethodDef t, x) +let HasConstant (t, x: int) = RowElement(RowElementTags.HasConstant t, x) +let HasCustomAttribute (t, x: int) = RowElement(RowElementTags.HasCustomAttribute t, x) +let HasFieldMarshal (t, x: int) = RowElement(RowElementTags.HasFieldMarshal t, x) +let HasDeclSecurity (t, x: int) = RowElement(RowElementTags.HasDeclSecurity t, x) +let MemberRefParent (t, x: int) = RowElement(RowElementTags.MemberRefParent t, x) +let HasSemantics (t, x: int) = RowElement(RowElementTags.HasSemantics t, x) +let MethodDefOrRef (t, x: int) = RowElement(RowElementTags.MethodDefOrRef t, x) +let MemberForwarded (t, x: int) = RowElement(RowElementTags.MemberForwarded t, x) +let Implementation (t, x: int) = RowElement(RowElementTags.Implementation t, x) let CustomAttributeType (t, x: int) = RowElement(RowElementTags.CustomAttributeType t, x) -let ResolutionScope (t, x: int) = RowElement(RowElementTags.ResolutionScope t, x) +let ResolutionScope (t, x: int) = RowElement(RowElementTags.ResolutionScope t, x) (* type RowElement = | UShort of uint16 | ULong of int32 - | Data of int * bool // Index into cenv.data or cenv.resources. Will be adjusted later in writing once we fix an overall location for the data section. flag indicates if offset is relative to cenv.resources. + | Data of int * bool // Index into cenv.data or cenv.resources. Will be adjusted later in writing once we fix an overall location for the data section. flag indicates if offset is relative to cenv.resources. | Guid of int // pos. in guid array | Blob of int // pos. in blob array | String of int // pos. in string array @@ -328,7 +328,7 @@ type RowElement = | MemberRefParent of MemberRefParentTag * int | HasSemantics of HasSemanticsTag * int | MethodDefOrRef of MethodDefOrRefTag * int - | MemberForwarded of MemberForwardedTag * int + | MemberForwarded of MemberForwardedTag * int | Implementation of ImplementationTag * int | CustomAttributeType of CustomAttributeTypeTag * int | ResolutionScope of ResolutionScopeTag * int @@ -349,7 +349,7 @@ let hashRow (elems: RowElement[]) = acc let equalRows (elems: RowElement[]) (elems2: RowElement[]) = - if elems.Length <> elems2.Length then false else + if elems.Length <> elems2.Length then false else let mutable ok = true let n = elems.Length let mutable i = 0 @@ -383,7 +383,7 @@ let AssemblyRefRow(s1, s2, s3, s4, l1, b1, nameIdx, str2, b2) = /// Special representation the computes the hash more efficiently let MemberRefRow(mrp: RowElement, nmIdx: StringIndex, blobIdx: BlobIndex) = - let hashCode = combineHash (hash blobIdx) (combineHash (hash nmIdx) (hash mrp)) + let hashCode = combineHash (hash blobIdx) (combineHash (hash nmIdx) (hash mrp)) let genericRow = [| mrp; StringE nmIdx; Blob blobIdx |] new SharedRow(genericRow, hashCode) @@ -409,10 +409,10 @@ type UnsharedRow(elems: RowElement[]) = // This environment keeps track of how many generic parameters are in scope. // This lets us translate AbsIL type variable number to IL type variable numbering type ILTypeWriterEnv = { EnclosingTyparCount: int } -let envForTypeDef (td: ILTypeDef) = { EnclosingTyparCount=td.GenericParams.Length } -let envForMethodRef env (ty: ILType) = { EnclosingTyparCount=(match ty with ILType.Array _ -> env.EnclosingTyparCount | _ -> ty.GenericArgs.Length) } -let envForNonGenericMethodRef _mref = { EnclosingTyparCount=System.Int32.MaxValue } -let envForFieldSpec (fspec: ILFieldSpec) = { EnclosingTyparCount=fspec.DeclaringType.GenericArgs.Length } +let envForTypeDef (td: ILTypeDef) = { EnclosingTyparCount=td.GenericParams.Length } +let envForMethodRef env (ty: ILType) = { EnclosingTyparCount=(match ty with ILType.Array _ -> env.EnclosingTyparCount | _ -> ty.GenericArgs.Length) } +let envForNonGenericMethodRef _mref = { EnclosingTyparCount=System.Int32.MaxValue } +let envForFieldSpec (fspec: ILFieldSpec) = { EnclosingTyparCount=fspec.DeclaringType.GenericArgs.Length } let envForOverrideSpec (ospec: ILOverridesSpec) = { EnclosingTyparCount=ospec.DeclaringType.GenericArgs.Length } //--------------------------------------------------------------------- @@ -426,7 +426,7 @@ type MetadataTable<'T> = #if DEBUG mutable lookups: int #endif - mutable rows: ResizeArray<'T> } + mutable rows: ResizeArray<'T> } member x.Count = x.rows.Count static member New(nm, hashEq) = @@ -561,7 +561,7 @@ type cenv = showTimes: bool desiredMetadataVersion: ILVersionInfo requiredDataFixups: (int32 * (int * bool)) list ref - /// References to strings in codestreams: offset of code and a (fixup-location , string token) list) + /// References to strings in codestreams: offset of code and a (fixup-location, string token) list) mutable requiredStringFixups: (int32 * (int * int) list) list codeChunks: ByteBuffer mutable nextCodeAddr: int32 @@ -584,8 +584,8 @@ type cenv = tables: MetadataTable[] AssemblyRefs: MetadataTable fieldDefs: MetadataTable - methodDefIdxsByKey: MetadataTable - methodDefIdxs: Dictionary + methodDefIdxsByKey: MetadataTable + methodDefIdxs: Dictionary propertyDefs: MetadataTable eventDefs: MetadataTable typeDefs: MetadataTable @@ -620,7 +620,7 @@ let metadataSchemaVersionSupportedByCLRVersion v = // Later Whidbey versions are post 2.0.40607.0.. However we assume // internal builds such as 2.0.x86chk are Whidbey Beta 2 or later if compareILVersions v (parseILVersion ("2.0.40520.0")) >= 0 && - compareILVersions v (parseILVersion ("2.0.40608.0")) < 0 then 1, 1 + compareILVersions v (parseILVersion ("2.0.40608.0")) < 0 then 1, 1 elif compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2, 0 else 1, 0 @@ -628,7 +628,7 @@ let headerVersionSupportedByCLRVersion v = // The COM20HEADER version number // Whidbey version numbers are 2.5 // Earlier are 2.0 - // From an email from jeffschw: "Be built with a compiler that marks the COM20HEADER with Major >=2 and Minor >= 5. The V2.0 compilers produce images with 2.5, V1.x produces images with 2.0." + // From an email from jeffschw: "Be built with a compiler that marks the COM20HEADER with Major >=2 and Minor >= 5. The V2.0 compilers produce images with 2.5, V1.x produces images with 2.0." if compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2, 5 else 2, 0 @@ -650,7 +650,7 @@ type ILTokenMappings = EventTokenMap: ILTypeDef list * ILTypeDef -> ILEventDef -> int32 } let recordRequiredDataFixup requiredDataFixups (buf: ByteBuffer) pos lab = - requiredDataFixups := (pos, lab) :: !requiredDataFixups + requiredDataFixups := (pos, lab) :: !requiredDataFixups // Write a special value in that we check later when applying the fixup buf.EmitInt32 0xdeaddddd @@ -695,12 +695,12 @@ and GenTypeDefsPass1 enc cenv tds = List.iter (GenTypeDefPass1 enc cenv) tds // Pass 2 - allocate indexes for methods and fields and write rows for types //===================================================================== -let rec GetIdxForTypeDef cenv key = +let rec GetIdxForTypeDef cenv key = try cenv.typeDefs.GetTableEntry key with :? KeyNotFoundException -> let (TdKey (enc, n) ) = key - errorR(InternalError("One of your modules expects the type '"+String.concat "." (enc@[n])+"' to be defined within the module being emitted. You may be missing an input file", range0)) + errorR(InternalError("One of your modules expects the type '"+String.concat "." (enc@[n])+"' to be defined within the module being emitted. You may be missing an input file", range0)) 0 // -------------------------------------------------------------------- @@ -716,7 +716,7 @@ let rec GetAssemblyRefAsRow cenv (aref: ILAssemblyRef) = ((match aref.PublicKey with Some (PublicKey _) -> 0x0001 | _ -> 0x0000) ||| (if aref.Retargetable then 0x0100 else 0x0000)), BlobIndex (match aref.PublicKey with - | None -> 0 + | None -> 0 | Some (PublicKey b | PublicKeyToken b) -> GetBytesAsBlobIdx cenv b), StringIndex (GetStringHeapIdx cenv aref.Name), StringIndex (match aref.Locale with None -> 0 | Some s -> GetStringHeapIdx cenv s), @@ -731,9 +731,9 @@ and GetModuleRefAsRow cenv (mref: ILModuleRef) = and GetModuleRefAsFileRow cenv (mref: ILModuleRef) = SharedRow - [| ULong (if mref.HasMetadata then 0x0000 else 0x0001) - StringE (GetStringHeapIdx cenv mref.Name) - (match mref.Hash with None -> Blob 0 | Some s -> Blob (GetBytesAsBlobIdx cenv s)) |] + [| ULong (if mref.HasMetadata then 0x0000 else 0x0001) + StringE (GetStringHeapIdx cenv mref.Name) + (match mref.Hash with None -> Blob 0 | Some s -> Blob (GetBytesAsBlobIdx cenv s)) |] and GetModuleRefAsIdx cenv mref = FindOrAddSharedRow cenv TableNames.ModuleRef (GetModuleRefAsRow cenv mref) @@ -755,7 +755,7 @@ let isTypeLocal (ty: ILType) = ty.IsNominal && isNil ty.GenericArgs && isTypeRef let GetScopeRefAsImplementationElem cenv scoref = match scoref with - | ILScopeRef.Local -> (i_AssemblyRef, 0) + | ILScopeRef.Local -> (i_AssemblyRef, 0) | ILScopeRef.Assembly aref -> (i_AssemblyRef, GetAssemblyRefAsIdx cenv aref) | ILScopeRef.Module mref -> (i_File, GetModuleRefAsFileIdx cenv mref) @@ -857,7 +857,7 @@ and GetTypeAsTypeDefOrRef cenv env (ty: ILType) = and GetTypeAsBytes cenv env ty = emitBytesViaBuffer (fun bb -> EmitType cenv env bb ty) and GetTypeOfLocalAsBytes cenv env (l: ILLocal) = - emitBytesViaBuffer (fun bb -> EmitLocalInfo cenv env bb l) + emitBytesViaBuffer (fun bb -> EmitLocalInfo cenv env bb l) and GetTypeAsBlobIdx cenv env (ty: ILType) = GetBytesAsBlobIdx cenv (GetTypeAsBytes cenv env ty) @@ -871,39 +871,39 @@ and GetTypeAsTypeSpecIdx cenv env ty = and EmitType cenv env bb ty = match ty with // REVIEW: what are these doing here? - | ILType.Value tspec when tspec.Name = "System.String" -> bb.EmitByte et_STRING - | ILType.Value tspec when tspec.Name = "System.Object" -> bb.EmitByte et_OBJECT - | ty when isILSByteTy ty -> bb.EmitByte et_I1 - | ty when isILInt16Ty ty -> bb.EmitByte et_I2 - | ty when isILInt32Ty ty -> bb.EmitByte et_I4 - | ty when isILInt64Ty ty -> bb.EmitByte et_I8 - | ty when isILByteTy ty -> bb.EmitByte et_U1 - | ty when isILUInt16Ty ty -> bb.EmitByte et_U2 - | ty when isILUInt32Ty ty -> bb.EmitByte et_U4 - | ty when isILUInt64Ty ty -> bb.EmitByte et_U8 - | ty when isILDoubleTy ty -> bb.EmitByte et_R8 - | ty when isILSingleTy ty -> bb.EmitByte et_R4 - | ty when isILBoolTy ty -> bb.EmitByte et_BOOLEAN - | ty when isILCharTy ty -> bb.EmitByte et_CHAR - | ty when isILStringTy ty -> bb.EmitByte et_STRING - | ty when isILObjectTy ty -> bb.EmitByte et_OBJECT - | ty when isILIntPtrTy ty -> bb.EmitByte et_I - | ty when isILUIntPtrTy ty -> bb.EmitByte et_U - | ty when isILTypedReferenceTy ty -> bb.EmitByte et_TYPEDBYREF - - | ILType.Boxed tspec -> EmitTypeSpec cenv env bb (et_CLASS, tspec) - | ILType.Value tspec -> EmitTypeSpec cenv env bb (et_VALUETYPE, tspec) + | ILType.Value tspec when tspec.Name = "System.String" -> bb.EmitByte et_STRING + | ILType.Value tspec when tspec.Name = "System.Object" -> bb.EmitByte et_OBJECT + | ty when isILSByteTy ty -> bb.EmitByte et_I1 + | ty when isILInt16Ty ty -> bb.EmitByte et_I2 + | ty when isILInt32Ty ty -> bb.EmitByte et_I4 + | ty when isILInt64Ty ty -> bb.EmitByte et_I8 + | ty when isILByteTy ty -> bb.EmitByte et_U1 + | ty when isILUInt16Ty ty -> bb.EmitByte et_U2 + | ty when isILUInt32Ty ty -> bb.EmitByte et_U4 + | ty when isILUInt64Ty ty -> bb.EmitByte et_U8 + | ty when isILDoubleTy ty -> bb.EmitByte et_R8 + | ty when isILSingleTy ty -> bb.EmitByte et_R4 + | ty when isILBoolTy ty -> bb.EmitByte et_BOOLEAN + | ty when isILCharTy ty -> bb.EmitByte et_CHAR + | ty when isILStringTy ty -> bb.EmitByte et_STRING + | ty when isILObjectTy ty -> bb.EmitByte et_OBJECT + | ty when isILIntPtrTy ty -> bb.EmitByte et_I + | ty when isILUIntPtrTy ty -> bb.EmitByte et_U + | ty when isILTypedReferenceTy ty -> bb.EmitByte et_TYPEDBYREF + + | ILType.Boxed tspec -> EmitTypeSpec cenv env bb (et_CLASS, tspec) + | ILType.Value tspec -> EmitTypeSpec cenv env bb (et_VALUETYPE, tspec) | ILType.Array (shape, ty) -> if shape = ILArrayShape.SingleDimensional then (bb.EmitByte et_SZARRAY ; EmitType cenv env bb ty) else (bb.EmitByte et_ARRAY; EmitType cenv env bb ty; EmitArrayShape bb shape) | ILType.TypeVar tv -> let cgparams = env.EnclosingTyparCount - if int32 tv < cgparams then + if int32 tv < cgparams then bb.EmitByte et_VAR bb.EmitZ32 (int32 tv) else bb.EmitByte et_MVAR - bb.EmitZ32 (int32 tv - cgparams) + bb.EmitZ32 (int32 tv - cgparams) | ILType.Byref ty -> bb.EmitByte et_BYREF @@ -964,9 +964,9 @@ let rec GetVariantTypeAsInt32 ty = (List.assoc ty (Lazy.force ILVariantTypeMap )) else match ty with - | ILNativeVariant.Array vt -> vt_ARRAY ||| GetVariantTypeAsInt32 vt - | ILNativeVariant.Vector vt -> vt_VECTOR ||| GetVariantTypeAsInt32 vt - | ILNativeVariant.Byref vt -> vt_BYREF ||| GetVariantTypeAsInt32 vt + | ILNativeVariant.Array vt -> vt_ARRAY ||| GetVariantTypeAsInt32 vt + | ILNativeVariant.Vector vt -> vt_VECTOR ||| GetVariantTypeAsInt32 vt + | ILNativeVariant.Byref vt -> vt_BYREF ||| GetVariantTypeAsInt32 vt | _ -> failwith "Unexpected variant type" // based on information in ECMA and asmparse.y in the CLR codebase @@ -1006,8 +1006,8 @@ and EmitNativeType bb ty = | None -> () | Some n -> let u1 = Bytes.stringAsUtf8NullTerminated n - bb.EmitZ32 (Array.length u1) ; bb.EmitBytes u1 - | ILNativeType.Array (nt, sizeinfo) -> (* REVIEW: check if this corresponds to the ECMA spec *) + bb.EmitZ32 (Array.length u1) ; bb.EmitBytes u1 + | ILNativeType.Array (nt, sizeinfo) -> (* REVIEW: check if this corresponds to the ECMA spec *) bb.EmitByte nt_ARRAY match nt with | None -> bb.EmitZ32 (int nt_MAX) @@ -1023,8 +1023,8 @@ and EmitNativeType bb ty = bb.EmitZ32 pnum (* ElemMul *) (* z_u32 0x1l *) match additive with - | None -> () - | Some n -> (* NumElem *) bb.EmitZ32 n + | None -> () + | Some n -> (* NumElem *) bb.EmitZ32 n | _ -> failwith "Unexpected native type" // -------------------------------------------------------------------- @@ -1038,9 +1038,9 @@ let rec GetFieldInitAsBlobIdx cenv (x: ILFieldInit) = and GetFieldInit (bb: ByteBuffer) x = match x with | ILFieldInit.String b -> bb.EmitBytes (System.Text.Encoding.Unicode.GetBytes b) - | ILFieldInit.Bool b -> bb.EmitByte (if b then 0x01uy else 0x00uy) + | ILFieldInit.Bool b -> bb.EmitByte (if b then 0x01uy else 0x00uy) | ILFieldInit.Char x -> bb.EmitUInt16 x - | ILFieldInit.Int8 x -> bb.EmitByte (byte x) + | ILFieldInit.Int8 x -> bb.EmitByte (byte x) | ILFieldInit.Int16 x -> bb.EmitUInt16 (uint16 x) | ILFieldInit.Int32 x -> bb.EmitInt32 x | ILFieldInit.Int64 x -> bb.EmitInt64 x @@ -1050,7 +1050,7 @@ and GetFieldInit (bb: ByteBuffer) x = | ILFieldInit.UInt64 x -> bb.EmitInt64 (int64 x) | ILFieldInit.Single x -> bb.EmitInt32 (bitsOfSingle x) | ILFieldInit.Double x -> bb.EmitInt64 (bitsOfDouble x) - | ILFieldInit.Null -> bb.EmitInt32 0 + | ILFieldInit.Null -> bb.EmitInt32 0 and GetFieldInitFlags i = UShort @@ -1078,20 +1078,20 @@ and GetFieldInitFlags i = let GetMemberAccessFlags access = match access with | ILMemberAccess.Public -> 0x00000006 - | ILMemberAccess.Private -> 0x00000001 - | ILMemberAccess.Family -> 0x00000004 + | ILMemberAccess.Private -> 0x00000001 + | ILMemberAccess.Family -> 0x00000004 | ILMemberAccess.CompilerControlled -> 0x00000000 | ILMemberAccess.FamilyAndAssembly -> 0x00000002 | ILMemberAccess.FamilyOrAssembly -> 0x00000005 | ILMemberAccess.Assembly -> 0x00000003 -let GetTypeAccessFlags access = +let GetTypeAccessFlags access = match access with | ILTypeDefAccess.Public -> 0x00000001 - | ILTypeDefAccess.Private -> 0x00000000 + | ILTypeDefAccess.Private -> 0x00000000 | ILTypeDefAccess.Nested ILMemberAccess.Public -> 0x00000002 - | ILTypeDefAccess.Nested ILMemberAccess.Private -> 0x00000003 - | ILTypeDefAccess.Nested ILMemberAccess.Family -> 0x00000004 + | ILTypeDefAccess.Nested ILMemberAccess.Private -> 0x00000003 + | ILTypeDefAccess.Nested ILMemberAccess.Family -> 0x00000004 | ILTypeDefAccess.Nested ILMemberAccess.CompilerControlled -> failwith "bad type acccess" | ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly -> 0x00000006 | ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly -> 0x00000007 @@ -1120,12 +1120,12 @@ and GetTypeOptionAsTypeDefOrRef cenv env tyOpt = and GetTypeDefAsPropertyMapRow cenv tidx = UnsharedRow - [| SimpleIndex (TableNames.TypeDef, tidx) + [| SimpleIndex (TableNames.TypeDef, tidx) SimpleIndex (TableNames.Property, cenv.propertyDefs.Count + 1) |] and GetTypeDefAsEventMapRow cenv tidx = UnsharedRow - [| SimpleIndex (TableNames.TypeDef, tidx) + [| SimpleIndex (TableNames.TypeDef, tidx) SimpleIndex (TableNames.Event, cenv.eventDefs.Count + 1) |] and GetKeyForFieldDef tidx (fd: ILFieldDef) = @@ -1143,16 +1143,16 @@ and GenMethodDefPass2 cenv tidx md = "method" (fun (key: MethodDefKey) -> dprintn "Duplicate in method table is:" - dprintn (" Type index: "+string key.TypeIdx) - dprintn (" Method name: "+key.Name) - dprintn (" Method arity (num generic params): "+string key.GenericArity) + dprintn (" Type index: "+string key.TypeIdx) + dprintn (" Method name: "+key.Name) + dprintn (" Method arity (num generic params): "+string key.GenericArity) key.Name ) (GetKeyForMethodDef tidx md) cenv.methodDefIdxs.[md] <- idx -and GetKeyForPropertyDef tidx (x: ILPropertyDef) = +and GetKeyForPropertyDef tidx (x: ILPropertyDef) = PropKey (tidx, x.Name, x.PropertyType, x.Args) and GenPropertyDefPass2 cenv tidx x = @@ -1220,14 +1220,14 @@ let FindMethodDefIdx cenv mdkey = let typeNameOfIdx i = match (cenv.typeDefs.dict - |> Seq.fold (fun sofar kvp -> + |> Seq.fold (fun sofar kvp -> let tkey2 = kvp.Key let tidx2 = kvp.Value if i = tidx2 then if sofar = None then Some tkey2 else failwith "multiple type names map to index" - else sofar) None) with + else sofar) None) with | Some x -> x | None -> raise MethodDefNotFound let (TdKey (tenc, tname)) = typeNameOfIdx mdkey.TypeIdx @@ -1270,7 +1270,7 @@ let GetMethodRefAsMethodDefIdx cenv (mref: ILMethodRef) = let mdkey = MethodDefKey (tidx, mref.GenericArity, mref.Name, mref.ReturnType, mref.ArgTypes, mref.CallingConv.IsStatic) FindMethodDefIdx cenv mdkey with e -> - failwithf "Error in GetMethodRefAsMethodDefIdx for mref = %A, error: %s" (mref.Name, tref.Name) e.Message + failwithf "Error in GetMethodRefAsMethodDefIdx for mref = %A, error: %s" (mref.Name, tref.Name) e.Message let rec MethodRefInfoAsMemberRefRow cenv env fenv (nm, ty, callconv, args, ret, varargs, genarity) = MemberRefRow(GetTypeAsMemberRefParent cenv env ty, @@ -1280,9 +1280,9 @@ let rec MethodRefInfoAsMemberRefRow cenv env fenv (nm, ty, callconv, args, ret, and GetMethodRefInfoAsBlobIdx cenv env info = GetBytesAsBlobIdx cenv (GetCallsigAsBytes cenv env info) -let GetMethodRefInfoAsMemberRefIdx cenv env ((_, ty, _, _, _, _, _) as minfo) = +let GetMethodRefInfoAsMemberRefIdx cenv env ((_, ty, _, _, _, _, _) as minfo) = let fenv = envForMethodRef env ty - FindOrAddSharedRow cenv TableNames.MemberRef (MethodRefInfoAsMemberRefRow cenv env fenv minfo) + FindOrAddSharedRow cenv TableNames.MemberRef (MethodRefInfoAsMemberRefRow cenv env fenv minfo) let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm, ty: ILType, cc, args, ret, varargs, genarity) as minfo) = if Option.isNone varargs && (isAlwaysMethodDef || isTypeLocal ty) then @@ -1350,15 +1350,15 @@ and InfoOfMethodSpec (mspec: ILMethodSpec, varargs) = let rec GetOverridesSpecAsMemberRefIdx cenv env ospec = let fenv = envForOverrideSpec ospec - let row = MethodRefInfoAsMemberRefRow cenv env fenv (ospec.MethodRef.Name, ospec.DeclaringType, ospec.MethodRef.CallingConv, ospec.MethodRef.ArgTypes, ospec.MethodRef.ReturnType, None, ospec.MethodRef.GenericArity) - FindOrAddSharedRow cenv TableNames.MemberRef row + let row = MethodRefInfoAsMemberRefRow cenv env fenv (ospec.MethodRef.Name, ospec.DeclaringType, ospec.MethodRef.CallingConv, ospec.MethodRef.ArgTypes, ospec.MethodRef.ReturnType, None, ospec.MethodRef.GenericArity) + FindOrAddSharedRow cenv TableNames.MemberRef row and GetOverridesSpecAsMethodDefOrRef cenv env (ospec: ILOverridesSpec) = let ty = ospec.DeclaringType if isTypeLocal ty then if not ty.IsNominal then failwith "GetOverridesSpecAsMethodDefOrRef: unexpected local tref-ty" try (mdor_MethodDef, GetMethodRefAsMethodDefIdx cenv ospec.MethodRef) - with MethodDefNotFound -> (mdor_MemberRef, GetOverridesSpecAsMemberRefIdx cenv env ospec) + with MethodDefNotFound -> (mdor_MemberRef, GetOverridesSpecAsMemberRefIdx cenv env ospec) else (mdor_MemberRef, GetOverridesSpecAsMemberRefIdx cenv env ospec) @@ -1394,7 +1394,7 @@ and GetCustomAttrRow cenv hca (attr: ILAttribute) = for element in attr.Elements do match element with | ILAttribElem.Type (Some ty) when ty.IsNominal -> GetTypeRefAsTypeRefIdx cenv ty.TypeRef |> ignore - | ILAttribElem.TypeRef (Some tref) -> GetTypeRefAsTypeRefIdx cenv tref |> ignore + | ILAttribElem.TypeRef (Some tref) -> GetTypeRefAsTypeRefIdx cenv tref |> ignore | _ -> () UnsharedRow @@ -1426,7 +1426,7 @@ and GenSecurityDeclsPass3 cenv hds attrs = List.iter (GenSecurityDeclPass3 cenv hds) attrs // -------------------------------------------------------------------- -// ILFieldSpec --> FieldRef or ILFieldDef row +// ILFieldSpec --> FieldRef or ILFieldDef row // -------------------------------------------------------------------- let rec GetFieldSpecAsMemberRefRow cenv env fenv (fspec: ILFieldSpec) = @@ -1508,7 +1508,7 @@ type ExceptionClauseSpec = (int * int * int * int * ExceptionClauseKind) type CodeBuffer = // -------------------------------------------------------------------- - // Buffer to write results of emitting code into. Also record: + // Buffer to write results of emitting code into. Also record: // - branch sources (where fixups will occur) // - possible branch destinations // - locations of embedded handles into the string table @@ -1535,7 +1535,7 @@ type CodeBuffer = member codebuf.EmitExceptionClause seh = codebuf.seh <- seh :: codebuf.seh - member codebuf.EmitSeqPoint cenv (m: ILSourceMarker) = + member codebuf.EmitSeqPoint cenv (m: ILSourceMarker) = if cenv.generatePdb then // table indexes are 1-based, document array indexes are 0-based let doc = (cenv.documents.FindOrAddSharedEntry m.Document) - 1 @@ -1574,8 +1574,8 @@ type CodeBuffer = module Codebuf = // -------------------------------------------------------------------- - // Applying branch fixups. Use short versions of instructions - // wherever possible. Sadly we can only determine if we can use a short + // Applying branch fixups. Use short versions of instructions + // wherever possible. Sadly we can only determine if we can use a short // version after we've layed out the code for all other instructions. // This in turn means that using a short version may change // the various offsets into the code. @@ -1596,7 +1596,7 @@ module Codebuf = let newCode = ByteBuffer.Create origCode.Length // Copy over all the code, working out whether the branches will be short - // or long and adjusting the branch destinations. Record an adjust function to adjust all the other + // or long and adjusting the branch destinations. Record an adjust function to adjust all the other // gumpf that refers to fixed offsets in the code stream. let newCode, newReqdBrFixups, adjuster = let remainingReqdFixups = ref orderedOrigReqdBrFixups @@ -1630,7 +1630,7 @@ module Codebuf = origWhere := origEndOfNoBranchBlock newWhere := !newWhere + nobranch_len - // Now do the branch instruction. Decide whether the fixup will be short or long in the new code + // Now do the branch instruction. Decide whether the fixup will be short or long in the new code if doingLast then doneLast := true else @@ -1648,7 +1648,7 @@ module Codebuf = match i, tgs with | (_, Some i_short), [tg] when - // Use the original offsets to compute if the branch is small or large. This is + // Use the original offsets to compute if the branch is small or large. This is // a safe approximation because code only gets smaller. (let origDest = match origAvailBrFixups.TryGetValue tg with @@ -1687,7 +1687,7 @@ module Codebuf = if !origWhere <> origEndOfInstr then dprintn "mismatch between origWhere and origEndOfInstr" - let adjuster = + let adjuster = let arr = Array.ofList (List.rev !adjustments) fun addr -> let i = @@ -1706,7 +1706,7 @@ module Codebuf = let newAvailBrFixups = let tab = Dictionary<_, _>(10, HashIdentity.Structural) for (KeyValue(tglab, origBrDest)) in origAvailBrFixups do - tab.[tglab] <- adjuster origBrDest + tab.[tglab] <- adjuster origBrDest tab let newReqdStringFixups = List.map (fun (origFixupLoc, stok) -> adjuster origFixupLoc, stok) origReqdStringFixups let newSeqPoints = Array.map (fun (sp: PdbSequencePoint) -> {sp with Offset=adjuster sp.Offset}) origSeqPoints @@ -1773,7 +1773,7 @@ module Codebuf = let emitInstrCode (codebuf: CodeBuffer) i = if i > 0xFF then assert (i >>> 8 = 0xFE) - codebuf.EmitByte ((i >>> 8) &&& 0xFF) + codebuf.EmitByte ((i >>> 8) &&& 0xFF) codebuf.EmitByte (i &&& 0xFF) else codebuf.EmitByte i @@ -1835,49 +1835,49 @@ module Codebuf = match instr with | si when isNoArgInstr si -> emitInstrCode codebuf (encodingsOfNoArgInstr si) - | I_brcmp (cmp, tg1) -> + | I_brcmp (cmp, tg1) -> codebuf.RecordReqdBrFixup ((Lazy.force ILCmpInstrMap).[cmp], Some (Lazy.force ILCmpInstrRevMap).[cmp]) tg1 | I_br tg -> codebuf.RecordReqdBrFixup (i_br, Some i_br_s) tg - | I_seqpoint s -> codebuf.EmitSeqPoint cenv s + | I_seqpoint s -> codebuf.EmitSeqPoint cenv s | I_leave tg -> codebuf.RecordReqdBrFixup (i_leave, Some i_leave_s) tg - | I_call (tl, mspec, varargs) -> + | I_call (tl, mspec, varargs) -> emitTailness cenv codebuf tl emitMethodSpecInstr cenv codebuf env i_call (mspec, varargs) //emitAfterTailcall codebuf tl - | I_callvirt (tl, mspec, varargs) -> + | I_callvirt (tl, mspec, varargs) -> emitTailness cenv codebuf tl emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) //emitAfterTailcall codebuf tl - | I_callconstraint (tl, ty, mspec, varargs) -> + | I_callconstraint (tl, ty, mspec, varargs) -> emitTailness cenv codebuf tl emitConstrained cenv codebuf env ty emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) //emitAfterTailcall codebuf tl - | I_newobj (mspec, varargs) -> + | I_newobj (mspec, varargs) -> emitMethodSpecInstr cenv codebuf env i_newobj (mspec, varargs) - | I_ldftn mspec -> + | I_ldftn mspec -> emitMethodSpecInstr cenv codebuf env i_ldftn (mspec, None) - | I_ldvirtftn mspec -> + | I_ldvirtftn mspec -> emitMethodSpecInstr cenv codebuf env i_ldvirtftn (mspec, None) - | I_calli (tl, callsig, varargs) -> + | I_calli (tl, callsig, varargs) -> emitTailness cenv codebuf tl emitInstrCode codebuf i_calli codebuf.EmitUncodedToken (getUncodedToken TableNames.StandAloneSig (GetCallsigAsStandAloneSigIdx cenv env (callsig, varargs))) //emitAfterTailcall codebuf tl - | I_ldarg u16 -> emitShortUInt16Instr codebuf (i_ldarg_s, i_ldarg) u16 - | I_starg u16 -> emitShortUInt16Instr codebuf (i_starg_s, i_starg) u16 - | I_ldarga u16 -> emitShortUInt16Instr codebuf (i_ldarga_s, i_ldarga) u16 - | I_ldloc u16 -> emitShortUInt16Instr codebuf (i_ldloc_s, i_ldloc) u16 - | I_stloc u16 -> emitShortUInt16Instr codebuf (i_stloc_s, i_stloc) u16 - | I_ldloca u16 -> emitShortUInt16Instr codebuf (i_ldloca_s, i_ldloca) u16 + | I_ldarg u16 -> emitShortUInt16Instr codebuf (i_ldarg_s, i_ldarg) u16 + | I_starg u16 -> emitShortUInt16Instr codebuf (i_starg_s, i_starg) u16 + | I_ldarga u16 -> emitShortUInt16Instr codebuf (i_ldarga_s, i_ldarga) u16 + | I_ldloc u16 -> emitShortUInt16Instr codebuf (i_ldloc_s, i_ldloc) u16 + | I_stloc u16 -> emitShortUInt16Instr codebuf (i_stloc_s, i_stloc) u16 + | I_ldloca u16 -> emitShortUInt16Instr codebuf (i_ldloca_s, i_ldloca) u16 - | I_cpblk (al, vol) -> + | I_cpblk (al, vol) -> emitAlignment codebuf al emitVolatility codebuf vol emitInstrCode codebuf i_cpblk - | I_initblk (al, vol) -> + | I_initblk (al, vol) -> emitAlignment codebuf al emitVolatility codebuf vol emitInstrCode codebuf i_initblk @@ -1894,90 +1894,90 @@ module Codebuf = emitInstrCode codebuf i_ldc_r8 codebuf.EmitInt64 (bitsOfDouble x) - | I_ldind (al, vol, dt) -> + | I_ldind (al, vol, dt) -> emitAlignment codebuf al emitVolatility codebuf vol emitInstrCode codebuf (match dt with | DT_I -> i_ldind_i - | DT_I1 -> i_ldind_i1 - | DT_I2 -> i_ldind_i2 - | DT_I4 -> i_ldind_i4 - | DT_U1 -> i_ldind_u1 - | DT_U2 -> i_ldind_u2 - | DT_U4 -> i_ldind_u4 - | DT_I8 -> i_ldind_i8 - | DT_R4 -> i_ldind_r4 - | DT_R8 -> i_ldind_r8 - | DT_REF -> i_ldind_ref + | DT_I1 -> i_ldind_i1 + | DT_I2 -> i_ldind_i2 + | DT_I4 -> i_ldind_i4 + | DT_U1 -> i_ldind_u1 + | DT_U2 -> i_ldind_u2 + | DT_U4 -> i_ldind_u4 + | DT_I8 -> i_ldind_i8 + | DT_R4 -> i_ldind_r4 + | DT_R8 -> i_ldind_r8 + | DT_REF -> i_ldind_ref | _ -> failwith "ldind") - | I_stelem dt -> + | I_stelem dt -> emitInstrCode codebuf (match dt with | DT_I | DT_U -> i_stelem_i - | DT_U1 | DT_I1 -> i_stelem_i1 - | DT_I2 | DT_U2 -> i_stelem_i2 - | DT_I4 | DT_U4 -> i_stelem_i4 - | DT_I8 | DT_U8 -> i_stelem_i8 - | DT_R4 -> i_stelem_r4 - | DT_R8 -> i_stelem_r8 - | DT_REF -> i_stelem_ref + | DT_U1 | DT_I1 -> i_stelem_i1 + | DT_I2 | DT_U2 -> i_stelem_i2 + | DT_I4 | DT_U4 -> i_stelem_i4 + | DT_I8 | DT_U8 -> i_stelem_i8 + | DT_R4 -> i_stelem_r4 + | DT_R8 -> i_stelem_r8 + | DT_REF -> i_stelem_ref | _ -> failwith "stelem") - | I_ldelem dt -> + | I_ldelem dt -> emitInstrCode codebuf (match dt with | DT_I -> i_ldelem_i - | DT_I1 -> i_ldelem_i1 - | DT_I2 -> i_ldelem_i2 - | DT_I4 -> i_ldelem_i4 - | DT_I8 -> i_ldelem_i8 - | DT_U1 -> i_ldelem_u1 - | DT_U2 -> i_ldelem_u2 - | DT_U4 -> i_ldelem_u4 - | DT_R4 -> i_ldelem_r4 - | DT_R8 -> i_ldelem_r8 - | DT_REF -> i_ldelem_ref + | DT_I1 -> i_ldelem_i1 + | DT_I2 -> i_ldelem_i2 + | DT_I4 -> i_ldelem_i4 + | DT_I8 -> i_ldelem_i8 + | DT_U1 -> i_ldelem_u1 + | DT_U2 -> i_ldelem_u2 + | DT_U4 -> i_ldelem_u4 + | DT_R4 -> i_ldelem_r4 + | DT_R8 -> i_ldelem_r8 + | DT_REF -> i_ldelem_ref | _ -> failwith "ldelem") - | I_stind (al, vol, dt) -> + | I_stind (al, vol, dt) -> emitAlignment codebuf al emitVolatility codebuf vol emitInstrCode codebuf (match dt with | DT_U | DT_I -> i_stind_i - | DT_U1 | DT_I1 -> i_stind_i1 - | DT_U2 | DT_I2 -> i_stind_i2 - | DT_U4 | DT_I4 -> i_stind_i4 - | DT_U8 | DT_I8 -> i_stind_i8 - | DT_R4 -> i_stind_r4 - | DT_R8 -> i_stind_r8 - | DT_REF -> i_stind_ref + | DT_U1 | DT_I1 -> i_stind_i1 + | DT_U2 | DT_I2 -> i_stind_i2 + | DT_U4 | DT_I4 -> i_stind_i4 + | DT_U8 | DT_I8 -> i_stind_i8 + | DT_R4 -> i_stind_r4 + | DT_R8 -> i_stind_r8 + | DT_REF -> i_stind_ref | _ -> failwith "stelem") - | I_switch labs -> codebuf.RecordReqdBrFixups (i_switch, None) labs + | I_switch labs -> codebuf.RecordReqdBrFixups (i_switch, None) labs - | I_ldfld (al, vol, fspec) -> + | I_ldfld (al, vol, fspec) -> emitAlignment codebuf al emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_ldfld fspec - | I_ldflda fspec -> + | I_ldflda fspec -> emitFieldSpecInstr cenv codebuf env i_ldflda fspec - | I_ldsfld (vol, fspec) -> + | I_ldsfld (vol, fspec) -> emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_ldsfld fspec - | I_ldsflda fspec -> + | I_ldsflda fspec -> emitFieldSpecInstr cenv codebuf env i_ldsflda fspec - | I_stfld (al, vol, fspec) -> + | I_stfld (al, vol, fspec) -> emitAlignment codebuf al emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_stfld fspec - | I_stsfld (vol, fspec) -> + | I_stsfld (vol, fspec) -> emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_stsfld fspec - | I_ldtoken tok -> + | I_ldtoken tok -> emitInstrCode codebuf i_ldtoken codebuf.EmitUncodedToken (match tok with @@ -1996,14 +1996,14 @@ module Codebuf = | ILToken.ILField fspec -> match GetFieldSpecAsFieldDefOrRef cenv env fspec with | (true, idx) -> getUncodedToken TableNames.Field idx - | (false, idx) -> getUncodedToken TableNames.MemberRef idx) - | I_ldstr s -> + | (false, idx) -> getUncodedToken TableNames.MemberRef idx) + | I_ldstr s -> emitInstrCode codebuf i_ldstr codebuf.RecordReqdStringFixup (GetUserStringHeapIdx cenv s) - | I_box ty -> emitTypeInstr cenv codebuf env i_box ty - | I_unbox ty -> emitTypeInstr cenv codebuf env i_unbox ty - | I_unbox_any ty -> emitTypeInstr cenv codebuf env i_unbox_any ty + | I_box ty -> emitTypeInstr cenv codebuf env i_box ty + | I_unbox ty -> emitTypeInstr cenv codebuf env i_unbox ty + | I_unbox_any ty -> emitTypeInstr cenv codebuf env i_unbox_any ty | I_newarr (shape, ty) -> if (shape = ILArrayShape.SingleDimensional) then @@ -2016,7 +2016,7 @@ module Codebuf = if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_stelem_any ty else - let args = List.init (shape.Rank+1) (fun i -> if i < shape.Rank then cenv.ilg.typ_Int32 else ty) + let args = List.init (shape.Rank+1) (fun i -> if i < shape.Rank then cenv.ilg.typ_Int32 else ty) emitMethodSpecInfoInstr cenv codebuf env i_call ("Set", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Void, None, []) | I_ldelem_any (shape, ty) -> @@ -2026,7 +2026,7 @@ module Codebuf = let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) emitMethodSpecInfoInstr cenv codebuf env i_call ("Get", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ty, None, []) - | I_ldelema (ro, _isNativePtr, shape, ty) -> + | I_ldelema (ro, _isNativePtr, shape, ty) -> if (ro = ReadonlyAddress) then emitInstrCode codebuf i_readonly if (shape = ILArrayShape.SingleDimensional) then @@ -2035,26 +2035,26 @@ module Codebuf = let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) emitMethodSpecInfoInstr cenv codebuf env i_call ("Address", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Byref ty, None, []) - | I_castclass ty -> emitTypeInstr cenv codebuf env i_castclass ty - | I_isinst ty -> emitTypeInstr cenv codebuf env i_isinst ty - | I_refanyval ty -> emitTypeInstr cenv codebuf env i_refanyval ty - | I_mkrefany ty -> emitTypeInstr cenv codebuf env i_mkrefany ty - | I_initobj ty -> emitTypeInstr cenv codebuf env i_initobj ty - | I_ldobj (al, vol, ty) -> + | I_castclass ty -> emitTypeInstr cenv codebuf env i_castclass ty + | I_isinst ty -> emitTypeInstr cenv codebuf env i_isinst ty + | I_refanyval ty -> emitTypeInstr cenv codebuf env i_refanyval ty + | I_mkrefany ty -> emitTypeInstr cenv codebuf env i_mkrefany ty + | I_initobj ty -> emitTypeInstr cenv codebuf env i_initobj ty + | I_ldobj (al, vol, ty) -> emitAlignment codebuf al emitVolatility codebuf vol emitTypeInstr cenv codebuf env i_ldobj ty - | I_stobj (al, vol, ty) -> + | I_stobj (al, vol, ty) -> emitAlignment codebuf al emitVolatility codebuf vol emitTypeInstr cenv codebuf env i_stobj ty - | I_cpobj ty -> emitTypeInstr cenv codebuf env i_cpobj ty - | I_sizeof ty -> emitTypeInstr cenv codebuf env i_sizeof ty - | EI_ldlen_multi (_, m) -> + | I_cpobj ty -> emitTypeInstr cenv codebuf env i_cpobj ty + | I_sizeof ty -> emitTypeInstr cenv codebuf env i_sizeof ty + | EI_ldlen_multi (_, m) -> emitShortInt32Instr codebuf (i_ldc_i4_s, i_ldc_i4) m emitInstr cenv codebuf env (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [(cenv.ilg.typ_Int32)], (cenv.ilg.typ_Int32)))) - | _ -> failwith "an IL instruction cannot be emitted" + | _ -> failwith "an IL instruction cannot be emitted" let mkScopeNode cenv (localSigs: _[]) (startOffset, endOffset, ls: ILLocalDebugMapping list, childScopes) = @@ -2073,7 +2073,7 @@ module Codebuf = // Used to put local debug scopes and exception handlers into a tree form - let rangeInsideRange (start_pc1, end_pc1) (start_pc2, end_pc2) = + let rangeInsideRange (start_pc1, end_pc1) (start_pc2, end_pc2) = (start_pc1: int) >= start_pc2 && start_pc1 < end_pc2 && (end_pc1: int) > start_pc2 && end_pc1 <= end_pc2 @@ -2198,7 +2198,7 @@ module Codebuf = let EmitTopCode cenv localSigs env nm code = let codebuf = CodeBuffer.Create nm - let origScopes = emitCode cenv localSigs codebuf env code + let origScopes = emitCode cenv localSigs codebuf env code let origCode = codebuf.code.Close() let origExnClauses = List.rev codebuf.seh let origReqdStringFixups = codebuf.reqdStringFixupsInMethod @@ -2243,7 +2243,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = if isNil il.Locals && il.MaxStack <= 8 && isNil seh && codeSize < 64 then // Use Tiny format let alignedCodeSize = align 4 (codeSize + 1) - let codePadding = (alignedCodeSize - (codeSize + 1)) + let codePadding = (alignedCodeSize - (codeSize + 1)) let requiredStringFixups' = (1, requiredStringFixups) methbuf.EmitByte (byte codeSize <<< 2 ||| e_CorILMethod_TinyFormat) methbuf.EmitBytes code @@ -2262,7 +2262,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = (FindOrAddSharedRow cenv TableNames.StandAloneSig (GetLocalSigAsStandAloneSigIdx cenv env il.Locals)) let alignedCodeSize = align 0x4 codeSize - let codePadding = (alignedCodeSize - codeSize) + let codePadding = (alignedCodeSize - codeSize) methbuf.EmitByte flags methbuf.EmitByte 0x30uy // last four bits record size of fat header in 4 byte chunks - this is always 12 bytes = 3 four word chunks @@ -2378,7 +2378,7 @@ and GenFieldDefPass3 cenv env fd = let rec GetGenericParamAsGenericParamRow cenv _env idx owner gp = let flags = - (match gp.Variance with + (match gp.Variance with | NonVariant -> 0x0000 | CoVariant -> 0x0001 | ContraVariant -> 0x0002) ||| @@ -2426,7 +2426,7 @@ and GenGenericParamPass4 cenv env idx owner gp = // param and return --> Param Row // -------------------------------------------------------------------- -let rec GetParamAsParamRow cenv _env seq (param: ILParameter) = +let rec GetParamAsParamRow cenv _env seq (param: ILParameter) = let flags = (if param.IsIn then 0x0001 else 0x0000) ||| (if param.IsOut then 0x0002 else 0x0000) ||| @@ -2519,7 +2519,7 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = RootScope = Some rootScope Range= match ilmbody.SourceMarker with - | Some m when cenv.generatePdb -> + | Some m when cenv.generatePdb -> // table indexes are 1-based, document array indexes are 0-based let doc = (cenv.documents.FindOrAddSharedEntry m.Document) - 1 @@ -2548,10 +2548,10 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = 0x0000 | MethodBody.Native -> failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries" - | _ -> 0x0000) + | _ -> 0x0000) UnsharedRow - [| ULong codeAddr + [| ULong codeAddr UShort (uint16 implflags) UShort (uint16 flags) StringE (GetStringHeapIdx cenv md.Name) @@ -2580,27 +2580,27 @@ let GenMethodDefPass3 cenv env (md: ILMethodDef) = | MethodBody.PInvoke attr -> let flags = begin match attr.CallingConv with - | PInvokeCallingConvention.None -> 0x0000 - | PInvokeCallingConvention.Cdecl -> 0x0200 - | PInvokeCallingConvention.Stdcall -> 0x0300 + | PInvokeCallingConvention.None -> 0x0000 + | PInvokeCallingConvention.Cdecl -> 0x0200 + | PInvokeCallingConvention.Stdcall -> 0x0300 | PInvokeCallingConvention.Thiscall -> 0x0400 | PInvokeCallingConvention.Fastcall -> 0x0500 - | PInvokeCallingConvention.WinApi -> 0x0100 + | PInvokeCallingConvention.WinApi -> 0x0100 end ||| begin match attr.CharEncoding with - | PInvokeCharEncoding.None -> 0x0000 - | PInvokeCharEncoding.Ansi -> 0x0002 + | PInvokeCharEncoding.None -> 0x0000 + | PInvokeCharEncoding.Ansi -> 0x0002 | PInvokeCharEncoding.Unicode -> 0x0004 - | PInvokeCharEncoding.Auto -> 0x0006 + | PInvokeCharEncoding.Auto -> 0x0006 end ||| begin match attr.CharBestFit with | PInvokeCharBestFit.UseAssembly -> 0x0000 - | PInvokeCharBestFit.Enabled -> 0x0010 + | PInvokeCharBestFit.Enabled -> 0x0010 | PInvokeCharBestFit.Disabled -> 0x0020 end ||| begin match attr.ThrowOnUnmappableChar with | PInvokeThrowOnUnmappableChar.UseAssembly -> 0x0000 - | PInvokeThrowOnUnmappableChar.Enabled -> 0x1000 + | PInvokeThrowOnUnmappableChar.Enabled -> 0x1000 | PInvokeThrowOnUnmappableChar.Disabled -> 0x2000 end ||| (if attr.NoMangle then 0x0001 else 0x0000) ||| @@ -2613,7 +2613,7 @@ let GenMethodDefPass3 cenv env (md: ILMethodDef) = SimpleIndex (TableNames.ModuleRef, GetModuleRefAsIdx cenv attr.Where) |]) |> ignore | _ -> () -let GenMethodDefPass4 cenv env md = +let GenMethodDefPass4 cenv env md = let midx = GetMethodDefIdx cenv md List.iteri (fun n gp -> GenGenericParamPass4 cenv env n (tomd_MethodDef, midx) gp) md.GenericParams @@ -2631,7 +2631,7 @@ let rec GetPropertySigAsBlobIdx cenv env prop = and GetPropertySigAsBytes cenv env (prop: ILPropertyDef) = emitBytesViaBuffer (fun bb -> - let b = ((hasthisToByte prop.CallingConv) ||| e_IMAGE_CEE_CS_CALLCONV_PROPERTY) + let b = ((hasthisToByte prop.CallingConv) ||| e_IMAGE_CEE_CS_CALLCONV_PROPERTY) bb.EmitByte b bb.EmitZ32 prop.Args.Length EmitType cenv env bb prop.PropertyType @@ -2693,16 +2693,16 @@ and GenEventPass3 cenv env (md: ILEventDef) = let rec GetResourceAsManifestResourceRow cenv r = let data, impl = let embedManagedResources (bytes: byte[]) = - // Embedded managed resources must be word-aligned. However resource format is - // not specified in ECMA. Some mscorlib resources appear to be non-aligned - it seems it doesn't matter.. + // Embedded managed resources must be word-aligned. However resource format is + // not specified in ECMA. Some mscorlib resources appear to be non-aligned - it seems it doesn't matter.. let offset = cenv.resources.Position - let alignedOffset = (align 0x8 offset) + let alignedOffset = (align 0x8 offset) let pad = alignedOffset - offset let resourceSize = bytes.Length cenv.resources.EmitPadding pad cenv.resources.EmitInt32 resourceSize cenv.resources.EmitBytes bytes - Data (alignedOffset, true), (i_File, 0) + Data (alignedOffset, true), (i_File, 0) match r.Location with | ILResourceLocation.LocalIn _ -> embedManagedResources (r.GetBytes()) @@ -2732,7 +2732,7 @@ let rec GenTypeDefPass3 enc cenv (td: ILTypeDef) = td.Events.AsList |> List.iter (GenEventPass3 cenv env) td.Fields.AsList |> List.iter (GenFieldDefPass3 cenv env) td.Methods |> Seq.iter (GenMethodDefPass3 cenv env) - td.MethodImpls.AsList |> List.iter (GenMethodImplPass3 cenv env td.GenericParams.Length tidx) + td.MethodImpls.AsList |> List.iter (GenMethodImplPass3 cenv env td.GenericParams.Length tidx) // ClassLayout entry if needed match td.Layout with | ILTypeDefLayout.Auto -> () @@ -2749,7 +2749,7 @@ let rec GenTypeDefPass3 enc cenv (td: ILTypeDef) = td.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_TypeDef, tidx) gp) td.NestedTypes.AsList |> GenTypeDefsPass3 (enc@[td.Name]) cenv with e -> - failwith ("Error in pass3 for type "+td.Name+", error: "+e.Message) + failwith ("Error in pass3 for type "+td.Name+", error: "+e.Message) reraise() raise e @@ -2782,7 +2782,7 @@ let timestamp = absilWriteGetTimeStamp () // -------------------------------------------------------------------- let rec GenNestedExportedTypePass3 cenv cidx (ce: ILNestedExportedType) = - let flags = GetMemberAccessFlags ce.Access + let flags = GetMemberAccessFlags ce.Access let nidx = AddUnsharedRow cenv TableNames.ExportedType (UnsharedRow @@ -2828,16 +2828,16 @@ and GetManifsetAsAssemblyRow cenv m = UShort (match m.Version with None -> 0us | Some (_, _, _, w) -> w) ULong ( (match m.AssemblyLongevity with - | ILAssemblyLongevity.Unspecified -> 0x0000 - | ILAssemblyLongevity.Library -> 0x0002 + | ILAssemblyLongevity.Unspecified -> 0x0000 + | ILAssemblyLongevity.Library -> 0x0002 | ILAssemblyLongevity.PlatformAppDomain -> 0x0004 - | ILAssemblyLongevity.PlatformProcess -> 0x0006 - | ILAssemblyLongevity.PlatformSystem -> 0x0008) ||| + | ILAssemblyLongevity.PlatformProcess -> 0x0006 + | ILAssemblyLongevity.PlatformSystem -> 0x0008) ||| (if m.Retargetable then 0x100 else 0x0) ||| // Setting these causes peverify errors. Hence both ilread and ilwrite ignore them and refuse to set them. // Any debugging customattributes will automatically propagate // REVIEW: No longer appears to be the case - (if m.JitTracking then 0x8000 else 0x0) ||| + (if m.JitTracking then 0x8000 else 0x0) ||| (match m.PublicKey with None -> 0x0000 | Some _ -> 0x0001) ||| 0x0000) (match m.PublicKey with None -> Blob 0 | Some x -> Blob (GetBytesAsBlobIdx cenv x)) StringE (GetStringHeapIdx cenv m.Name) @@ -2863,7 +2863,7 @@ and newGuid (modul: ILModuleDef) = and deterministicGuid (modul: ILModuleDef) = let n = 16909060 - let m2 = Seq.sum (Seq.mapi (fun i x -> i + int x) modul.Name) // use a stable hash + let m2 = Seq.sum (Seq.mapi (fun i x -> i + int x) modul.Name) // use a stable hash [| b0 n; b1 n; b2 n; b3 n; b0 m2; b1 m2; b2 m2; b3 m2; 0xa7uy; 0x45uy; 0x03uy; 0x83uy; b0 n; b1 n; b2 n; b3 n |] and GetModuleAsRow (cenv: cenv) (modul: ILModuleDef) = @@ -2911,13 +2911,13 @@ let GenModule (cenv : cenv) (modul: ILModuleDef) = GenCustomAttrsPass3Or4 cenv (hca_Module, midx) modul.CustomAttrs // GenericParam is the only sorted table indexed by Columns in other tables (GenericParamConstraint\CustomAttributes). // Hence we need to sort it before we emit any entries in GenericParamConstraint\CustomAttributes that are attached to generic params. - // Note this mutates the rows in a table. 'SetRowsOfTable' clears + // Note this mutates the rows in a table. 'SetRowsOfTable' clears // the key --> index map since it is no longer valid cenv.GetTable(TableNames.GenericParam).SetRowsOfSharedTable (SortTableRows TableNames.GenericParam (cenv.GetTable(TableNames.GenericParam).GenericRowsOfTable)) GenTypeDefsPass4 [] cenv tds reportTime cenv.showTimes "Module Generation Pass 4" -let generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg : ILGlobals, emitTailcalls, deterministic, showTimes) (m : ILModuleDef) cilStartAddress normalizeAssemblyRefs = +let generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg : ILGlobals, emitTailcalls, deterministic, showTimes) (m : ILModuleDef) cilStartAddress normalizeAssemblyRefs = let isDll = m.IsDLL let cenv = @@ -2969,9 +2969,9 @@ let generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg : IL normalizeAssemblyRefs = normalizeAssemblyRefs } // Now the main compilation step - GenModule cenv m + GenModule cenv m - // .exe files have a .entrypoint instruction. Do not write it to the entrypoint when writing dll. + // .exe files have a .entrypoint instruction. Do not write it to the entrypoint when writing dll. let entryPointToken = match cenv.entrypoint with | Some (epHere, tok) -> @@ -2993,12 +2993,12 @@ let generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg : IL let enc = tds |> List.map (fun td -> td.Name) GetIdxForTypeDef cenv (TdKey(enc, td.Name)) - let strings = Array.map Bytes.stringAsUtf8NullTerminated cenv.strings.EntriesAsArray + let strings = Array.map Bytes.stringAsUtf8NullTerminated cenv.strings.EntriesAsArray let userStrings = cenv.userStrings.EntriesAsArray |> Array.map System.Text.Encoding.Unicode.GetBytes - let blobs = cenv.blobs.EntriesAsArray - let guids = cenv.guids.EntriesAsArray - let tables = cenv.tables - let code = cenv.GetCode() + let blobs = cenv.blobs.EntriesAsArray + let guids = cenv.guids.EntriesAsArray + let tables = cenv.tables + let code = cenv.GetCode() // turn idx tbls into token maps let mappings = { TypeDefTokenMap = (fun t -> @@ -3026,7 +3026,7 @@ let generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg : IL // TABLES+BLOBS --> PHYSICAL METADATA+BLOBS //===================================================================== let chunk sz next = ({addr=next; size=sz}, next + sz) -let nochunk next = ({addr= 0x0;size= 0x0; } , next) +let nochunk next = ({addr= 0x0;size= 0x0; }, next) let count f arr = Array.fold (fun x y -> x + f y) 0x0 arr @@ -3101,13 +3101,13 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca // Most addresses after this point are measured from the MD root // Switch to md-rooted addresses let next = metadataHeaderStartChunk.size - let _metadataHeaderVersionChunk, next = chunk paddedVersionLength next - let _metadataHeaderEndChunk, next = chunk 0x04 next - let _tablesStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#~".Length + 0x01))) next - let _stringsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#Strings".Length + 0x01))) next + let _metadataHeaderVersionChunk, next = chunk paddedVersionLength next + let _metadataHeaderEndChunk, next = chunk 0x04 next + let _tablesStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#~".Length + 0x01))) next + let _stringsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#Strings".Length + 0x01))) next let _userStringsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#US".Length + 0x01))) next - let _guidsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#GUID".Length + 0x01))) next - let _blobsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#Blob".Length + 0x01))) next + let _guidsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#GUID".Length + 0x01))) next + let _blobsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#Blob".Length + 0x01))) next let tablesStreamStart = next @@ -3131,8 +3131,8 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca let (valid1, valid2), _ = (((0, 0), 0), tables) ||> Array.fold (fun ((valid1, valid2) as valid, n) rows -> let valid = - if rows.Count = 0 then valid else - ( (if n < 32 then valid1 ||| (1 <<< n ) else valid1), + if rows.Count = 0 then valid else + ( (if n < 32 then valid1 ||| (1 <<< n ) else valid1), (if n >= 32 then valid2 ||| (1 <<< (n-32)) else valid2) ) (valid, n+1)) @@ -3141,7 +3141,7 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca let sorted1 = 0x3301fa00 let sorted2 = // If there are any generic parameters in the binary we're emitting then mark that - // table as sorted, otherwise don't. This maximizes the number of assemblies we emit + // table as sorted, otherwise don't. This maximizes the number of assemblies we emit // which have an ECMA-v.1. compliant set of sorted tables. (if tableSize (TableNames.GenericParam) > 0 then 0x00000400 else 0x00000000) ||| (if tableSize (TableNames.GenericParamConstraint) > 0 then 0x00001000 else 0x00000000) ||| @@ -3149,7 +3149,7 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca reportTime showTimes "Layout Header of Tables" - let guidAddress n = (if n = 0 then 0 else (n - 1) * 0x10 + 0x01) + let guidAddress n = (if n = 0 then 0 else (n - 1) * 0x10 + 0x01) let stringAddressTable = let tab = Array.create (strings.Length + 1) 0 @@ -3229,7 +3229,7 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca let hcaBigness = codedBigness 5 TableNames.Method || codedBigness 5 TableNames.Field || - codedBigness 5 TableNames.TypeRef || + codedBigness 5 TableNames.TypeRef || codedBigness 5 TableNames.TypeDef || codedBigness 5 TableNames.Param || codedBigness 5 TableNames.InterfaceImpl || @@ -3245,7 +3245,7 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca codedBigness 5 TableNames.AssemblyRef || codedBigness 5 TableNames.File || codedBigness 5 TableNames.ExportedType || - codedBigness 5 TableNames.ManifestResource || + codedBigness 5 TableNames.ManifestResource || codedBigness 5 TableNames.GenericParam || codedBigness 5 TableNames.GenericParamConstraint || codedBigness 5 TableNames.MethodSpec @@ -3290,19 +3290,19 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca let rsBigness = codedBigness 2 TableNames.Module || codedBigness 2 TableNames.ModuleRef || - codedBigness 2 TableNames.AssemblyRef || + codedBigness 2 TableNames.AssemblyRef || codedBigness 2 TableNames.TypeRef - let tablesBuf = ByteBuffer.Create 20000 + let tablesBuf = ByteBuffer.Create 20000 - // Now the coded tables themselves - first the schemata header + // Now the coded tables themselves - first the schemata header tablesBuf.EmitIntsAsBytes [| 0x00; 0x00; 0x00; 0x00 mdtableVersionMajor // major version of table schemata mdtableVersionMinor // minor version of table schemata ((if stringsBig then 0x01 else 0x00) ||| // bit vector for heap size - (if guidsBig then 0x02 else 0x00) ||| + (if guidsBig then 0x02 else 0x00) ||| (if blobsBig then 0x04 else 0x00)) 0x01 (* reserved, always 1 *) |] @@ -3327,29 +3327,29 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca let t = x.Tag let n = x.Val match t with - | _ when t = RowElementTags.UShort -> tablesBuf.EmitUInt16 (uint16 n) - | _ when t = RowElementTags.ULong -> tablesBuf.EmitInt32 n - | _ when t = RowElementTags.Data -> recordRequiredDataFixup requiredDataFixups tablesBuf (tablesStreamStart + tablesBuf.Position) (n, false) + | _ when t = RowElementTags.UShort -> tablesBuf.EmitUInt16 (uint16 n) + | _ when t = RowElementTags.ULong -> tablesBuf.EmitInt32 n + | _ when t = RowElementTags.Data -> recordRequiredDataFixup requiredDataFixups tablesBuf (tablesStreamStart + tablesBuf.Position) (n, false) | _ when t = RowElementTags.DataResources -> recordRequiredDataFixup requiredDataFixups tablesBuf (tablesStreamStart + tablesBuf.Position) (n, true) - | _ when t = RowElementTags.Guid -> tablesBuf.EmitZUntaggedIndex -3 guidsStreamPaddedSize guidsBig (guidAddress n) - | _ when t = RowElementTags.Blob -> tablesBuf.EmitZUntaggedIndex -2 blobsStreamPaddedSize blobsBig (blobAddress n) - | _ when t = RowElementTags.String -> tablesBuf.EmitZUntaggedIndex -1 stringsStreamPaddedSize stringsBig (stringAddress n) - | _ when t <= RowElementTags.SimpleIndexMax -> + | _ when t = RowElementTags.Guid -> tablesBuf.EmitZUntaggedIndex -3 guidsStreamPaddedSize guidsBig (guidAddress n) + | _ when t = RowElementTags.Blob -> tablesBuf.EmitZUntaggedIndex -2 blobsStreamPaddedSize blobsBig (blobAddress n) + | _ when t = RowElementTags.String -> tablesBuf.EmitZUntaggedIndex -1 stringsStreamPaddedSize stringsBig (stringAddress n) + | _ when t <= RowElementTags.SimpleIndexMax -> let tnum = t - RowElementTags.SimpleIndexMin tablesBuf.EmitZUntaggedIndex tnum (size tnum) (bigness tnum) n - | _ when t <= RowElementTags.TypeDefOrRefOrSpecMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.TypeDefOrRefOrSpecMin) 2 tdorBigness n - | _ when t <= RowElementTags.TypeOrMethodDefMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.TypeOrMethodDefMin) 1 tomdBigness n - | _ when t <= RowElementTags.HasConstantMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasConstantMin) 2 hcBigness n - | _ when t <= RowElementTags.HasCustomAttributeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasCustomAttributeMin) 5 hcaBigness n - | _ when t <= RowElementTags.HasFieldMarshalMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasFieldMarshalMin) 1 hfmBigness n - | _ when t <= RowElementTags.HasDeclSecurityMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasDeclSecurityMin) 2 hdsBigness n - | _ when t <= RowElementTags.MemberRefParentMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MemberRefParentMin) 3 mrpBigness n - | _ when t <= RowElementTags.HasSemanticsMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasSemanticsMin) 1 hsBigness n - | _ when t <= RowElementTags.MethodDefOrRefMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MethodDefOrRefMin) 1 mdorBigness n - | _ when t <= RowElementTags.MemberForwardedMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MemberForwardedMin) 1 mfBigness n - | _ when t <= RowElementTags.ImplementationMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.ImplementationMin) 2 iBigness n - | _ when t <= RowElementTags.CustomAttributeTypeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.CustomAttributeTypeMin) 3 catBigness n - | _ when t <= RowElementTags.ResolutionScopeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.ResolutionScopeMin) 2 rsBigness n + | _ when t <= RowElementTags.TypeDefOrRefOrSpecMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.TypeDefOrRefOrSpecMin) 2 tdorBigness n + | _ when t <= RowElementTags.TypeOrMethodDefMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.TypeOrMethodDefMin) 1 tomdBigness n + | _ when t <= RowElementTags.HasConstantMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasConstantMin) 2 hcBigness n + | _ when t <= RowElementTags.HasCustomAttributeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasCustomAttributeMin) 5 hcaBigness n + | _ when t <= RowElementTags.HasFieldMarshalMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasFieldMarshalMin) 1 hfmBigness n + | _ when t <= RowElementTags.HasDeclSecurityMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasDeclSecurityMin) 2 hdsBigness n + | _ when t <= RowElementTags.MemberRefParentMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MemberRefParentMin) 3 mrpBigness n + | _ when t <= RowElementTags.HasSemanticsMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasSemanticsMin) 1 hsBigness n + | _ when t <= RowElementTags.MethodDefOrRefMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MethodDefOrRefMin) 1 mdorBigness n + | _ when t <= RowElementTags.MemberForwardedMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MemberForwardedMin) 1 mfBigness n + | _ when t <= RowElementTags.ImplementationMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.ImplementationMin) 2 iBigness n + | _ when t <= RowElementTags.CustomAttributeTypeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.CustomAttributeTypeMin) 3 catBigness n + | _ when t <= RowElementTags.ResolutionScopeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.ResolutionScopeMin) 2 rsBigness n | _ -> failwith "invalid tag in row element" tablesBuf.Close() @@ -3374,7 +3374,7 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca reportTime showTimes "Layout Metadata" let metadata, guidStart = - let mdbuf = ByteBuffer.Create 500000 + let mdbuf = ByteBuffer.Create 500000 mdbuf.EmitIntsAsBytes [| 0x42; 0x53; 0x4a; 0x42 // Magic signature 0x01; 0x00 // Major version @@ -3395,7 +3395,7 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca mdbuf.EmitIntsAsBytes [| 0x23; 0x7e; 0x00; 0x00; (* #~00 *)|] mdbuf.EmitInt32 stringsChunk.addr mdbuf.EmitInt32 stringsChunk.size - mdbuf.EmitIntsAsBytes [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; 0x00; 0x00; 0x00; 0x00 (* "#Strings0000" *)|] + mdbuf.EmitIntsAsBytes [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; 0x00; 0x00; 0x00; 0x00 (* "#Strings0000" *)|] mdbuf.EmitInt32 userStringsChunk.addr mdbuf.EmitInt32 userStringsChunk.size mdbuf.EmitIntsAsBytes [| 0x23; 0x55; 0x53; 0x00; (* #US0*) |] @@ -3421,7 +3421,7 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca mdbuf.EmitIntAsByte 0x00 reportTime showTimes "Write Metadata Strings" // The user string stream - mdbuf.EmitByte 0x00uy + mdbuf.EmitByte 0x00uy for s in userStrings do mdbuf.EmitZ32 (s.Length + 1) mdbuf.EmitBytes s @@ -3450,9 +3450,9 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca // uses of strings in the code for (codeStartAddr, l) in requiredStringFixups do for (codeOffset, userStringIndex) in l do - if codeStartAddr < codep.addr || codeStartAddr >= codep.addr + codep.size then + if codeStartAddr < codep.addr || codeStartAddr >= codep.addr + codep.size then failwith "strings-in-code fixup: a group of fixups is located outside the code array" - let locInCode = ((codeStartAddr + codeOffset) - codep.addr) + let locInCode = ((codeStartAddr + codeOffset) - codep.addr) checkFixup32 code locInCode 0xdeadbeef let token = getUncodedToken TableNames.UserStrings (userStringAddress userStringIndex) if (Bytes.get code (locInCode-1) <> i_ldstr) then failwith "strings-in-code fixup: not at ldstr instruction!" @@ -3504,14 +3504,14 @@ let writeInt64 (os: BinaryWriter) x = os.Write (dw7 x) let writeInt32 (os: BinaryWriter) x = - os.Write (byte (b0 x)) - os.Write (byte (b1 x)) - os.Write (byte (b2 x)) - os.Write (byte (b3 x)) + os.Write (byte (b0 x)) + os.Write (byte (b1 x)) + os.Write (byte (b2 x)) + os.Write (byte (b3 x)) let writeInt32AsUInt16 (os: BinaryWriter) x = - os.Write (byte (b0 x)) - os.Write (byte (b1 x)) + os.Write (byte (b0 x)) + os.Write (byte (b1 x)) let writeDirectory os dict = writeInt32 os (if dict.size = 0x0 then 0x0 else dict.addr) @@ -3523,7 +3523,7 @@ let writeBinaryAndReportMappings (outfile, ilg: ILGlobals, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB, embedAllSource, embedSourceList, sourceLink, emitTailcalls, deterministic, showTimes, dumpDebugInfo ) modul normalizeAssemblyRefs = - // Store the public key from the signer into the manifest. This means it will be written + // Store the public key from the signer into the manifest. This means it will be written // to the binary and also acts as an indicator to leave space for delay sign reportTime showTimes "Write Started" @@ -3614,7 +3614,7 @@ let writeBinaryAndReportMappings (outfile, let headerSectionPhysSize = nextPhys - headerSectionPhysLoc let next = align alignVirt (headerAddr + headerSize) - // TEXT SECTION: 8 bytes IAT table 72 bytes CLI header + // TEXT SECTION: 8 bytes IAT table 72 bytes CLI header let textSectionPhysLoc = nextPhys let textSectionAddr = next @@ -3674,7 +3674,7 @@ let writeBinaryAndReportMappings (outfile, let pdbOpt = match portablePDB with - | true -> + | true -> let (uncompressedLength, contentId, stream) as pdbStream = generatePortablePdb embedAllSource embedSourceList sourceLink showTimes pdbData deterministic @@ -3692,7 +3692,7 @@ let writeBinaryAndReportMappings (outfile, sizeof_IMAGE_DEBUG_DIRECTORY ) next // The debug data is given to us by the PDB writer and appears to - // typically be the type of the data plus the PDB file name. We fill + // typically be the type of the data plus the PDB file name. We fill // this in after we've written the binary. We approximate the size according // to what PDB writers seem to require and leave extra space just in case... let debugDataJustInCase = 40 @@ -3718,7 +3718,7 @@ let writeBinaryAndReportMappings (outfile, let next = align alignVirt (textSectionAddr + textSectionSize) // .RSRC SECTION (DATA) - let dataSectionPhysLoc = nextPhys + let dataSectionPhysLoc = nextPhys let dataSectionAddr = next let dataSectionVirtToPhys v = v - dataSectionAddr + dataSectionPhysLoc @@ -3761,8 +3761,8 @@ let writeBinaryAndReportMappings (outfile, let dataSectionPhysSize = nextPhys - dataSectionPhysLoc let next = align alignVirt (dataSectionAddr + dataSectionSize) - // .RELOC SECTION base reloc table: 0x0c size - let relocSectionPhysLoc = nextPhys + // .RELOC SECTION base reloc table: 0x0c size + let relocSectionPhysLoc = nextPhys let relocSectionAddr = next let baseRelocTableChunk, next = chunk 0x0c next @@ -3776,8 +3776,8 @@ let writeBinaryAndReportMappings (outfile, begin requiredDataFixups |> List.iter (fun (metadataOffset32, (dataOffset, kind)) -> - let metadataOffset = metadataOffset32 - if metadataOffset < 0 || metadataOffset >= metadata.Length - 4 then failwith "data RVA fixup: fixup located outside metadata" + let metadataOffset = metadataOffset32 + if metadataOffset < 0 || metadataOffset >= metadata.Length - 4 then failwith "data RVA fixup: fixup located outside metadata" checkFixup32 metadata metadataOffset 0xdeaddddd let dataRva = if kind then @@ -3795,7 +3795,7 @@ let writeBinaryAndReportMappings (outfile, end // IMAGE TOTAL SIZE - let imageEndSectionPhysLoc = nextPhys + let imageEndSectionPhysLoc = nextPhys let imageEndAddr = next reportTime showTimes "Layout image" @@ -3805,7 +3805,7 @@ let writeBinaryAndReportMappings (outfile, | None -> () | Some pExpected -> os.Flush() - let pCurrent = int32 os.BaseStream.Position + let pCurrent = int32 os.BaseStream.Position if pCurrent <> pExpected then failwith ("warning: "+chunkName+" not where expected, pCurrent = "+string pCurrent+", p.addr = "+string pExpected) writeBytes os chunk @@ -3844,7 +3844,7 @@ let writeBinaryAndReportMappings (outfile, let final = [| hCode; hData; hMeta |] |> Array.collect id |> sha.ComputeHash // Confirm we have found the correct data and aren't corrupting the metadata - if metadata.[ guidStart..guidStart+3] <> [| 4uy; 3uy; 2uy; 1uy |] then failwith "Failed to find MVID" + if metadata.[ guidStart..guidStart+3] <> [| 4uy; 3uy; 2uy; 1uy |] then failwith "Failed to find MVID" if metadata.[ guidStart+12..guidStart+15] <> [| 4uy; 3uy; 2uy; 1uy |] then failwith "Failed to find MVID" // Update MVID guid in metadata @@ -3853,7 +3853,7 @@ let writeBinaryAndReportMappings (outfile, // Use last 4 bytes for timestamp - High bit set, to stop tool chains becoming confused let timestamp = int final.[16] ||| (int final.[17] <<< 8) ||| (int final.[18] <<< 16) ||| (int (final.[19] ||| 128uy) <<< 24) writeInt32 os timestamp - // Update pdbData with new guid and timestamp. Portable and embedded PDBs don't need the ModuleID + // Update pdbData with new guid and timestamp. Portable and embedded PDBs don't need the ModuleID // Full and PdbOnly aren't supported under deterministic builds currently, they rely on non-determinsitic Windows native code { pdbData with ModuleID = final.[0..15] ; Timestamp = timestamp } else @@ -3886,7 +3886,7 @@ let writeBinaryAndReportMappings (outfile, // 000000a0 writeInt32 os dataSectionPhysSize // Size of the initialized data section writeInt32 os 0x00 // Size of the uninitialized data section - writeInt32 os entrypointCodeChunk.addr // RVA of entry point , needs to point to bytes 0xFF 0x25 followed by the RVA+!0x4000000 + writeInt32 os entrypointCodeChunk.addr // RVA of entry point, needs to point to bytes 0xFF 0x25 followed by the RVA+!0x4000000 writeInt32 os textSectionAddr // e.g. 0x0002000 // 000000b0 if modul.Is64Bit then @@ -3919,7 +3919,7 @@ let writeBinaryAndReportMappings (outfile, // x86 : IMAGE_DLLCHARACTERISTICS_ NO_SEH | IMAGE_DLL_CHARACTERISTICS_DYNAMIC_BASE | IMAGE_DLLCHARACTERISTICS_NX_COMPAT // x64 : IMAGE_DLLCHARACTERISTICS_ NO_SEH | IMAGE_DLL_CHARACTERISTICS_DYNAMIC_BASE | IMAGE_DLLCHARACTERISTICS_NX_COMPAT let dllCharacteristics = - let flags = + let flags = if modul.Is64Bit then (if isItanium then 0x8540 else 0x540) else 0x540 if modul.UseHighEntropyVA then flags ||| 0x20 // IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA @@ -3982,7 +3982,7 @@ let writeBinaryAndReportMappings (outfile, write (Some textSectionHeaderChunk.addr) os "text section header" [| |] // 00000178 - writeBytes os [| 0x2euy; 0x74uy; 0x65uy; 0x78uy; 0x74uy; 0x00uy; 0x00uy; 0x00uy; |] // ".text\000\000\000" + writeBytes os [| 0x2euy; 0x74uy; 0x65uy; 0x78uy; 0x74uy; 0x00uy; 0x00uy; 0x00uy; |] // ".text\000\000\000" // 00000180 writeInt32 os textSectionSize // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. writeInt32 os textSectionAddr // VirtualAddress For executable images this is the address of the first byte of the section @@ -4012,7 +4012,7 @@ let writeBinaryAndReportMappings (outfile, // 000001c0 writeInt32AsUInt16 os 0x00 // NumberOfRelocations Number of relocations, set to 0 if unused. writeInt32AsUInt16 os 0x00 // NumberOfLinenumbers Always 0 (see Section 23.1). - writeBytes os [| 0x40uy; 0x00uy; 0x00uy; 0x40uy |] // Characteristics Flags: IMAGE_SCN_MEM_READ | IMAGE_SCN_CNT_INITIALIZED_DATA + writeBytes os [| 0x40uy; 0x00uy; 0x00uy; 0x40uy |] // Characteristics Flags: IMAGE_SCN_MEM_READ | IMAGE_SCN_CNT_INITIALIZED_DATA write (Some relocSectionHeaderChunk.addr) os "reloc section header" [| |] // 000001a0 @@ -4039,7 +4039,7 @@ let writeBinaryAndReportMappings (outfile, // e.g. 0x0200 write (Some (textV2P importAddrTableChunk.addr)) os "import addr table" [| |] writeInt32 os importNameHintTableChunk.addr - writeInt32 os 0x00 // QUERY 4 bytes of zeros not 2 like ECMA 24.3.1 says + writeInt32 os 0x00 // QUERY 4 bytes of zeros not 2 like ECMA 24.3.1 says // e.g. 0x0208 @@ -4052,7 +4052,7 @@ let writeBinaryAndReportMappings (outfile, let headerVersionMajor, headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion writePadding os "pad to cli header" cliHeaderPadding - write (Some (textV2P cliHeaderChunk.addr)) os "cli header" [| |] + write (Some (textV2P cliHeaderChunk.addr)) os "cli header" [| |] writeInt32 os 0x48 // size of header writeInt32AsUInt16 os headerVersionMajor // Major part of minimum version of CLR reqd. writeInt32AsUInt16 os headerVersionMinor // Minor part of minimum version of CLR reqd. ... @@ -4245,7 +4245,7 @@ let writeBinaryAndReportMappings (outfile, for i in idd do // write the debug raw data as given us by the PDB writer os2.BaseStream.Seek (int64 (textV2P i.iddChunk.addr), SeekOrigin.Begin) |> ignore - if i.iddChunk.size < i.iddData.Length then failwith "Debug data area is not big enough. Debug info may not be usable" + if i.iddChunk.size < i.iddData.Length then failwith "Debug data area is not big enough. Debug info may not be usable" writeBytes os2 i.iddData os2.Dispose() with e -> @@ -4260,7 +4260,7 @@ let writeBinaryAndReportMappings (outfile, ignore debugEmbeddedPdbChunk reportTime showTimes "Finalize PDB" - /// Sign the binary. No further changes to binary allowed past this point! + /// Sign the binary. No further changes to binary allowed past this point! match signer with | None -> () | Some s -> diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index 4aa0bed68c8..c859fb63889 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -712,38 +712,38 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = // THESE ARE THE LEGITIMATE CASES // [< >] on anything - | _, _ , None , None, None , None, None , None , None + | _, _, 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 -> () @@ -754,18 +754,18 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = 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) -> @@ -774,9 +774,9 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = // 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 | _ -> @@ -829,7 +829,7 @@ let TyconIsCandidateForAugmentationWithCompare (g: TcGlobals) (tycon: Tycon) = not (TyconRefHasAttribute g tycon.Range g.attrib_IsByRefLikeAttribute (mkLocalTyconRef tycon)) && match getAugmentationAttribs g tycon with // [< >] - | true, true, None, None, None, None , None, None, None + | true, true, None, None, None, None, None, None, None // [] | true, true, None, None, None, Some(true), None, None, Some(true) // [] @@ -845,7 +845,7 @@ let TyconIsCandidateForAugmentationWithEquals (g: TcGlobals) (tycon: Tycon) = match getAugmentationAttribs g tycon with // [< >] - | true, _, None, None, None, None , _, _, _ + | true, _, None, None, None, None, _, _, _ // [] // [] | true, _, None, None, None, Some(true), _, _, _ -> true diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index df5ffa8d8b7..33216b30e5e 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. /// Coordinating compiler operations - configuration, loading initial context, reporting errors etc. module internal FSharp.Compiler.CompileOps @@ -241,8 +241,8 @@ let GetDiagnosticNumber(err: PhasedDiagnostic) = | ErrorFromAddingTypeEquation _ -> 1 | FunctionExpected _ -> 2 | NotAFunctionButIndexer _ -> 3217 - | NotAFunction _ -> 3 - | FieldNotMutable _ -> 5 + | NotAFunction _ -> 3 + | FieldNotMutable _ -> 5 | Recursion _ -> 6 | InvalidRuntimeCoercion _ -> 7 | IndeterminateRuntimeCoercion _ -> 8 @@ -250,19 +250,19 @@ let GetDiagnosticNumber(err: PhasedDiagnostic) = | SyntaxError _ -> 10 // 11 cannot be reused // 12 cannot be reused - | IndeterminateStaticCoercion _ -> 13 - | StaticCoercionShouldUseBox _ -> 14 + | IndeterminateStaticCoercion _ -> 13 + | StaticCoercionShouldUseBox _ -> 14 // 15 cannot be reused | RuntimeCoercionSourceSealed _ -> 16 | OverrideDoesntOverride _ -> 17 - | UnionPatternsBindDifferentNames _ -> 18 - | UnionCaseWrongArguments _ -> 19 - | UnitTypeExpected _ -> 20 - | UnitTypeExpectedWithEquality _ -> 20 - | UnitTypeExpectedWithPossiblePropertySetter _ -> 20 - | UnitTypeExpectedWithPossibleAssignment _ -> 20 - | RecursiveUseCheckedAtRuntime _ -> 21 - | LetRecEvaluatedOutOfOrder _ -> 22 + | UnionPatternsBindDifferentNames _ -> 18 + | UnionCaseWrongArguments _ -> 19 + | UnitTypeExpected _ -> 20 + | UnitTypeExpectedWithEquality _ -> 20 + | UnitTypeExpectedWithPossiblePropertySetter _ -> 20 + | UnitTypeExpectedWithPossibleAssignment _ -> 20 + | RecursiveUseCheckedAtRuntime _ -> 21 + | LetRecEvaluatedOutOfOrder _ -> 22 | NameClash _ -> 23 // 24 cannot be reused | PatternMatchCompilation.MatchIncomplete _ -> 25 @@ -271,14 +271,14 @@ let GetDiagnosticNumber(err: PhasedDiagnostic) = | ValNotLocal _ -> 28 | MissingFields _ -> 29 | ValueRestriction _ -> 30 - | LetRecUnsound _ -> 31 - | FieldsFromDifferentTypes _ -> 32 + | LetRecUnsound _ -> 31 + | FieldsFromDifferentTypes _ -> 32 | TyconBadArgs _ -> 33 | ValueNotContained _ -> 34 - | Deprecated _ -> 35 + | Deprecated _ -> 35 | ConstrNotContained _ -> 36 | Duplicate _ -> 37 - | VarBoundTwice _ -> 38 + | VarBoundTwice _ -> 38 | UndefinedName _ -> 39 | LetRecCheckedAtRuntime _ -> 40 | UnresolvedOverloading _ -> 41 @@ -374,9 +374,9 @@ let GetWarningLevel err = match err.Exception with // Level 5 warnings | RecursiveUseCheckedAtRuntime _ - | LetRecEvaluatedOutOfOrder _ + | LetRecEvaluatedOutOfOrder _ | DefensiveCopyWarning _ - | FullAbstraction _ -> 5 + | FullAbstraction _ -> 5 | NumberedError((n, _), _) | ErrorWithSuggestions((n, _), _, _, _) | Error((n, _), _) -> @@ -386,7 +386,7 @@ let GetWarningLevel err = // 1178, tcNoEqualityNeeded2, "The struct, record or union type '%s' does not support structural equality because the type '%s' does not satisfy the 'equality' constraint...." if (n = 1178) then 5 else 2 // Level 2 - | _ -> 2 + | _ -> 2 let warningOn err level specificWarnOn = let n = GetDiagnosticNumber err @@ -610,7 +610,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | ConstraintSolverInfiniteTypes(contextInfo, denv, t1, t2, m, m2) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 - os.Append(ConstraintSolverInfiniteTypesE().Format t1 t2) |> ignore + os.Append(ConstraintSolverInfiniteTypesE().Format t1 t2) |> ignore match contextInfo with | ContextInfo.ReturnInComputationExpression -> @@ -631,7 +631,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 - os.Append(ConstraintSolverTypesNotInEqualityRelation1E().Format t1 t2 ) |> ignore + os.Append(ConstraintSolverTypesNotInEqualityRelation1E().Format t1 t2 ) |> ignore if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore @@ -673,9 +673,9 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | _ -> () fopt |> Option.iter (Printf.bprintf os " %s") - | ErrorFromAddingTypeEquation(g, denv, t1, t2, ConstraintSolverTypesNotInEqualityRelation(_, t1', t2', m , _ , contextInfo), _) + | ErrorFromAddingTypeEquation(g, denv, t1, t2, ConstraintSolverTypesNotInEqualityRelation(_, t1', t2', m, _, contextInfo), _) when typeEquiv g t1 t1' - && typeEquiv g t2 t2' -> + && typeEquiv g t2 t2' -> let t1, t2, tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 match contextInfo with | ContextInfo.IfExpression range when range = m -> os.Append(FSComp.SR.ifExpression(t1, t2)) |> ignore @@ -814,7 +814,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = else os.Append(NameClash2E().Format k1 nm1 nm k2 nm2) |> ignore - | Duplicate(k, s, _) -> + | Duplicate(k, s, _) -> if k = "member" then os.Append(Duplicate1E().Format (DecompileOpName s)) |> ignore else @@ -831,7 +831,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = let _, errs = f(smr, ccuName, s) os.Append(errs) |> ignore - | FieldNotMutable _ -> + | FieldNotMutable _ -> os.Append(FieldNotMutableE().Format) |> ignore | FieldsFromDifferentTypes (_, fref1, fref2, _) -> @@ -874,9 +874,9 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | Some tpnm -> match ty1 with | TType_measure _ -> - os.Append(NonRigidTypar2E().Format tpnm (NicePrint.stringOfTy denv ty)) |> ignore + os.Append(NonRigidTypar2E().Format tpnm (NicePrint.stringOfTy denv ty)) |> ignore | _ -> - os.Append(NonRigidTypar3E().Format tpnm (NicePrint.stringOfTy denv ty)) |> ignore + os.Append(NonRigidTypar3E().Format tpnm (NicePrint.stringOfTy denv ty)) |> ignore | SyntaxError (ctxt, _) -> let ctxt = unbox>(ctxt) @@ -915,57 +915,57 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | Parser.TOKEN_INFIX_STAR_STAR_OP -> getErrorString("Parser.TOKEN.INFIX.STAR.STAR.OP") | Parser.TOKEN_INFIX_COMPARE_OP -> getErrorString("Parser.TOKEN.INFIX.COMPARE.OP") | Parser.TOKEN_COLON_GREATER -> getErrorString("Parser.TOKEN.COLON.GREATER") - | Parser.TOKEN_COLON_COLON ->getErrorString("Parser.TOKEN.COLON.COLON") + | Parser.TOKEN_COLON_COLON ->getErrorString("Parser.TOKEN.COLON.COLON") | Parser.TOKEN_PERCENT_OP -> getErrorString("Parser.TOKEN.PERCENT.OP") | Parser.TOKEN_INFIX_AT_HAT_OP -> getErrorString("Parser.TOKEN.INFIX.AT.HAT.OP") | Parser.TOKEN_INFIX_BAR_OP -> getErrorString("Parser.TOKEN.INFIX.BAR.OP") | Parser.TOKEN_PLUS_MINUS_OP -> getErrorString("Parser.TOKEN.PLUS.MINUS.OP") | Parser.TOKEN_PREFIX_OP -> getErrorString("Parser.TOKEN.PREFIX.OP") - | Parser.TOKEN_COLON_QMARK_GREATER -> getErrorString("Parser.TOKEN.COLON.QMARK.GREATER") + | Parser.TOKEN_COLON_QMARK_GREATER -> getErrorString("Parser.TOKEN.COLON.QMARK.GREATER") | Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> getErrorString("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP") | Parser.TOKEN_INFIX_AMP_OP -> getErrorString("Parser.TOKEN.INFIX.AMP.OP") - | Parser.TOKEN_AMP -> getErrorString("Parser.TOKEN.AMP") - | Parser.TOKEN_AMP_AMP -> getErrorString("Parser.TOKEN.AMP.AMP") - | Parser.TOKEN_BAR_BAR -> getErrorString("Parser.TOKEN.BAR.BAR") - | Parser.TOKEN_LESS -> getErrorString("Parser.TOKEN.LESS") - | Parser.TOKEN_GREATER -> getErrorString("Parser.TOKEN.GREATER") - | Parser.TOKEN_QMARK -> getErrorString("Parser.TOKEN.QMARK") + | Parser.TOKEN_AMP -> getErrorString("Parser.TOKEN.AMP") + | Parser.TOKEN_AMP_AMP -> getErrorString("Parser.TOKEN.AMP.AMP") + | Parser.TOKEN_BAR_BAR -> getErrorString("Parser.TOKEN.BAR.BAR") + | Parser.TOKEN_LESS -> getErrorString("Parser.TOKEN.LESS") + | Parser.TOKEN_GREATER -> getErrorString("Parser.TOKEN.GREATER") + | Parser.TOKEN_QMARK -> getErrorString("Parser.TOKEN.QMARK") | Parser.TOKEN_QMARK_QMARK -> getErrorString("Parser.TOKEN.QMARK.QMARK") | Parser.TOKEN_COLON_QMARK-> getErrorString("Parser.TOKEN.COLON.QMARK") | Parser.TOKEN_INT32_DOT_DOT -> getErrorString("Parser.TOKEN.INT32.DOT.DOT") - | Parser.TOKEN_DOT_DOT -> getErrorString("Parser.TOKEN.DOT.DOT") - | Parser.TOKEN_QUOTE -> getErrorString("Parser.TOKEN.QUOTE") - | Parser.TOKEN_STAR -> getErrorString("Parser.TOKEN.STAR") - | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> getErrorString("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP") - | Parser.TOKEN_COLON -> getErrorString("Parser.TOKEN.COLON") - | Parser.TOKEN_COLON_EQUALS -> getErrorString("Parser.TOKEN.COLON.EQUALS") - | Parser.TOKEN_LARROW -> getErrorString("Parser.TOKEN.LARROW") + | Parser.TOKEN_DOT_DOT -> getErrorString("Parser.TOKEN.DOT.DOT") + | Parser.TOKEN_QUOTE -> getErrorString("Parser.TOKEN.QUOTE") + | Parser.TOKEN_STAR -> getErrorString("Parser.TOKEN.STAR") + | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> getErrorString("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP") + | Parser.TOKEN_COLON -> getErrorString("Parser.TOKEN.COLON") + | Parser.TOKEN_COLON_EQUALS -> getErrorString("Parser.TOKEN.COLON.EQUALS") + | Parser.TOKEN_LARROW -> getErrorString("Parser.TOKEN.LARROW") | Parser.TOKEN_EQUALS -> getErrorString("Parser.TOKEN.EQUALS") | Parser.TOKEN_GREATER_BAR_RBRACK -> getErrorString("Parser.TOKEN.GREATER.BAR.RBRACK") | Parser.TOKEN_MINUS -> getErrorString("Parser.TOKEN.MINUS") - | Parser.TOKEN_ADJACENT_PREFIX_OP -> getErrorString("Parser.TOKEN.ADJACENT.PREFIX.OP") + | Parser.TOKEN_ADJACENT_PREFIX_OP -> getErrorString("Parser.TOKEN.ADJACENT.PREFIX.OP") | Parser.TOKEN_FUNKY_OPERATOR_NAME -> getErrorString("Parser.TOKEN.FUNKY.OPERATOR.NAME") | Parser.TOKEN_COMMA-> getErrorString("Parser.TOKEN.COMMA") | Parser.TOKEN_DOT -> getErrorString("Parser.TOKEN.DOT") | Parser.TOKEN_BAR-> getErrorString("Parser.TOKEN.BAR") | Parser.TOKEN_HASH -> getErrorString("Parser.TOKEN.HASH") - | Parser.TOKEN_UNDERSCORE -> getErrorString("Parser.TOKEN.UNDERSCORE") - | Parser.TOKEN_SEMICOLON -> getErrorString("Parser.TOKEN.SEMICOLON") + | Parser.TOKEN_UNDERSCORE -> getErrorString("Parser.TOKEN.UNDERSCORE") + | Parser.TOKEN_SEMICOLON -> getErrorString("Parser.TOKEN.SEMICOLON") | Parser.TOKEN_SEMICOLON_SEMICOLON-> getErrorString("Parser.TOKEN.SEMICOLON.SEMICOLON") | Parser.TOKEN_LPAREN-> getErrorString("Parser.TOKEN.LPAREN") | Parser.TOKEN_RPAREN | Parser.TOKEN_RPAREN_COMING_SOON | Parser.TOKEN_RPAREN_IS_HERE -> getErrorString("Parser.TOKEN.RPAREN") - | Parser.TOKEN_LQUOTE -> getErrorString("Parser.TOKEN.LQUOTE") - | Parser.TOKEN_LBRACK -> getErrorString("Parser.TOKEN.LBRACK") - | Parser.TOKEN_LBRACE_BAR -> getErrorString("Parser.TOKEN.LBRACE.BAR") - | Parser.TOKEN_LBRACK_BAR -> getErrorString("Parser.TOKEN.LBRACK.BAR") - | Parser.TOKEN_LBRACK_LESS -> getErrorString("Parser.TOKEN.LBRACK.LESS") - | Parser.TOKEN_LBRACE -> getErrorString("Parser.TOKEN.LBRACE") - | Parser.TOKEN_BAR_RBRACK -> getErrorString("Parser.TOKEN.BAR.RBRACK") - | Parser.TOKEN_BAR_RBRACE -> getErrorString("Parser.TOKEN.BAR.RBRACE") - | Parser.TOKEN_GREATER_RBRACK -> getErrorString("Parser.TOKEN.GREATER.RBRACK") + | Parser.TOKEN_LQUOTE -> getErrorString("Parser.TOKEN.LQUOTE") + | Parser.TOKEN_LBRACK -> getErrorString("Parser.TOKEN.LBRACK") + | Parser.TOKEN_LBRACE_BAR -> getErrorString("Parser.TOKEN.LBRACE.BAR") + | Parser.TOKEN_LBRACK_BAR -> getErrorString("Parser.TOKEN.LBRACK.BAR") + | Parser.TOKEN_LBRACK_LESS -> getErrorString("Parser.TOKEN.LBRACK.LESS") + | Parser.TOKEN_LBRACE -> getErrorString("Parser.TOKEN.LBRACE") + | Parser.TOKEN_BAR_RBRACK -> getErrorString("Parser.TOKEN.BAR.RBRACK") + | Parser.TOKEN_BAR_RBRACE -> getErrorString("Parser.TOKEN.BAR.RBRACE") + | Parser.TOKEN_GREATER_RBRACK -> getErrorString("Parser.TOKEN.GREATER.RBRACK") | Parser.TOKEN_RQUOTE_DOT _ - | Parser.TOKEN_RQUOTE -> getErrorString("Parser.TOKEN.RQUOTE") - | Parser.TOKEN_RBRACK -> getErrorString("Parser.TOKEN.RBRACK") + | Parser.TOKEN_RQUOTE -> getErrorString("Parser.TOKEN.RQUOTE") + | Parser.TOKEN_RBRACK -> getErrorString("Parser.TOKEN.RBRACK") | Parser.TOKEN_RBRACE | Parser.TOKEN_RBRACE_COMING_SOON | Parser.TOKEN_RBRACE_IS_HERE -> getErrorString("Parser.TOKEN.RBRACE") | Parser.TOKEN_PUBLIC -> getErrorString("Parser.TOKEN.PUBLIC") | Parser.TOKEN_PRIVATE -> getErrorString("Parser.TOKEN.PRIVATE") @@ -982,14 +982,14 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | Parser.TOKEN_MEMBER -> getErrorString("Parser.TOKEN.MEMBER") | Parser.TOKEN_STATIC -> getErrorString("Parser.TOKEN.STATIC") | Parser.TOKEN_NAMESPACE-> getErrorString("Parser.TOKEN.NAMESPACE") - | Parser.TOKEN_OBLOCKBEGIN -> getErrorString("Parser.TOKEN.OBLOCKBEGIN") + | Parser.TOKEN_OBLOCKBEGIN -> getErrorString("Parser.TOKEN.OBLOCKBEGIN") | EndOfStructuredConstructToken -> getErrorString("Parser.TOKEN.OBLOCKEND") | Parser.TOKEN_THEN | Parser.TOKEN_OTHEN -> getErrorString("Parser.TOKEN.OTHEN") | Parser.TOKEN_ELSE | Parser.TOKEN_OELSE -> getErrorString("Parser.TOKEN.OELSE") | Parser.TOKEN_LET(_) - | Parser.TOKEN_OLET(_) -> getErrorString("Parser.TOKEN.OLET") + | Parser.TOKEN_OLET(_) -> getErrorString("Parser.TOKEN.OLET") | Parser.TOKEN_OBINDER | Parser.TOKEN_BINDER -> getErrorString("Parser.TOKEN.BINDER") | Parser.TOKEN_ODO -> getErrorString("Parser.TOKEN.ODO") @@ -1001,50 +1001,50 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | Parser.TOKEN_DO_BANG | Parser.TOKEN_ODO_BANG -> getErrorString("Parser.TOKEN.ODO.BANG") | Parser.TOKEN_YIELD -> getErrorString("Parser.TOKEN.YIELD") - | Parser.TOKEN_YIELD_BANG -> getErrorString("Parser.TOKEN.YIELD.BANG") + | Parser.TOKEN_YIELD_BANG -> getErrorString("Parser.TOKEN.YIELD.BANG") | Parser.TOKEN_OINTERFACE_MEMBER-> getErrorString("Parser.TOKEN.OINTERFACE.MEMBER") | Parser.TOKEN_ELIF -> getErrorString("Parser.TOKEN.ELIF") | Parser.TOKEN_RARROW -> getErrorString("Parser.TOKEN.RARROW") | Parser.TOKEN_SIG -> getErrorString("Parser.TOKEN.SIG") - | Parser.TOKEN_STRUCT -> getErrorString("Parser.TOKEN.STRUCT") - | Parser.TOKEN_UPCAST -> getErrorString("Parser.TOKEN.UPCAST") - | Parser.TOKEN_DOWNCAST -> getErrorString("Parser.TOKEN.DOWNCAST") - | Parser.TOKEN_NULL -> getErrorString("Parser.TOKEN.NULL") - | Parser.TOKEN_RESERVED -> getErrorString("Parser.TOKEN.RESERVED") - | Parser.TOKEN_MODULE | Parser.TOKEN_MODULE_COMING_SOON | Parser.TOKEN_MODULE_IS_HERE -> getErrorString("Parser.TOKEN.MODULE") - | Parser.TOKEN_AND -> getErrorString("Parser.TOKEN.AND") - | Parser.TOKEN_AS -> getErrorString("Parser.TOKEN.AS") - | Parser.TOKEN_ASSERT -> getErrorString("Parser.TOKEN.ASSERT") - | Parser.TOKEN_OASSERT -> getErrorString("Parser.TOKEN.ASSERT") + | Parser.TOKEN_STRUCT -> getErrorString("Parser.TOKEN.STRUCT") + | Parser.TOKEN_UPCAST -> getErrorString("Parser.TOKEN.UPCAST") + | Parser.TOKEN_DOWNCAST -> getErrorString("Parser.TOKEN.DOWNCAST") + | Parser.TOKEN_NULL -> getErrorString("Parser.TOKEN.NULL") + | Parser.TOKEN_RESERVED -> getErrorString("Parser.TOKEN.RESERVED") + | Parser.TOKEN_MODULE | Parser.TOKEN_MODULE_COMING_SOON | Parser.TOKEN_MODULE_IS_HERE -> getErrorString("Parser.TOKEN.MODULE") + | Parser.TOKEN_AND -> getErrorString("Parser.TOKEN.AND") + | Parser.TOKEN_AS -> getErrorString("Parser.TOKEN.AS") + | Parser.TOKEN_ASSERT -> getErrorString("Parser.TOKEN.ASSERT") + | Parser.TOKEN_OASSERT -> getErrorString("Parser.TOKEN.ASSERT") | Parser.TOKEN_ASR-> getErrorString("Parser.TOKEN.ASR") - | Parser.TOKEN_DOWNTO -> getErrorString("Parser.TOKEN.DOWNTO") - | Parser.TOKEN_EXCEPTION -> getErrorString("Parser.TOKEN.EXCEPTION") - | Parser.TOKEN_FALSE -> getErrorString("Parser.TOKEN.FALSE") - | Parser.TOKEN_FOR -> getErrorString("Parser.TOKEN.FOR") - | Parser.TOKEN_FUN -> getErrorString("Parser.TOKEN.FUN") + | Parser.TOKEN_DOWNTO -> getErrorString("Parser.TOKEN.DOWNTO") + | Parser.TOKEN_EXCEPTION -> getErrorString("Parser.TOKEN.EXCEPTION") + | Parser.TOKEN_FALSE -> getErrorString("Parser.TOKEN.FALSE") + | Parser.TOKEN_FOR -> getErrorString("Parser.TOKEN.FOR") + | Parser.TOKEN_FUN -> getErrorString("Parser.TOKEN.FUN") | Parser.TOKEN_FUNCTION-> getErrorString("Parser.TOKEN.FUNCTION") - | Parser.TOKEN_FINALLY -> getErrorString("Parser.TOKEN.FINALLY") - | Parser.TOKEN_LAZY -> getErrorString("Parser.TOKEN.LAZY") - | Parser.TOKEN_OLAZY -> getErrorString("Parser.TOKEN.LAZY") - | Parser.TOKEN_MATCH -> getErrorString("Parser.TOKEN.MATCH") + | Parser.TOKEN_FINALLY -> getErrorString("Parser.TOKEN.FINALLY") + | Parser.TOKEN_LAZY -> getErrorString("Parser.TOKEN.LAZY") + | Parser.TOKEN_OLAZY -> getErrorString("Parser.TOKEN.LAZY") + | Parser.TOKEN_MATCH -> getErrorString("Parser.TOKEN.MATCH") | Parser.TOKEN_MATCH_BANG -> getErrorString("Parser.TOKEN.MATCH.BANG") - | Parser.TOKEN_MUTABLE -> getErrorString("Parser.TOKEN.MUTABLE") - | Parser.TOKEN_NEW -> getErrorString("Parser.TOKEN.NEW") - | Parser.TOKEN_OF -> getErrorString("Parser.TOKEN.OF") - | Parser.TOKEN_OPEN -> getErrorString("Parser.TOKEN.OPEN") + | Parser.TOKEN_MUTABLE -> getErrorString("Parser.TOKEN.MUTABLE") + | Parser.TOKEN_NEW -> getErrorString("Parser.TOKEN.NEW") + | Parser.TOKEN_OF -> getErrorString("Parser.TOKEN.OF") + | Parser.TOKEN_OPEN -> getErrorString("Parser.TOKEN.OPEN") | Parser.TOKEN_OR -> getErrorString("Parser.TOKEN.OR") | Parser.TOKEN_VOID -> getErrorString("Parser.TOKEN.VOID") | Parser.TOKEN_EXTERN-> getErrorString("Parser.TOKEN.EXTERN") | Parser.TOKEN_INTERFACE -> getErrorString("Parser.TOKEN.INTERFACE") - | Parser.TOKEN_REC -> getErrorString("Parser.TOKEN.REC") - | Parser.TOKEN_TO -> getErrorString("Parser.TOKEN.TO") - | Parser.TOKEN_TRUE -> getErrorString("Parser.TOKEN.TRUE") - | Parser.TOKEN_TRY -> getErrorString("Parser.TOKEN.TRY") - | Parser.TOKEN_TYPE | Parser.TOKEN_TYPE_COMING_SOON | Parser.TOKEN_TYPE_IS_HERE -> getErrorString("Parser.TOKEN.TYPE") - | Parser.TOKEN_VAL -> getErrorString("Parser.TOKEN.VAL") - | Parser.TOKEN_INLINE -> getErrorString("Parser.TOKEN.INLINE") - | Parser.TOKEN_WHEN -> getErrorString("Parser.TOKEN.WHEN") - | Parser.TOKEN_WHILE -> getErrorString("Parser.TOKEN.WHILE") + | Parser.TOKEN_REC -> getErrorString("Parser.TOKEN.REC") + | Parser.TOKEN_TO -> getErrorString("Parser.TOKEN.TO") + | Parser.TOKEN_TRUE -> getErrorString("Parser.TOKEN.TRUE") + | Parser.TOKEN_TRY -> getErrorString("Parser.TOKEN.TRY") + | Parser.TOKEN_TYPE | Parser.TOKEN_TYPE_COMING_SOON | Parser.TOKEN_TYPE_IS_HERE -> getErrorString("Parser.TOKEN.TYPE") + | Parser.TOKEN_VAL -> getErrorString("Parser.TOKEN.VAL") + | Parser.TOKEN_INLINE -> getErrorString("Parser.TOKEN.INLINE") + | Parser.TOKEN_WHEN -> getErrorString("Parser.TOKEN.WHEN") + | Parser.TOKEN_WHILE -> getErrorString("Parser.TOKEN.WHILE") | Parser.TOKEN_WITH-> getErrorString("Parser.TOKEN.WITH") | Parser.TOKEN_IF -> getErrorString("Parser.TOKEN.IF") | Parser.TOKEN_DO -> getErrorString("Parser.TOKEN.DO") @@ -1053,13 +1053,13 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | Parser.TOKEN_IN | Parser.TOKEN_JOIN_IN -> getErrorString("Parser.TOKEN.IN") | Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP-> getErrorString("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP") | Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP-> getErrorString("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP") - | Parser.TOKEN_BEGIN -> getErrorString("Parser.TOKEN.BEGIN") + | Parser.TOKEN_BEGIN -> getErrorString("Parser.TOKEN.BEGIN") | Parser.TOKEN_END -> getErrorString("Parser.TOKEN.END") | Parser.TOKEN_HASH_LIGHT | Parser.TOKEN_HASH_LINE | Parser.TOKEN_HASH_IF | Parser.TOKEN_HASH_ELSE - | Parser.TOKEN_HASH_ENDIF -> getErrorString("Parser.TOKEN.HASH.ENDIF") + | Parser.TOKEN_HASH_ENDIF -> getErrorString("Parser.TOKEN.HASH.ENDIF") | Parser.TOKEN_INACTIVECODE -> getErrorString("Parser.TOKEN.INACTIVECODE") | Parser.TOKEN_LEX_FAILURE-> getErrorString("Parser.TOKEN.LEX.FAILURE") | Parser.TOKEN_WHITESPACE -> getErrorString("Parser.TOKEN.WHITESPACE") @@ -1175,8 +1175,8 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | [NONTERM_Category_Definition] -> os.Append(NONTERM_Category_DefinitionE().Format) |> ignore; true | [NONTERM_Category_SignatureFile] -> os.Append(NONTERM_Category_SignatureFileE().Format) |> ignore; true | [NONTERM_Category_Pattern] -> os.Append(NONTERM_Category_PatternE().Format) |> ignore; true - | [NONTERM_Category_Expr] -> os.Append(NONTERM_Category_ExprE().Format) |> ignore; true - | [NONTERM_Category_Type] -> os.Append(NONTERM_Category_TypeE().Format) |> ignore; true + | [NONTERM_Category_Expr] -> os.Append(NONTERM_Category_ExprE().Format) |> ignore; true + | [NONTERM_Category_Type] -> os.Append(NONTERM_Category_TypeE().Format) |> ignore; true | [Parser.NONTERM_typeArgsActual] -> os.Append(NONTERM_typeArgsActualE().Format) |> ignore; true | _ -> false) @@ -1194,7 +1194,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = |> List.map tokenIdToText |> Set.ofList |> Set.toList) with - | [tokenName1] -> os.Append(TokenName1E().Format (fix tokenName1)) |> ignore + | [tokenName1] -> os.Append(TokenName1E().Format (fix tokenName1)) |> ignore | [tokenName1;tokenName2] -> os.Append(TokenName1TokenName2E().Format (fix tokenName1) (fix tokenName2)) |> ignore | [tokenName1;tokenName2;tokenName3] -> os.Append(TokenName1TokenName2TokenName3E().Format (fix tokenName1) (fix tokenName2) (fix tokenName3)) |> ignore | _ -> () @@ -1255,7 +1255,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = os.Append(OverrideDoesntOverride2E().Format sig1) |> ignore let sig2 = DispatchSlotChecking.FormatMethInfoSig g amap m denv minfoVirt if sig1 <> sig2 then - os.Append(OverrideDoesntOverride3E().Format sig2) |> ignore + os.Append(OverrideDoesntOverride3E().Format sig2) |> ignore | UnionCaseWrongArguments (_, n1, n2, _) -> os.Append(UnionCaseWrongArgumentsE().Format n2 n1) |> ignore @@ -1315,10 +1315,10 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = if isAlreadyMutable then UnitTypeExpectedWithPossibleAssignmentToMutableE().Format (NicePrint.stringOfTy denv ty) bindingName else - UnitTypeExpectedWithPossibleAssignmentE().Format (NicePrint.stringOfTy denv ty) bindingName + UnitTypeExpectedWithPossibleAssignmentE().Format (NicePrint.stringOfTy denv ty) bindingName os.Append warningText |> ignore - | RecursiveUseCheckedAtRuntime _ -> + | RecursiveUseCheckedAtRuntime _ -> os.Append(RecursiveUseCheckedAtRuntimeE().Format) |> ignore | LetRecUnsound (_, [v], _) -> @@ -1372,7 +1372,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | InvalidArgument s - | Failure s as exn -> + | Failure s as exn -> ignore exn // use the argument, even in non DEBUG let f1 = SR.GetString("Failure1") let f2 = SR.GetString("Failure2") @@ -1394,8 +1394,8 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = os.Append(MatchIncomplete1E().Format) |> ignore match cexOpt with | None -> () - | Some (cex, false) -> os.Append(MatchIncomplete2E().Format cex) |> ignore - | Some (cex, true) -> os.Append(MatchIncomplete3E().Format cex) |> ignore + | Some (cex, false) -> os.Append(MatchIncomplete2E().Format cex) |> ignore + | Some (cex, true) -> os.Append(MatchIncomplete3E().Format cex) |> ignore if isComp then os.Append(MatchIncomplete4E().Format) |> ignore @@ -1403,8 +1403,8 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = os.Append(EnumMatchIncomplete1E().Format) |> ignore match cexOpt with | None -> () - | Some (cex, false) -> os.Append(MatchIncomplete2E().Format cex) |> ignore - | Some (cex, true) -> os.Append(MatchIncomplete3E().Format cex) |> ignore + | Some (cex, false) -> os.Append(MatchIncomplete2E().Format cex) |> ignore + | Some (cex, true) -> os.Append(MatchIncomplete3E().Format cex) |> ignore if isComp then os.Append(MatchIncomplete4E().Format) |> ignore @@ -1453,7 +1453,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | MemberKind.PropertyGet | MemberKind.PropertySet | MemberKind.Constructor -> true (* can't infer extra polymorphism *) - | _ -> false (* can infer extra polymorphism *) + | _ -> false (* can infer extra polymorphism *) end -> os.Append(ValueRestriction3E().Format (NicePrint.stringOfQualifiedValOrMember denv v)) |> ignore | _ -> @@ -1542,7 +1542,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) = | InvalidInternalsVisibleToAssemblyName(badName, fileNameOption) -> match fileNameOption with | Some file -> os.Append(InvalidInternalsVisibleToAssemblyName1E().Format badName file) |> ignore - | None -> os.Append(InvalidInternalsVisibleToAssemblyName2E().Format badName) |> ignore + | None -> os.Append(InvalidInternalsVisibleToAssemblyName2E().Format badName) |> ignore | LoadedSourceNotFoundIgnoring(filename, _) -> os.Append(LoadedSourceNotFoundIgnoringE().Format filename) |> ignore @@ -1593,7 +1593,7 @@ let SanitizeFileName fileName implicitIncludeDir = // - fsi.exe sometimes passes "stdin" as a dummy filename // - 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. + // 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) try let fullPath = FileSystem.GetFullPathShim(fileName) @@ -1645,7 +1645,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt SanitizeFileName file implicitIncludeDir let text, m, file = match errorStyle with - | ErrorStyle.EmacsErrors -> + | ErrorStyle.EmacsErrors -> let file = file.Replace("\\", "/") (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file @@ -1656,18 +1656,18 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file // We may also want to change TestErrors to be 1-based - | ErrorStyle.TestErrors -> + | ErrorStyle.TestErrors -> let file = file.Replace("/", "\\") let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file - | ErrorStyle.GccErrors -> + | ErrorStyle.GccErrors -> let file = file.Replace('/', System.IO.Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file // Here, we want the complete range information so Project Systems can generate proper squiggles - | ErrorStyle.VSErrors -> + | ErrorStyle.VSErrors -> // Show prefix only for real files. Otherwise, we just want a truncated error like: // parse error FS0031: blah blah if m<>range0 && m<>rangeStartup && m<>rangeCmdArgs then @@ -1699,7 +1699,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory (if isError then "error" else "warning") errorNumber | _ -> sprintf "%s FS%04d: " (if isError then "error" else "warning") errorNumber - { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} + { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} let mainError, relatedErrors = SplitRelatedDiagnostics err let where = OutputWhere(mainError) @@ -1765,17 +1765,17 @@ let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, erro let OutputDiagnosticContext prefix fileLineFn os err = match GetRangeOfDiagnostic err with - | None -> () + | None -> () | Some m -> let filename = m.FileName let lineA = m.StartLine let lineB = m.EndLine - let line = fileLineFn filename lineA + let line = fileLineFn filename lineA if line<>"" then - let iA = m.StartColumn - let iB = m.EndColumn - let iLen = if lineA = lineB then max (iB - iA) 1 else 1 - Printf.bprintf os "%s%s\n" prefix line + let iA = m.StartColumn + let iB = m.EndColumn + let iLen = if lineA = lineB then max (iB - iA) 1 else 1 + Printf.bprintf os "%s%s\n" prefix line Printf.bprintf os "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') //---------------------------------------------------------------------------- @@ -1788,7 +1788,7 @@ let GetDefaultFSharpCoreReference () = typeof>.Assembly.Location type private TypeInThisAssembly = class end // Use the ValueTuple that is executing with the compiler if it is from System.ValueTuple -// or the System.ValueTuple.dll that sits alongside the compiler. (Note we always ship one with the compiler) +// or the System.ValueTuple.dll that sits alongside the compiler. (Note we always ship one with the compiler) let GetDefaultSystemValueTupleReference () = try let asm = typeof>.Assembly @@ -1822,7 +1822,7 @@ let DefaultReferencesForScriptsAndOutOfProjectSources(assumeDotNetFramework) = yield "System.Drawing" yield "System.Core" - // These are the Portable-profile and .NET Standard 1.6 dependencies of FSharp.Core.dll. These are needed + // These are the Portable-profile and .NET Standard 1.6 dependencies of FSharp.Core.dll. These are needed // when an F# sript references an F# profile 7, 78, 259 or .NET Standard 1.6 component which in turn refers // to FSharp.Core for profile 7, 78, 259 or .NET Standard. yield "System.Runtime" // lots of types @@ -1867,8 +1867,8 @@ let DefaultReferencesForScriptsAndOutOfProjectSources(assumeDotNetFramework) = ] -// A set of assemblies to always consider to be system assemblies. A common set of these can be used a shared -// resources between projects in the compiler services. Also all assembles where well-known system types exist +// A set of assemblies to always consider to be system assemblies. A common set of these can be used a shared +// resources between projects in the compiler services. Also all assembles where well-known system types exist // referenced from TcGlobals must be listed here. let SystemAssemblies () = HashSet @@ -2002,14 +2002,14 @@ 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 then Some name else let res = paths |> List.tryPick (fun path -> let n = Path.Combine (path, name) - if FileSystem.SafeExists n then Some n + if FileSystem.SafeExists n then Some n else None) res @@ -2092,7 +2092,7 @@ type IRawFSharpAssemblyData = /// The raw list AutoOpenAttribute attributes in the assembly abstract GetAutoOpenAttributes: ILGlobals -> string list /// The raw list InternalsVisibleToAttribute attributes in the assembly - abstract GetInternalsVisibleToAttributes: ILGlobals -> string list + abstract GetInternalsVisibleToAttributes: ILGlobals -> string list /// The raw IL module definition in the assembly, if any. This is not present for cross-project references /// in the language service abstract TryGetILModuleDef: unit -> ILModuleDef option @@ -2143,7 +2143,7 @@ and IProjectReference = /// /// For project references this is maximum of the timestamps of all dependent files. /// The project is not actually built, nor are any assemblies read, but the timestamps for each dependent file - /// are read via the FileSystem. If the files don't exist, then a default timestamp is used. + /// are read via the FileSystem. If the files don't exist, then a default timestamp is used. /// /// The operation returns None only if it is not possible to create an IncrementalBuilder for the project at all, e.g. if there /// are fatal errors in the options for the project. @@ -2299,7 +2299,7 @@ type TcConfigBuilder = mutable showTerms: bool (* show terms between passes? *) mutable writeTermsToFiles: bool (* show terms to files? *) mutable doDetuple: bool (* run detuple pass? *) - mutable doTLR: bool (* run TLR pass? *) + mutable doTLR: bool (* run TLR pass? *) mutable doFinalSimplify: bool (* do final simplification pass *) mutable optsOn: bool (* optimizations are turned on *) mutable optSettings: Optimizer.OptimizationSettings @@ -2525,7 +2525,7 @@ type TcConfigBuilder = let outfile = match tcConfigB.outputFile, List.rev implFiles with | None, [] -> "out" + ext() - | None, h :: _ -> + | None, h :: _ -> let basic = fileNameOfPath h let modname = try Filename.chopExtension basic with _ -> basic modname+(ext()) @@ -2608,7 +2608,7 @@ type TcConfigBuilder = member tcConfigB.AddReferencedAssemblyByPath (m, path) = 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. + 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) @@ -2670,11 +2670,11 @@ type AssemblyResolution = member this.ProjectReference = this.originalReference.ProjectReference - /// Compute the ILAssemblyRef for a resolved assembly. This is done by reading the binary if necessary. The result + /// Compute the ILAssemblyRef for a resolved assembly. This is done by reading the binary if necessary. The result /// 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) = @@ -2692,7 +2692,7 @@ type AssemblyResolution = | Some contents -> match contents.ILScopeRef with | ILScopeRef.Assembly aref -> return Some aref - | _ -> return None + | _ -> return None | None -> return None } let assemblyRef = @@ -2794,7 +2794,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = // targetFrameworkVersion shouldn't matter since resolution has already happened. // In those cases where it does matter (e.g. --noframework is not being used or we are processing further // resolutions for a script) then it is correct to just use HighestInstalledNetFrameworkVersion(). - let clrRootValue, targetFrameworkVersionValue = + let clrRootValue, targetFrameworkVersionValue = match primaryAssemblyExplicitFilenameOpt with | Some primaryAssemblyFilename -> let filename = ComputeMakePathAbsolute data.implicitIncludeDir primaryAssemblyFilename @@ -2806,7 +2806,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) | None -> #if !ENABLE_MONO_SUPPORT - // TODO: we have to get msbuild out of this + // TODO: we have to get msbuild out of this if data.useSimpleResolution then None, "" else @@ -2867,87 +2867,87 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member x.subsystemVersion = data.subsystemVersion member x.useHighEntropyVA = data.useHighEntropyVA member x.inputCodePage = data.inputCodePage - member x.embedResources = data.embedResources + member x.embedResources = data.embedResources member x.errorSeverityOptions = data.errorSeverityOptions member x.mlCompatibility = data.mlCompatibility member x.checkOverflow = data.checkOverflow member x.showReferenceResolutions = data.showReferenceResolutions - member x.outputFile = data.outputFile - member x.platform = data.platform + member x.outputFile = data.outputFile + member x.platform = data.platform member x.prefer32Bit = data.prefer32Bit - member x.useSimpleResolution = data.useSimpleResolution - member x.target = data.target - member x.debuginfo = data.debuginfo + member x.useSimpleResolution = data.useSimpleResolution + member x.target = data.target + member x.debuginfo = data.debuginfo member x.testFlagEmitFeeFeeAs100001 = data.testFlagEmitFeeFeeAs100001 member x.dumpDebugInfo = data.dumpDebugInfo - member x.debugSymbolFile = data.debugSymbolFile - member x.typeCheckOnly = data.typeCheckOnly - member x.parseOnly = data.parseOnly + member x.debugSymbolFile = data.debugSymbolFile + member x.typeCheckOnly = data.typeCheckOnly + member x.parseOnly = data.parseOnly member x.importAllReferencesOnly = data.importAllReferencesOnly member x.simulateException = data.simulateException - member x.printAst = data.printAst + member x.printAst = data.printAst member x.targetFrameworkVersion = targetFrameworkVersionValue - member x.tokenizeOnly = data.tokenizeOnly - member x.testInteractionParser = data.testInteractionParser - member x.reportNumDecls = data.reportNumDecls - member x.printSignature = data.printSignature - member x.printSignatureFile = data.printSignatureFile - member x.xmlDocOutputFile = data.xmlDocOutputFile - member x.stats = data.stats - member x.generateFilterBlocks = data.generateFilterBlocks - member x.signer = data.signer + member x.tokenizeOnly = data.tokenizeOnly + member x.testInteractionParser = data.testInteractionParser + member x.reportNumDecls = data.reportNumDecls + member x.printSignature = data.printSignature + member x.printSignatureFile = data.printSignatureFile + member x.xmlDocOutputFile = data.xmlDocOutputFile + member x.stats = data.stats + member x.generateFilterBlocks = data.generateFilterBlocks + member x.signer = data.signer member x.container = data.container - member x.delaysign = data.delaysign - member x.publicsign = data.publicsign - member x.version = data.version + member x.delaysign = data.delaysign + member x.publicsign = data.publicsign + member x.version = data.version member x.metadataVersion = data.metadataVersion - member x.standalone = data.standalone - member x.extraStaticLinkRoots = data.extraStaticLinkRoots - member x.noSignatureData = data.noSignatureData - member x.onlyEssentialOptimizationData = data.onlyEssentialOptimizationData - member x.useOptimizationDataFile = data.useOptimizationDataFile - member x.jitTracking = data.jitTracking - member x.portablePDB = data.portablePDB - member x.embeddedPDB = data.embeddedPDB - member x.embedAllSource = data.embedAllSource - member x.embedSourceList = data.embedSourceList - member x.sourceLink = data.sourceLink - member x.ignoreSymbolStoreSequencePoints = data.ignoreSymbolStoreSequencePoints - member x.internConstantStrings = data.internConstantStrings - member x.extraOptimizationIterations = data.extraOptimizationIterations - member x.win32res = data.win32res + member x.standalone = data.standalone + member x.extraStaticLinkRoots = data.extraStaticLinkRoots + member x.noSignatureData = data.noSignatureData + member x.onlyEssentialOptimizationData = data.onlyEssentialOptimizationData + member x.useOptimizationDataFile = data.useOptimizationDataFile + member x.jitTracking = data.jitTracking + member x.portablePDB = data.portablePDB + member x.embeddedPDB = data.embeddedPDB + member x.embedAllSource = data.embedAllSource + member x.embedSourceList = data.embedSourceList + member x.sourceLink = data.sourceLink + member x.ignoreSymbolStoreSequencePoints = data.ignoreSymbolStoreSequencePoints + member x.internConstantStrings = data.internConstantStrings + member x.extraOptimizationIterations = data.extraOptimizationIterations + member x.win32res = data.win32res member x.win32manifest = data.win32manifest member x.includewin32manifest = data.includewin32manifest - member x.linkResources = data.linkResources - member x.showFullPaths = data.showFullPaths - member x.errorStyle = data.errorStyle - member x.utf8output = data.utf8output + member x.linkResources = data.linkResources + member x.showFullPaths = data.showFullPaths + member x.errorStyle = data.errorStyle + member x.utf8output = data.utf8output member x.flatErrors = data.flatErrors - member x.maxErrors = data.maxErrors - member x.baseAddress = data.baseAddress + member x.maxErrors = data.maxErrors + member x.baseAddress = data.baseAddress #if DEBUG - member x.showOptimizationData = data.showOptimizationData + member x.showOptimizationData = data.showOptimizationData #endif - member x.showTerms = data.showTerms - member x.writeTermsToFiles = data.writeTermsToFiles - member x.doDetuple = data.doDetuple - member x.doTLR = data.doTLR - member x.doFinalSimplify = data.doFinalSimplify - member x.optSettings = data.optSettings - member x.emitTailcalls = data.emitTailcalls - member x.deterministic = data.deterministic - member x.preferredUiLang = data.preferredUiLang - member x.lcid = data.lcid - member x.optsOn = data.optsOn - member x.productNameForBannerText = data.productNameForBannerText - member x.showBanner = data.showBanner - member x.showTimes = data.showTimes + member x.showTerms = data.showTerms + member x.writeTermsToFiles = data.writeTermsToFiles + member x.doDetuple = data.doDetuple + member x.doTLR = data.doTLR + member x.doFinalSimplify = data.doFinalSimplify + member x.optSettings = data.optSettings + member x.emitTailcalls = data.emitTailcalls + member x.deterministic = data.deterministic + member x.preferredUiLang = data.preferredUiLang + member x.lcid = data.lcid + member x.optsOn = data.optsOn + member x.productNameForBannerText = data.productNameForBannerText + member x.showBanner = data.showBanner + member x.showTimes = data.showTimes member x.showLoadedAssemblies = data.showLoadedAssemblies member x.continueAfterParseFailure = data.continueAfterParseFailure #if !NO_EXTENSIONTYPING - member x.showExtensionTypeMessages = data.showExtensionTypeMessages + member x.showExtensionTypeMessages = data.showExtensionTypeMessages #endif - member x.pause = data.pause + member x.pause = data.pause member x.alwaysCallVirt = data.alwaysCallVirt member x.noDebugData = data.noDebugData member x.isInteractive = data.isInteractive @@ -3057,7 +3057,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = |> List.distinct /// A closed set of assemblies where, for any subset S: - /// - the TcImports object built for S (and thus the F# Compiler CCUs for the assemblies in S) + /// - the TcImports object built for S (and thus the F# Compiler CCUs for the assemblies in S) /// is a resource that can be shared between any two IncrementalBuild objects that reference /// precisely S /// @@ -3113,7 +3113,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let searchPaths = // if this is a #r reference (not from dummy range), make sure the directory of the declaring // file is included in the search path. This should ideally already be one of the search paths, but - // during some global checks it won't be. We append to the end of the search list so that this is the last + // during some global checks it won't be. We append to the end of the search list so that this is the last // place that is checked. if m <> range0 && m <> rangeStartup && m <> rangeCmdArgs && FileSystem.IsPathRootedShim m.FileName then tcConfig.GetSearchPathsForLibraryFiles() @ [Path.GetDirectoryName(m.FileName)] @@ -3186,7 +3186,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = assemblyName, highestPosition, assemblyGroup) |> Array.ofSeq - let logMessage showMessages = + let logMessage showMessages = if showMessages && tcConfig.showReferenceResolutions then (fun (message: string)->dprintf "%s\n" message) else ignore @@ -3396,7 +3396,7 @@ let QualFileNameOfSpecs filename specs = let QualFileNameOfImpls filename specs = match specs with | [SynModuleOrNamespace(modname, _, kind, _, _, _, _, m)] when kind.IsModule -> QualFileNameOfModuleName m filename modname - | [SynModuleOrNamespace(_, _, kind, _, _, _, _, m)] when not kind.IsModule -> QualFileNameOfFilename m filename + | [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]) @@ -3418,7 +3418,7 @@ let ComputeAnonModuleName check defaultNamespace filename (m: range) = | None -> modname | Some ns -> textOfPath [ns;modname] - let anonymousModuleNameRange = + let anonymousModuleNameRange = let filename = m.FileName mkRange filename pos0 pos0 pathToSynLid anonymousModuleNameRange (splitNamespace combined) @@ -3507,7 +3507,7 @@ let PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, ParsedImp let PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, ParsedSigFile(hashDirectives, specs)) = match specs |> List.rev |> List.tryPick (function ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid, _, _, _, _, _, _, _)) -> Some(lid) | _ -> None) with - | Some lid when specs.Length > 1 -> + | Some lid when specs.Length > 1 -> errorR(Error(FSComp.SR.buildMultipleToplevelModules(), rangeOfLid lid)) | _ -> () @@ -3562,7 +3562,7 @@ let ParseInput (lexer, errorLogger: ErrorLogger, lexbuf: UnicodeLexing.Lexbuf, d // - fsi.exe sometimes passes "stdin" as a dummy filename // - 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. + // 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) let lower = String.lowercase filename // Delay sending errors and warnings until after the file is parsed. This gives us a chance to scrape the @@ -3570,16 +3570,16 @@ let ParseInput (lexer, errorLogger: ErrorLogger, lexbuf: UnicodeLexing.Lexbuf, d let delayLogger = CapturingErrorLogger("Parsing") use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayLogger) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - let mutable scopedPragmas = [] + let mutable scopedPragmas = [] try let input = - if mlCompatSuffixes |> List.exists (Filename.checkSuffix lower) then + if mlCompatSuffixes |> List.exists (Filename.checkSuffix lower) then mlCompatWarning (FSComp.SR.buildCompilingExtensionIsForML()) rangeStartup - if FSharpImplFileSuffixes |> List.exists (Filename.checkSuffix lower) then + if FSharpImplFileSuffixes |> List.exists (Filename.checkSuffix lower) then let impl = Parser.implementationFile lexer lexbuf PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, impl) - elif FSharpSigFileSuffixes |> List.exists (Filename.checkSuffix lower) then + elif FSharpSigFileSuffixes |> List.exists (Filename.checkSuffix lower) then let intfs = Parser.signatureFile lexer lexbuf PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, intfs) else @@ -3613,7 +3613,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp let t = tokenizer.Lexer lexbuf printf "tokenize - got %s @ %a\n" (Parser.token_to_string t) outputRange lexbuf.LexemeRange (match t with Parser.EOF _ -> exit 0 | _ -> ()) - if lexbuf.IsPastEndOfStream then printf "!!! at end of stream\n" + if lexbuf.IsPastEndOfStream then printf "!!! at end of stream\n" if tcConfig.testInteractionParser then while true do @@ -3647,7 +3647,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = try let lower = String.lowercase filename - if List.exists (Filename.checkSuffix lower) (FSharpSigFileSuffixes@FSharpImplFileSuffixes) then + if List.exists (Filename.checkSuffix lower) (FSharpSigFileSuffixes@FSharpImplFileSuffixes) then if not(FileSystem.SafeExists(filename)) then error(Error(FSComp.SR.buildCouldNotFindSourceFile(filename), rangeStartup)) // bug 3155: if the file name is indirect, use a full path @@ -3661,7 +3661,7 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompil type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list, unresolved: UnresolvedAssemblyReference list) = let originalReferenceToResolution = results |> List.map (fun r -> r.originalReference.Text, r) |> Map.ofList - let resolvedPathToResolution = results |> List.map (fun r -> r.resolvedPath, r) |> Map.ofList + 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) @@ -3770,15 +3770,15 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list, // Typecheck and optimization environments on disk //-------------------------------------------------------------------------- -let IsSignatureDataResource (r: ILResource) = +let IsSignatureDataResource (r: ILResource) = r.Name.StartsWithOrdinal(FSharpSignatureDataResourceName) || r.Name.StartsWithOrdinal(FSharpSignatureDataResourceName2) -let IsOptimizationDataResource (r: ILResource) = +let IsOptimizationDataResource (r: ILResource) = r.Name.StartsWithOrdinal(FSharpOptimizationDataResourceName)|| r.Name.StartsWithOrdinal(FSharpOptimizationDataResourceName2) -let GetSignatureDataResourceName (r: ILResource) = +let GetSignatureDataResourceName (r: ILResource) = if r.Name.StartsWithOrdinal(FSharpSignatureDataResourceName) then String.dropPrefix r.Name FSharpSignatureDataResourceName elif r.Name.StartsWithOrdinal(FSharpSignatureDataResourceName2) then @@ -3867,7 +3867,7 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR let optDataReaders = if optDataReaders.IsEmpty && List.contains ilShortAssemName externalSigAndOptData then let optDataFile = Path.ChangeExtension(filename, "optdata") - if not (FileSystem.SafeExists optDataFile) then + if not (FileSystem.SafeExists optDataFile) then error(Error(FSComp.SR.buildExpectedFileAlongSideFSharpCore(optDataFile, FileSystem.GetFullPathShim optDataFile), m)) [ (ilShortAssemName, (fun () -> FileSystem.ReadAllBytesShim optDataFile))] else @@ -3949,7 +3949,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu | None -> false | None -> false - member private tcImports.Base = + member private tcImports.Base = CheckDisposed() importsBase @@ -4009,7 +4009,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu 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() = @@ -4202,7 +4202,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu CheckDisposed() tcImports.GetDllInfos() |> List.exists (fun dll -> match dll.ILScopeRef with - | ILScopeRef.Assembly a -> a.Name = nm + | ILScopeRef.Assembly a -> a.Name = nm | _ -> false) member tcImports.GetImportMap() = @@ -4322,14 +4322,14 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu name.Version let typeProviderEnvironment = - { resolutionFolder = tcConfig.implicitIncludeDir - outputFile = tcConfig.outputFile + { resolutionFolder = tcConfig.implicitIncludeDir + outputFile = tcConfig.outputFile showResolutionMessages = tcConfig.showExtensionTypeMessages - referencedAssemblies = Array.distinct [| for r in tcImports.AllAssemblyResolutions() -> r.resolvedPath |] - temporaryFolder = FileSystem.GetTempPathShim() } + referencedAssemblies = Array.distinct [| for r in tcImports.AllAssemblyResolutions() -> r.resolvedPath |] + temporaryFolder = FileSystem.GetTempPathShim() } // The type provider should not hold strong references to disposed - // TcImport objects. So the callbacks provided in the type provider config + // TcImport objects. So the callbacks provided in the type provider config // dispatch via a thunk which gets set to a non-resource-capturing // failing function when the object is disposed. let systemRuntimeContainsType = @@ -4487,7 +4487,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu Stamp = newStamp() FileName = Some filename QualifiedName= Some(ilScopeRef.QualifiedName) - SourceCodeDirectory = codeDir (* note: in some cases we fix up this information later *) + SourceCodeDirectory = codeDir (* note: in some cases we fix up this information later *) IsFSharp=true Contents = mspec #if !NO_EXTENSIONTYPING @@ -4504,7 +4504,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let optdata = lazy - (match Map.tryFind ccuName optDatas with + (match Map.tryFind ccuName optDatas with | None -> if verbose then dprintf "*** no optimization data for CCU %s, was DLL compiled with --no-optimization-data??\n" ccuName None @@ -4548,7 +4548,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu phase2 - // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable. + // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable. member tcImports.RegisterAndPrepareToImportReferencedDll (ctok, r: AssemblyResolution) : Cancellable<_ * (unit -> AvailableImportedAssembly list)> = cancellable { CheckDisposed() @@ -4589,7 +4589,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu tcImports.RegisterDll(dllinfo) let ilg = defaultArg ilGlobalsOpt EcmaMscorlibILGlobals let phase2 = - if assemblyData.HasAnyFSharpSignatureDataAttribute then + if assemblyData.HasAnyFSharpSignatureDataAttribute then if not (assemblyData.HasMatchingFSharpSignatureDataAttribute(ilg)) then errorR(Error(FSComp.SR.buildDifferentVersionMustRecompile(filename), m)) tcImports.PrepareToImportReferencedILAssembly (ctok, m, filename, dllinfo) @@ -4602,7 +4602,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu return dllinfo, phase2 } - // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable. + // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable. member tcImports.RegisterAndImportReferencedAssemblies (ctok, nms: AssemblyResolution list) = cancellable { CheckDisposed() @@ -4624,7 +4624,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu } /// Note that implicit loading is not used for compilations from MSBuild, which passes ``--noframework`` - /// Implicit loading is done in non-cancellation mode. Implicit loading is never used in the language service, so + /// Implicit loading is done in non-cancellation mode. Implicit loading is never used in the language service, so /// no cancellation is needed. member tcImports.ImplicitLoadIfAllowed (ctok, m, assemblyName, lookupOnly) = CheckDisposed() @@ -4644,10 +4644,10 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu false if tryFile (assemblyName + ".dll") then () - else tryFile (assemblyName + ".exe") |> ignore + else tryFile (assemblyName + ".exe") |> ignore #if !NO_EXTENSIONTYPING - member tcImports.TryFindProviderGeneratedAssemblyByName(ctok, assemblyName: string) : System.Reflection.Assembly option = + member tcImports.TryFindProviderGeneratedAssemblyByName(ctok, assemblyName: string) : System.Reflection.Assembly option = // The assembly may not be in the resolutions, but may be in the load set including EST injected assemblies match tcImports.TryFindDllInfo (ctok, range0, assemblyName, lookupOnly=true) with | Some res -> @@ -4657,12 +4657,12 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu #endif /// This doesn't need to be cancellable, it is only used by F# Interactive - member tcImports.TryFindExistingFullyQualifiedPathBySimpleAssemblyName (ctok, simpleAssemName) : string option = + member tcImports.TryFindExistingFullyQualifiedPathBySimpleAssemblyName (ctok, simpleAssemName) : string option = resolutions.TryFindBySimpleAssemblyName (ctok, simpleAssemName) |> Option.map (fun r -> r.resolvedPath) /// This doesn't need to be cancellable, it is only used by F# Interactive - member tcImports.TryFindExistingFullyQualifiedPathByExactAssemblyRef(ctok, assemblyRef: ILAssemblyRef) : string option = - resolutions.TryFindByExactILAssemblyRef (ctok, assemblyRef) |> Option.map (fun r -> r.resolvedPath) + member tcImports.TryFindExistingFullyQualifiedPathByExactAssemblyRef(ctok, assemblyRef: ILAssemblyRef) : string option = + resolutions.TryFindByExactILAssemblyRef (ctok, assemblyRef) |> Option.map (fun r -> r.resolvedPath) member tcImports.TryResolveAssemblyReference(ctok, assemblyReference: AssemblyReference, mode: ResolveAssemblyReferenceMode) : OperationResult = let tcConfig = tcConfigP.Get(ctok) @@ -4698,10 +4698,10 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu // But don't cache resolution failures because the assembly may appear on the disk later. let resolved, unresolved = TcConfig.TryResolveLibsUsingMSBuildRules(tcConfig, [ assemblyReference ], assemblyReference.Range, mode) match resolved, unresolved with - | (assemblyResolution::_, _) -> + | (assemblyResolution::_, _) -> resolutions <- resolutions.AddResolutionResults resolved ResultD [assemblyResolution] - | (_, _::_) -> + | (_, _::_) -> resolutions <- resolutions.AddUnresolvedReferences unresolved ErrorD(AssemblyNotResolved(assemblyReference.Text, assemblyReference.Range)) | [], [] -> @@ -4736,7 +4736,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu let primaryScopeRef = match primaryAssem with | (_, [ResolvedImportedAssembly(ccu)]) -> ccu.FSharpViewOfMetadata.ILScopeRef - | _ -> failwith "unexpected" + | _ -> failwith "unexpected" let ilGlobals = mkILGlobals primaryScopeRef frameworkTcImports.SetILGlobals ilGlobals @@ -4784,7 +4784,7 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu IlxSettings.ilxFsharpCoreLibAssemRef := (let scoref = fslibCcuInfo.ILScopeRef match scoref with - | ILScopeRef.Assembly aref -> Some aref + | ILScopeRef.Assembly aref -> Some aref | ILScopeRef.Local | ILScopeRef.Module _ -> error(InternalError("not ILScopeRef.Assembly", rangeStartup))) fslibCcuInfo.FSharpViewOfMetadata @@ -4860,7 +4860,7 @@ let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file) = let dllinfos, ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) |> Cancellable.runWithoutCancellation let asms = - ccuinfos |> List.map (function + ccuinfos |> List.map (function | ResolvedImportedAssembly(asm) -> asm | UnresolvedImportedAssembly(assemblyName) -> error(Error(FSComp.SR.buildCouldNotResolveAssemblyRequiredByFile(assemblyName, file), m))) @@ -4881,10 +4881,10 @@ let ProcessMetaCommandsFromInput let canHaveScriptMetaCommands = match inp with - | ParsedInput.SigFile(_) -> false + | ParsedInput.SigFile(_) -> false | ParsedInput.ImplFile(ParsedImplFileInput(isScript = isScript)) -> isScript - let ProcessMetaCommand state hash = + let ProcessMetaCommand state hash = let mutable matchedm = range0 try match hash with @@ -5015,7 +5015,7 @@ type LoadClosureInput = { FileName: string SyntaxTree: ParsedInput option ParseDiagnostics: (PhasedDiagnostic * bool) list - MetaCommandDiagnostics: (PhasedDiagnostic * bool) list } + MetaCommandDiagnostics: (PhasedDiagnostic * bool) list } [] type LoadClosure = @@ -5032,7 +5032,7 @@ type LoadClosure = /// The #nowarns NoWarns: (string * range list) list /// Diagnostics seen while processing resolutions - ResolutionDiagnostics: (PhasedDiagnostic * bool) list + ResolutionDiagnostics: (PhasedDiagnostic * bool) list /// Diagnostics seen while parsing root of closure AllRootFileDiagnostics: (PhasedDiagnostic * bool) list /// Diagnostics seen while processing the compiler options implied root of closure @@ -5053,7 +5053,7 @@ module private ScriptPreprocessClosure = type ClosureSource = ClosureSource of filename: string * referenceRange: range * sourceText: string * parseRequired: bool /// Represents an output of the closure finding process - type ClosureFile = ClosureFile of string * range * ParsedInput option * (PhasedDiagnostic * bool) list * (PhasedDiagnostic * bool) list * (string * range) list // filename, range, errors, warnings, nowarns + type ClosureFile = ClosureFile of string * range * ParsedInput option * (PhasedDiagnostic * bool) list * (PhasedDiagnostic * bool) list * (string * range) list // filename, range, errors, warnings, nowarns type Observed() = let seen = System.Collections.Generic.Dictionary<_, bool>() @@ -5127,8 +5127,8 @@ module private ScriptPreprocessClosure = use stream = FileSystem.FileStreamReadShim filename use reader = match inputCodePage with - | None -> new StreamReader(stream, true) - | Some (n: int) -> new StreamReader(stream, Encoding.GetEncoding(n)) + | None -> new StreamReader(stream, true) + | Some (n: int) -> new StreamReader(stream, Encoding.GetEncoding(n)) let source = reader.ReadToEnd() [ClosureSource(filename, m, source, parseRequired)] with e -> @@ -5152,7 +5152,7 @@ module private ScriptPreprocessClosure = try TcConfig.Create(tcConfigB, validate=false), nowarns with ReportedError _ -> - // Recover by using a default TcConfig. + // Recover by using a default TcConfig. let tcConfigB = tcConfig.CloneOfOriginalBuilder TcConfig.Create(tcConfigB, validate=false), nowarns @@ -5233,7 +5233,7 @@ module private ScriptPreprocessClosure = | _ -> closureFiles // Get all source files. - let sourceFiles = [ for (ClosureFile(filename, m, _, _, _, _)) in closureFiles -> (filename, m) ] + let sourceFiles = [ for (ClosureFile(filename, m, _, _, _, _)) in closureFiles -> (filename, m) ] let sourceInputs = [ for (ClosureFile(filename, _, input, parseDiagnostics, metaDiagnostics, _nowarns)) in closureFiles -> @@ -5250,7 +5250,7 @@ module private ScriptPreprocessClosure = use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) let references, unresolvedReferences = GetAssemblyResolutionInformation(ctok, tcConfig) - let references = references |> List.map (fun ar -> ar.resolvedPath, ar) + let references = references |> List.map (fun ar -> ar.resolvedPath, ar) references, unresolvedReferences, errorLogger.Diagnostics // Root errors and warnings - look at the last item in the closureFiles list @@ -5275,10 +5275,10 @@ module private ScriptPreprocessClosure = let result: LoadClosure = { SourceFiles = List.groupBy fst sourceFiles |> List.map (map2Of2 (List.map snd)) - References = List.groupBy fst references |> List.map (map2Of2 (List.map snd)) + References = List.groupBy fst references |> List.map (map2Of2 (List.map snd)) UnresolvedReferences = unresolvedReferences Inputs = sourceInputs - NoWarns = List.groupBy fst globalNoWarns |> List.map (map2Of2 (List.map snd)) + NoWarns = List.groupBy fst globalNoWarns |> List.map (map2Of2 (List.map snd)) OriginalLoadReferences = tcConfig.loadedSources ResolutionDiagnostics = resolutionDiagnostics AllRootFileDiagnostics = allRootDiagnostics @@ -5307,7 +5307,7 @@ module private ScriptPreprocessClosure = tryGetMetadataSnapshot, reduceMemoryUsage) let resolutions0, _unresolvedReferences = GetAssemblyResolutionInformation(ctok, tcConfig) - let references0 = resolutions0 |> List.map (fun r->r.originalReference.Range, r.resolvedPath) |> Seq.distinct |> List.ofSeq + let references0 = resolutions0 |> List.map (fun r->r.originalReference.Range, r.resolvedPath) |> Seq.distinct |> List.ofSeq references0 let tcConfig = @@ -5361,7 +5361,7 @@ type LoadClosure with //-------------------------------------------------------------------------- /// Build the initial type checking environment -let GetInitialTcEnv (thisAssemblyName: string, initm: range, tcConfig: TcConfig, tcImports: TcImports, tcGlobals) = +let GetInitialTcEnv (thisAssemblyName: string, initm: range, tcConfig: TcConfig, tcImports: TcImports, tcGlobals) = let initm = initm.StartRange let ccus = @@ -5412,7 +5412,7 @@ let CheckSimulateException(tcConfig: TcConfig) = // Type-check sets of files //-------------------------------------------------------------------------- -type RootSigs = Zmap +type RootSigs = Zmap type RootImpls = Zset let qnameOrder = Order.orderBy (fun (q: QualifiedNameOfFile) -> q.Text) @@ -5426,7 +5426,7 @@ type TcState = tcsCreatesGeneratedProvidedTypes: bool tcsRootSigs: RootSigs tcsRootImpls: RootImpls - tcsCcuSig: ModuleOrNamespaceType } + tcsCcuSig: ModuleOrNamespaceType } member x.NiceNameGenerator = x.tcsNiceNameGen @@ -5522,9 +5522,9 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: let! (tcEnv, sigFileType, createsGeneratedProvidedTypes) = TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcState.tcsTcSigEnv file - let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs + let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs - // Add the signature to the signature env (unless it had an explicit signature) + // Add the signature to the signature env (unless it had an explicit signature) let ccuSigForFile = CombineCcuContentFragments m [sigFileType; tcState.tcsCcuSig] // Open the prefixPath for fsi.exe @@ -5560,7 +5560,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: // Typecheck the implementation file let! topAttrs, implFile, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = - TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcImplEnv rootSigOpt file + TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcImplEnv rootSigOpt file let hadSig = rootSigOpt.IsSome let implFileSigType = SigTypeOfImplFile implFile @@ -5609,7 +5609,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 = +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 unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck @@ -5628,7 +5628,7 @@ let TypeCheckMultipleInputsFinish(results, tcState: TcState) = let TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = eventually { Logger.LogBlockStart LogCompilerFunctionId.CompileOps_TypeCheckOneInputAndFinishEventually - let! results, tcState = TypeCheckOneInputEventually(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) + let! results, tcState = TypeCheckOneInputEventually(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) let result = TypeCheckMultipleInputsFinish([results], tcState) Logger.LogBlockStop LogCompilerFunctionId.CompileOps_TypeCheckOneInputAndFinishEventually return result @@ -5647,7 +5647,7 @@ let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions - let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState) let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index eb3c6364acf..4aeefae3bfa 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -751,7 +751,7 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) = let embed = [ CompilerOption ("embed", tagNone, - OptionSwitch (SetEmbedAllSourceSwitch tcConfigB) , None, + OptionSwitch (SetEmbedAllSourceSwitch tcConfigB), None, Some (FSComp.SR.optsEmbedAllSource())) CompilerOption @@ -768,7 +768,7 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) = let codegen = [ CompilerOption ("optimize", tagNone, - OptionSwitch (SetOptimizeSwitch tcConfigB) , None, + OptionSwitch (SetOptimizeSwitch tcConfigB), None, Some (FSComp.SR.optsOptimize())) CompilerOption @@ -1013,12 +1013,12 @@ let internalFlags (tcConfigB:TcConfigBuilder) = Some(InternalCommandLineOption("--ranges", rangeCmdArgs)), None) CompilerOption - ("terms" , tagNone, + ("terms", tagNone, OptionUnit (fun () -> tcConfigB.showTerms <- true), Some(InternalCommandLineOption("--terms", rangeCmdArgs)), None) CompilerOption - ("termsfile" , tagNone, + ("termsfile", tagNone, OptionUnit (fun () -> tcConfigB.writeTermsToFiles <- true), Some(InternalCommandLineOption("--termsfile", rangeCmdArgs)), None) @@ -1174,14 +1174,14 @@ let internalFlags (tcConfigB:TcConfigBuilder) = // "Display timing profiles for compilation" CompilerOption - ("times" , tagNone, + ("times", tagNone, OptionUnit (fun () -> tcConfigB.showTimes <- true), Some(InternalCommandLineOption("times", rangeCmdArgs)), None) #if !NO_EXTENSIONTYPING // "Display information about extension type resolution") CompilerOption - ("showextensionresolution" , tagNone, + ("showextensionresolution", tagNone, OptionUnit (fun () -> tcConfigB.showExtensionTypeMessages <- true), Some(InternalCommandLineOption("showextensionresolution", rangeCmdArgs)), None) #endif @@ -1392,7 +1392,7 @@ let miscFlagsFsi tcConfigB = miscFlagsBoth tcConfigB let abbreviatedFlagsBoth tcConfigB = [ CompilerOption("d", tagString, OptionString (defineSymbol tcConfigB), None, Some(FSComp.SR.optsShortFormOf("--define"))) - CompilerOption("O", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, Some(FSComp.SR.optsShortFormOf("--optimize[+|-]"))) + CompilerOption("O", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB), None, Some(FSComp.SR.optsShortFormOf("--optimize[+|-]"))) CompilerOption("g", tagNone, OptionSwitch (SetDebugSwitch tcConfigB None), None, Some(FSComp.SR.optsShortFormOf("--debug"))) CompilerOption("i", tagString, OptionUnit (fun () -> tcConfigB.printSignature <- true), None, Some(FSComp.SR.optsShortFormOf("--sig"))) referenceFlagAbbrev tcConfigB (* -r *) @@ -1416,12 +1416,12 @@ let abbreviatedFlagsFsc tcConfigB = // FSC help abbreviations. FSI has it's own help options... CompilerOption - ("?" , tagNone, + ("?", tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some(FSComp.SR.optsShortFormOf("--help"))) CompilerOption - ("help" , tagNone, + ("help", tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some(FSComp.SR.optsShortFormOf("--help"))) @@ -1526,15 +1526,15 @@ let GetCoreServiceCompilerOptions (tcConfigB:TcConfigBuilder) = /// The core/common options used by fsi.exe. [note, some additional options are added in fsi.fs]. let GetCoreFsiCompilerOptions (tcConfigB: TcConfigBuilder) = - [ PublicOptions(FSComp.SR.optsHelpBannerOutputFiles() , outputFileFlagsFsi tcConfigB) - PublicOptions(FSComp.SR.optsHelpBannerInputFiles() , inputFileFlagsFsi tcConfigB) - PublicOptions(FSComp.SR.optsHelpBannerResources() , resourcesFlagsFsi tcConfigB) - PublicOptions(FSComp.SR.optsHelpBannerCodeGen() , codeGenerationFlags true tcConfigB) - PublicOptions(FSComp.SR.optsHelpBannerErrsAndWarns() , errorsAndWarningsFlags tcConfigB) - PublicOptions(FSComp.SR.optsHelpBannerLanguage() , languageFlags tcConfigB) + [ PublicOptions(FSComp.SR.optsHelpBannerOutputFiles(), outputFileFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerInputFiles(), inputFileFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerResources(), resourcesFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerCodeGen(), codeGenerationFlags true tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerErrsAndWarns(), errorsAndWarningsFlags tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerLanguage(), languageFlags tcConfigB) // Note: no HTML block for fsi.exe - PublicOptions(FSComp.SR.optsHelpBannerMisc() , miscFlagsFsi tcConfigB) - PublicOptions(FSComp.SR.optsHelpBannerAdvanced() , advancedFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerMisc(), miscFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerAdvanced(), advancedFlagsFsi tcConfigB) PrivateOptions(List.concat [ internalFlags tcConfigB abbreviatedFlagsFsi tcConfigB deprecatedFlagsFsi tcConfigB diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index c6f418e9dbe..196edd054cf 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -355,8 +355,8 @@ type OptionalTrace = let res = f newTrace match predicate res, t with | false, _ -> newTrace.Undo() - | true , WithTrace t -> t.actions <- newTrace.actions @ t.actions - | true , NoTrace -> () + | true, WithTrace t -> t.actions <- newTrace.actions @ t.actions + | true, NoTrace -> () res let CollectThenUndo f = @@ -833,16 +833,16 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr | (TType_app (tc2, [ms]), _) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) -> SolveTypeEqualsType csenv ndeep m2 trace None ms (TType_measure Measure.One) - | TType_app (tc1, l1) , TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 - | TType_app (_, _) , TType_app (_, _) -> localAbortD - | TType_tuple (tupInfo1, l1) , TType_tuple (tupInfo2, l2) -> + | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + | TType_app (_, _), TType_app (_, _) -> localAbortD + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) else SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 | TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) -> SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 ++ (fun () -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2) - | TType_fun (d1, r1) , TType_fun (d2, r2) -> SolveFunTypeEqn csenv ndeep m2 trace None d1 d2 r1 r2 - | TType_measure ms1 , TType_measure ms2 -> UnifyMeasures csenv trace ms1 ms2 + | TType_fun (d1, r1), TType_fun (d2, r2) -> SolveFunTypeEqn csenv ndeep m2 trace None d1 d2 r1 r2 + | TType_measure ms1, TType_measure ms2 -> UnifyMeasures csenv trace ms1 ms2 | TType_forall(tps1, rty1), TType_forall(tps2, rty2) -> if tps1.Length <> tps2.Length then localAbortD else let aenv = aenv.BindEquivTypars tps1 tps2 @@ -850,7 +850,7 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr if not (typarsAEquiv g aenv tps1 tps2) then localAbortD else SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty1 rty2 - | TType_ucase (uc1, l1) , TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 | _ -> localAbortD @@ -911,13 +911,13 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional | _, TType_var r when not csenv.MatchingOnly -> SolveTyparSubtypeOfType csenv ndeep m2 trace r ty1 - | TType_tuple (tupInfo1, l1) , TType_tuple (tupInfo2, l2) -> + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) else SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 (* nb. can unify since no variance *) | TType_anon (anonInfo1, l1), TType_anon (anonInfo2, l2) -> SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 ++ (fun () -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2) (* nb. can unify since no variance *) - | TType_fun (d1, r1) , TType_fun (d2, r2) -> SolveFunTypeEqn csenv ndeep m2 trace cxsln d1 d2 r1 r2 (* nb. can unify since no variance *) + | TType_fun (d1, r1), TType_fun (d2, r2) -> SolveFunTypeEqn csenv ndeep m2 trace cxsln d1 d2 r1 r2 (* nb. can unify since no variance *) | TType_measure ms1, TType_measure ms2 -> UnifyMeasures csenv trace ms1 ms2 // Enforce the identities float=float<1>, float32=float32<1> and decimal=decimal<1> @@ -927,7 +927,7 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms (TType_measure Measure.One) // Special subsumption rule for byref tags - | TType_app (tc1, l1) , TType_app (tc2, l2) when tyconRefEq g tc1 tc2 && g.byref2_tcr.CanDeref && tyconRefEq g g.byref2_tcr tc1 -> + | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2 && g.byref2_tcr.CanDeref && tyconRefEq g g.byref2_tcr tc1 -> match l1, l2 with | [ h1; tag1 ], [ h2; tag2 ] -> trackErrors { do! SolveTypeEqualsType csenv ndeep m2 trace None h1 h2 @@ -939,10 +939,10 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional } | _ -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 - | TType_app (tc1, l1) , TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> + | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 - | TType_ucase (uc1, l1) , TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> + | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 | _ -> @@ -1680,7 +1680,7 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint } | TyparConstraint.SupportsComparison _, TyparConstraint.IsDelegate _ - | TyparConstraint.IsDelegate _ , TyparConstraint.SupportsComparison _ + | TyparConstraint.IsDelegate _, TyparConstraint.SupportsComparison _ | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _ | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _ -> ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m)) diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index 67f5f43d617..7272e33983f 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -113,9 +113,9 @@ open FSharp.Compiler.Lib // [[FORMAL: SameArg xi]] -> xi // [[FORMAL: NewArgs vs]] -> [ [v1] ... [vN] ] // list up individual args for Expr.Lambda // -// [[REBIND: xi , SameArg xi]] -> // no binding needed +// [[REBIND: xi, SameArg xi]] -> // no binding needed // [[REBIND: [u], NewArgs vs]] -> u = "rebuildTuple(cpi, vs)" -// [[REBIND: us , NewArgs vs]] -> "rebuildTuple(cpi, vs)" then bind us to buildProjections. // for Expr.Lambda +// [[REBIND: us, NewArgs vs]] -> "rebuildTuple(cpi, vs)" then bind us to buildProjections. // for Expr.Lambda // // rebuildTuple - create tuple based on vs fringe according to cpi tuple structure. // @@ -346,7 +346,7 @@ let rec ValReprInfoForTS ts = let rec andTS ts tsB = match ts, tsB with - | _ , UnknownTS -> UnknownTS + | _, UnknownTS -> UnknownTS | UnknownTS, _ -> UnknownTS | TupleTS ss, TupleTS ssB -> if ss.Length <> ssB.Length then UnknownTS (* different tuple instances *) @@ -378,9 +378,9 @@ let typeTS g tys = tys |> uncheckedTypeTS g |> checkTS let rebuildTS g m ts vs = let rec rebuild vs ts = match vs, ts with - | [] , UnknownTS -> internalError "rebuildTS: not enough fringe to build tuple" + | [], UnknownTS -> internalError "rebuildTS: not enough fringe to build tuple" | v::vs, UnknownTS -> (exprForVal m v, v.Type), vs - | vs , TupleTS tss -> + | vs, TupleTS tss -> let xtys, vs = List.mapFold rebuild vs tss let xs, tys = List.unzip xtys let x = mkRefTupled g m xs tys @@ -415,10 +415,10 @@ let rec minimalCallPattern callPattern = let commonCallPattern callPatterns = let rec andCPs cpA cpB = match cpA, cpB with - | [] , [] -> [] + | [], [] -> [] | tsA::tsAs, tsB::tsBs -> andTS tsA tsB :: andCPs tsAs tsBs | _tsA::_tsAs, [] -> [] (* now trim to shortest - UnknownTS :: andCPs tsAs [] *) - | [] , _tsB::_tsBs -> [] (* now trim to shortest - UnknownTS :: andCPs [] tsBs *) + | [], _tsB::_tsBs -> [] (* now trim to shortest - UnknownTS :: andCPs [] tsBs *) List.reduce andCPs callPatterns @@ -530,7 +530,7 @@ let decideFormalSuggestedCP g z tys vss = let rec trimTsByAccess accessors ts = match ts, accessors with - | UnknownTS , _ -> UnknownTS + | UnknownTS, _ -> UnknownTS | TupleTS _tss, [] -> UnknownTS (* trim it, require the val at this point *) | TupleTS tss, TupleGet (i, _ty)::accessors -> let tss = List.mapNth i (trimTsByAccess accessors) tss @@ -683,7 +683,7 @@ let rec collapseArg env bindings ts (x: Expr) = let m = x.Range let env = rangeE env m match ts, x with - | UnknownTS , x -> + | UnknownTS, x -> let bindings, vx = noEffectExpr env bindings x bindings, [vx] | TupleTS tss, Expr.Op(TOp.Tuple tupInfo, _xtys, xs, _) when not (evalTupInfoIsStruct tupInfo) -> @@ -700,7 +700,7 @@ let rec collapseArg env bindings ts (x: Expr) = and collapseArgs env bindings n (callPattern) args = match callPattern, args with - | [] , args -> bindings, args + | [], args -> bindings, args | ts::tss, arg::args -> let env1 = suffixE env (string n) let bindings, xty = collapseArg env1 bindings ts arg @@ -754,9 +754,9 @@ let transFormal ybi xi = let transRebind ybi xi = match xi, ybi with - | _ , SameArg -> [] (* no rebinding, reused original formal *) + | _, SameArg -> [] (* no rebinding, reused original formal *) | [u], NewArgs (_vs, x) -> [mkCompGenBind u x] - | us , NewArgs (_vs, x) -> List.map2 mkCompGenBind us (tryDestRefTupleExpr x) + | us, NewArgs (_vs, x) -> List.map2 mkCompGenBind us (tryDestRefTupleExpr x) //------------------------------------------------------------------------- diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index 16e83147d1b..9bf54e3be79 100755 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -1111,7 +1111,7 @@ module internal ExtensionTyping = /// Apply the given provided type to the given static arguments (the arguments are assumed to have been sorted into application order let TryApplyProvidedType(typeBeforeArguments: Tainted, optGeneratedTypePath: string list option, staticArgs: obj[], m: range) = if staticArgs.Length = 0 then - Some (typeBeforeArguments , (fun () -> ())) + Some (typeBeforeArguments, (fun () -> ())) else let fullTypePathAfterArguments = diff --git a/src/fsharp/FSharp.Build/Fsc.fs b/src/fsharp/FSharp.Build/Fsc.fs index d56dab90f0f..d1f0ea78d94 100644 --- a/src/fsharp/FSharp.Build/Fsc.fs +++ b/src/fsharp/FSharp.Build/Fsc.fs @@ -140,8 +140,8 @@ type public Fsc () as this = | "ANYCPU", true, "EXE" | "ANYCPU", true, "WINEXE" -> "anycpu32bitpreferred" | "ANYCPU", _, _ -> "anycpu" - | "X86" , _, _ -> "x86" - | "X64" , _, _ -> "x64" + | "X86", _, _ -> "x86" + | "X64", _, _ -> "x64" | _ -> null) // Resources if resources <> null then diff --git a/src/fsharp/FSharp.Core/Query.fs b/src/fsharp/FSharp.Core/Query.fs index fbab2547ed3..0f889072c7c 100644 --- a/src/fsharp/FSharp.Core/Query.fs +++ b/src/fsharp/FSharp.Core/Query.fs @@ -1341,7 +1341,7 @@ module Query = let source, sourceConv, v, keySelector = TransInnerApplicativeAndCommit check source (v, keySelector) TransInnerResult.Other(MakeTakeWhile (qTyIsIQueryable qTy, source, v, keySelector)), sourceConv - | CallGroupBy(_, [_; qTy; _] , immutSource, Lambda(immutVar, immutKeySelector)) -> + | CallGroupBy(_, [_; qTy; _], immutSource, Lambda(immutVar, immutKeySelector)) -> let mutSource, sourceConv = TransInnerAndCommit CanEliminate.Yes check immutSource let mutVar, mutKeySelector = ConvertImmutableConsumerToMutableConsumer sourceConv (immutVar, MacroExpand immutKeySelector) let conv = match sourceConv with NoConv -> NoConv | _ -> GroupingConv(immutKeySelector.Type,immutVar.Type,sourceConv) diff --git a/src/fsharp/FSharp.Core/array.fs b/src/fsharp/FSharp.Core/array.fs index 5531a690038..13c3353ca06 100644 --- a/src/fsharp/FSharp.Core/array.fs +++ b/src/fsharp/FSharp.Core/array.fs @@ -723,7 +723,7 @@ namespace Microsoft.FSharp.Collections res2.[i] <- res.[downCount] downCount <- downCount - 1 - res1 , res2 + res1, res2 [] let find predicate (array: _[]) = diff --git a/src/fsharp/FSharp.Core/array2.fs b/src/fsharp/FSharp.Core/array2.fs index 3ef0c9ff437..d24ccf795ac 100644 --- a/src/fsharp/FSharp.Core/array2.fs +++ b/src/fsharp/FSharp.Core/array2.fs @@ -139,9 +139,9 @@ namespace Microsoft.FSharp.Collections checkNonNull "source" source checkNonNull "target" target - let sourceX0, sourceY0 = source.GetLowerBound 0 , source.GetLowerBound 1 + let sourceX0, sourceY0 = source.GetLowerBound 0, source.GetLowerBound 1 let sourceXN, sourceYN = (length1 source) + sourceX0, (length2 source) + sourceY0 - let targetX0, targetY0 = target.GetLowerBound 0 , target.GetLowerBound 1 + let targetX0, targetY0 = target.GetLowerBound 0, target.GetLowerBound 1 let targetXN, targetYN = (length1 target) + targetX0, (length2 target) + targetY0 if sourceIndex1 < sourceX0 then invalidArgOutOfRange "sourceIndex1" sourceIndex1 "source axis-0 lower bound" sourceX0 diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 7ef250a0ee9..9b2fbc9d832 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -478,8 +478,10 @@ namespace Microsoft.FSharp.Collections [] member internal m.Comparer = comparer + //[] member internal m.Tree = tree + member m.Add(key,value) : Map<'Key,'Value> = #if TRACE_SETS_AND_MAPS MapTree.report() @@ -494,6 +496,7 @@ namespace Microsoft.FSharp.Collections [] member m.IsEmpty = MapTree.isEmpty tree + member m.Item with get(key : 'Key) = #if TRACE_SETS_AND_MAPS @@ -502,19 +505,24 @@ namespace Microsoft.FSharp.Collections MapTree.totalSizeOnMapLookup <- MapTree.totalSizeOnMapLookup + float (MapTree.size tree) #endif MapTree.find comparer key tree + member m.TryPick(f) = MapTree.tryPick f tree + member m.Exists(f) = MapTree.exists f tree - member m.Filter(f) : Map<'Key,'Value> = new Map<'Key,'Value>(comparer ,MapTree.filter comparer f tree) + + member m.Filter(f) : Map<'Key,'Value> = new Map<'Key,'Value>(comparer,MapTree.filter comparer f tree) + member m.ForAll(f) = MapTree.forall f tree + member m.Fold f acc = MapTree.foldBack f tree acc member m.FoldSection (lo:'Key) (hi:'Key) f (acc:'z) = MapTree.foldSection comparer lo hi f tree acc member m.Iterate f = MapTree.iter f tree - member m.MapRange f = new Map<'Key,'b>(comparer,MapTree.map f tree) + member m.MapRange f = new Map<'Key,'b>(comparer,MapTree.map f tree) - member m.Map f = new Map<'Key,'b>(comparer,MapTree.mapi f tree) + member m.Map f = new Map<'Key,'b>(comparer,MapTree.mapi f tree) member m.Partition(f) : Map<'Key,'Value> * Map<'Key,'Value> = let r1,r2 = MapTree.partition comparer f tree in @@ -530,7 +538,7 @@ namespace Microsoft.FSharp.Collections #endif MapTree.mem comparer key tree - member m.Remove(key) : Map<'Key,'Value> = + member m.Remove(key) : Map<'Key,'Value> = new Map<'Key,'Value>(comparer,MapTree.remove comparer key tree) member m.TryGetValue(key, [] value:byref<'Value>) = diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 7929ef77581..7bdf69c2924 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -822,25 +822,33 @@ namespace Microsoft.FSharp.Core /// Implements generic comparison between two objects. This corresponds to the pseudo-code in the F# /// specification. The treatment of NaNs is governed by "comp". let rec GenericCompare (comp:GenericComparer) (xobj:obj,yobj:obj) = - (*if objEq xobj yobj then 0 else *) match xobj,yobj with | null,null -> 0 | null,_ -> -1 | _,null -> 1 + // Use Ordinal comparison for strings - | (:? string as x),(:? string as y) -> System.String.CompareOrdinal(x, y) + | (:? string as x),(:? string as y) -> + System.String.CompareOrdinal(x, y) + // Permit structural comparison on arrays | (:? System.Array as arr1),_ -> match arr1,yobj with // Fast path - | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericComparisonObjArrayWithComparer comp arr1 arr2 + | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> + GenericComparisonObjArrayWithComparer comp arr1 arr2 // Fast path - | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericComparisonByteArray arr1 arr2 - | _ , (:? System.Array as arr2) -> GenericComparisonArbArrayWithComparer comp arr1 arr2 - | _ -> FailGenericComparison xobj + | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> + GenericComparisonByteArray arr1 arr2 + | _, (:? System.Array as arr2) -> + GenericComparisonArbArrayWithComparer comp arr1 arr2 + | _ -> + FailGenericComparison xobj + // Check for IStructuralComparable | (:? IStructuralComparable as x),_ -> x.CompareTo(yobj,comp) + // Check for IComparable | (:? System.IComparable as x),_ -> if comp.ThrowsOnPER then @@ -853,15 +861,22 @@ namespace Microsoft.FSharp.Core raise NaNException | _ -> () x.CompareTo(yobj) - | (:? nativeint as x),(:? nativeint as y) -> if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #) - | (:? unativeint as x),(:? unativeint as y) -> if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) + + | (:? nativeint as x),(:? nativeint as y) -> + if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #) + + | (:? unativeint as x),(:? unativeint as y) -> + if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) + | _,(:? IStructuralComparable as yc) -> let res = yc.CompareTo(xobj,comp) if res < 0 then 1 elif res > 0 then -1 else 0 + | _,(:? System.IComparable as yc) -> // Note -c doesn't work here: be careful of comparison function returning minint - let c = yc.CompareTo(xobj) in + let c = yc.CompareTo(xobj) if c < 0 then 1 elif c > 0 then -1 else 0 + | _ -> FailGenericComparison xobj /// specialcase: Core implementation of structural comparison on arbitrary arrays. @@ -1090,7 +1105,7 @@ namespace Microsoft.FSharp.Core when 'T : string = // NOTE: we don't have to null check here because System.String.CompareOrdinal // gives reliable results on null values. - System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #)) + System.String.CompareOrdinal((# "" x : string #),(# "" y : string #)) when 'T : decimal = System.Decimal.Compare((# "" x:decimal #), (# "" y:decimal #)) @@ -1168,7 +1183,7 @@ namespace Microsoft.FSharp.Core when 'T : string = // NOTE: we don't have to null check here because System.String.CompareOrdinal // gives reliable results on null values. - System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #)) + System.String.CompareOrdinal((# "" x : string #),(# "" y : string #)) when 'T : decimal = System.Decimal.Compare((# "" x:decimal #), (# "" y:decimal #)) /// Generic less-than with static optimizations for some well-known cases. @@ -1374,7 +1389,7 @@ namespace Microsoft.FSharp.Core | (:? (char[]) as arr1), (:? (char[]) as arr2) -> GenericEqualityCharArray arr1 arr2 | (:? (float32[]) as arr1), (:? (float32[]) as arr2) -> GenericEqualitySingleArray er arr1 arr2 | (:? (float[]) as arr1), (:? (float[]) as arr2) -> GenericEqualityDoubleArray er arr1 arr2 - | _ , (:? System.Array as arr2) -> GenericEqualityArbArray er iec arr1 arr2 + | _, (:? System.Array as arr2) -> GenericEqualityArbArray er iec arr1 arr2 | _ -> xobj.Equals(yobj) | (:? IStructuralEquatable as x1),_ -> x1.Equals(yobj,iec) // Ensure ER NaN semantics on recursive calls @@ -4066,7 +4081,7 @@ namespace Microsoft.FSharp.Core when ^T : float32= (# "clt" x y : bool #) when ^T : char = (# "clt" x y : bool #) when ^T : decimal = System.Decimal.op_LessThan ((# "" x:decimal #), (# "" y:decimal #)) - when ^T : string = (# "clt" (System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #))) 0 : bool #) + when ^T : string = (# "clt" (System.String.CompareOrdinal((# "" x : string #),(# "" y : string #))) 0 : bool #) /// Static greater-than with static optimizations for some well-known cases. let inline (>) (x:^T) (y:^U) = @@ -4086,7 +4101,7 @@ namespace Microsoft.FSharp.Core when 'T : float32 = (# "cgt" x y : bool #) when 'T : char = (# "cgt" x y : bool #) when 'T : decimal = System.Decimal.op_GreaterThan ((# "" x:decimal #), (# "" y:decimal #)) - when ^T : string = (# "cgt" (System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #))) 0 : bool #) + when ^T : string = (# "cgt" (System.String.CompareOrdinal((# "" x : string #),(# "" y : string #))) 0 : bool #) /// Static less-than-or-equal with static optimizations for some well-known cases. let inline (<=) (x:^T) (y:^U) = @@ -4106,7 +4121,7 @@ namespace Microsoft.FSharp.Core when 'T : float32 = not (# "cgt.un" x y : bool #) when 'T : char = not (# "cgt" x y : bool #) when 'T : decimal = System.Decimal.op_LessThanOrEqual ((# "" x:decimal #), (# "" y:decimal #)) - when ^T : string = not (# "cgt" (System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #))) 0 : bool #) + when ^T : string = not (# "cgt" (System.String.CompareOrdinal((# "" x : string #),(# "" y : string #))) 0 : bool #) /// Static greater-than-or-equal with static optimizations for some well-known cases. let inline (>=) (x:^T) (y:^U) = @@ -4126,7 +4141,7 @@ namespace Microsoft.FSharp.Core when 'T : float32 = not (# "clt.un" x y : bool #) when 'T : char = not (# "clt" x y : bool #) when 'T : decimal = System.Decimal.op_GreaterThanOrEqual ((# "" x:decimal #), (# "" y:decimal #)) - when ^T : string = not (# "clt" (System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #))) 0 : bool #) + when ^T : string = not (# "clt" (System.String.CompareOrdinal((# "" x : string #),(# "" y : string #))) 0 : bool #) /// Static greater-than-or-equal with static optimizations for some well-known cases. @@ -4198,7 +4213,7 @@ namespace Microsoft.FSharp.Core when ^T : string = // NOTE: we don't have to null check here because System.String.CompareOrdinal // gives reliable results on null values. - System.String.CompareOrdinal((# "" e1 : string #) ,(# "" e2 : string #)) + System.String.CompareOrdinal((# "" e1 : string #),(# "" e2 : string #)) when ^T : decimal = System.Decimal.Compare((# "" e1:decimal #), (# "" e2:decimal #)) [] @@ -5018,7 +5033,7 @@ namespace Microsoft.FSharp.Core let inline ComputeSlice bound start finish length = match start, finish with | None, None -> bound, bound + length - 1 - | None, Some n when n >= bound -> bound , n + | None, Some n when n >= bound -> bound, n | Some m, None when m <= bound + length -> m, bound + length - 1 | Some m, Some n -> m, n | _ -> raise (System.IndexOutOfRangeException()) diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index a62b9d18783..c977af45417 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -732,7 +732,7 @@ namespace Microsoft.FSharp.Core /// /// When applied to a module within an assembly, then the attribute must not be given any arguments. /// When the enclosing namespace is opened in user source code, the module is also implicitly opened. - [] + [] [] type AutoOpenAttribute = inherit Attribute diff --git a/src/fsharp/FSharp.Core/printf.fs b/src/fsharp/FSharp.Core/printf.fs index 535d87d491b..0c2d6b70316 100644 --- a/src/fsharp/FSharp.Core/printf.fs +++ b/src/fsharp/FSharp.Core/printf.fs @@ -195,7 +195,7 @@ module internal PrintfImpl = Utils.Write(env, g, h) static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i) = Utils.Write(env, a, b, c, d, e, f, g) - Utils.Write(env, h ,i) + Utils.Write(env, h, i) static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i, j) = Utils.Write(env, a, b, c, d, e, f, g, h) Utils.Write(env, i, j) @@ -1283,7 +1283,7 @@ module internal PrintfImpl = let args = [| box prefix; tail |] mi.Invoke(null, args) else - System.Diagnostics.Debug.Assert(spec.IsStarPrecision || spec.IsStarWidth , "spec.IsStarPrecision || spec.IsStarWidth ") + System.Diagnostics.Debug.Assert(spec.IsStarPrecision || spec.IsStarWidth, "spec.IsStarPrecision || spec.IsStarWidth ") let mi = let n = if spec.IsStarWidth = spec.IsStarPrecision then 2 else 1 @@ -1321,7 +1321,7 @@ module internal PrintfImpl = let args = [| box prefix; box suffix |] mi.Invoke(null, args) else - System.Diagnostics.Debug.Assert(spec.IsStarPrecision || spec.IsStarWidth , "spec.IsStarPrecision || spec.IsStarWidth ") + System.Diagnostics.Debug.Assert(spec.IsStarPrecision || spec.IsStarWidth, "spec.IsStarPrecision || spec.IsStarWidth ") let mi = let n = if spec.IsStarWidth = spec.IsStarPrecision then 2 else 1 diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index 6198357fa08..7af4a9f7956 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -622,8 +622,8 @@ module Patterns = | InstancePropGetOp prop,_ -> prop.PropertyType | StaticPropSetOp _,_ -> typeof | InstancePropSetOp _,_ -> typeof - | InstanceFieldGetOp fld ,_ -> fld.FieldType - | StaticFieldGetOp fld ,_ -> fld.FieldType + | InstanceFieldGetOp fld,_ -> fld.FieldType + | StaticFieldGetOp fld,_ -> fld.FieldType | InstanceFieldSetOp _,_ -> typeof | StaticFieldSetOp _,_ -> typeof | NewObjectOp ctor,_ -> ctor.DeclaringType @@ -1429,7 +1429,7 @@ module Patterns = (fun env -> let v = a env in E(LambdaTerm(v,b (addVar env v)))) | 3 -> let a = u_dtype st let idx = u_int st - (fun env -> E(HoleTerm(a env.typeInst , idx))) + (fun env -> E(HoleTerm(a env.typeInst, idx))) | 4 -> let a = u_Expr st (fun env -> mkQuote(a env, true)) | 5 -> let a = u_Expr st diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index ea8f1bfdf70..f0d9c2854c2 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -265,7 +265,7 @@ module internal Impl = if isOptionType typ then match tag with | 0 (* None *) -> getInstancePropertyInfos (typ,[| |],bindingFlags) - | 1 (* Some *) -> getInstancePropertyInfos (typ,[| "Value" |] ,bindingFlags) + | 1 (* Some *) -> getInstancePropertyInfos (typ,[| "Value" |],bindingFlags) | _ -> failwith "fieldsPropsOfUnionCase" elif isListType typ then match tag with @@ -737,12 +737,12 @@ type FSharpType = static member IsUnion(typ:Type,?bindingFlags) = let bindingFlags = defaultArg bindingFlags BindingFlags.Public Impl.checkNonNull "typ" typ - let typ = Impl.getTypeOfReprType (typ ,BindingFlags.Public ||| BindingFlags.NonPublic) + let typ = Impl.getTypeOfReprType (typ,BindingFlags.Public ||| BindingFlags.NonPublic) Impl.isUnionType (typ,bindingFlags) static member IsFunction(typ:Type) = Impl.checkNonNull "typ" typ - let typ = Impl.getTypeOfReprType (typ ,BindingFlags.Public ||| BindingFlags.NonPublic) + let typ = Impl.getTypeOfReprType (typ,BindingFlags.Public ||| BindingFlags.NonPublic) Impl.isFunctionType typ static member IsModule(typ:Type) = @@ -781,7 +781,7 @@ type FSharpType = static member GetFunctionElements(functionType:Type) = Impl.checkNonNull "functionType" functionType - let functionType = Impl.getTypeOfReprType (functionType ,BindingFlags.Public ||| BindingFlags.NonPublic) + let functionType = Impl.getTypeOfReprType (functionType,BindingFlags.Public ||| BindingFlags.NonPublic) Impl.getFunctionTypeInfo functionType static member GetRecordFields(recordType:Type,?bindingFlags) = @@ -792,7 +792,7 @@ type FSharpType = static member GetUnionCases (unionType:Type,?bindingFlags) = let bindingFlags = defaultArg bindingFlags BindingFlags.Public Impl.checkNonNull "unionType" unionType - let unionType = Impl.getTypeOfReprType (unionType ,bindingFlags) + let unionType = Impl.getTypeOfReprType (unionType,bindingFlags) Impl.checkUnionType(unionType,bindingFlags); Impl.getUnionTypeTagNameMap(unionType,bindingFlags) |> Array.mapi (fun i _ -> UnionCaseInfo(unionType,i)) @@ -927,7 +927,7 @@ type FSharpValue = let unionType = ensureType(unionType,value) Impl.checkNonNull "unionType" unionType - let unionType = Impl.getTypeOfReprType (unionType ,bindingFlags) + let unionType = Impl.getTypeOfReprType (unionType,bindingFlags) Impl.checkUnionType(unionType,bindingFlags) let tag = Impl.getUnionTagReader (unionType,bindingFlags) value @@ -937,16 +937,16 @@ type FSharpValue = static member PreComputeUnionTagReader(unionType: Type,?bindingFlags) : (obj -> int) = let bindingFlags = defaultArg bindingFlags BindingFlags.Public Impl.checkNonNull "unionType" unionType - let unionType = Impl.getTypeOfReprType (unionType ,bindingFlags) + let unionType = Impl.getTypeOfReprType (unionType,bindingFlags) Impl.checkUnionType(unionType,bindingFlags) - Impl.getUnionTagReader (unionType ,bindingFlags) + Impl.getUnionTagReader (unionType,bindingFlags) static member PreComputeUnionTagMemberInfo(unionType: Type,?bindingFlags) = let bindingFlags = defaultArg bindingFlags BindingFlags.Public Impl.checkNonNull "unionType" unionType; - let unionType = Impl.getTypeOfReprType (unionType ,bindingFlags) + let unionType = Impl.getTypeOfReprType (unionType,bindingFlags) Impl.checkUnionType(unionType,bindingFlags) - Impl.getUnionTagMemberInfo(unionType ,bindingFlags) + Impl.getUnionTagMemberInfo(unionType,bindingFlags) static member PreComputeUnionReader(unionCase: UnionCaseInfo,?bindingFlags) : (obj -> obj[]) = let bindingFlags = defaultArg bindingFlags BindingFlags.Public diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index 85c04a2c241..394bc4963de 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -173,7 +173,7 @@ namespace Microsoft.FSharp.Collections let rec split (comparer: IComparer<'T>) pivot t = // Given a pivot and a set t - // Return { x in t s.t. x < pivot }, pivot in t? , { x in t s.t. x > pivot } + // Return { x in t s.t. x < pivot }, pivot in t?, { x in t s.t. x > pivot } match t with | SetNode(k1,t11,t12,_) -> let c = comparer.Compare(pivot,k1) @@ -187,8 +187,8 @@ namespace Microsoft.FSharp.Collections balance comparer t11 k1 t12Lo,havePivot,t12Hi | SetOne k1 -> let c = comparer.Compare(k1,pivot) - if c < 0 then t ,false,SetEmpty // singleton under pivot - elif c = 0 then SetEmpty,true ,SetEmpty // singleton is pivot + if c < 0 then t,false,SetEmpty // singleton under pivot + elif c = 0 then SetEmpty,true,SetEmpty // singleton is pivot else SetEmpty,false,t // singleton over pivot | SetEmpty -> SetEmpty,false,SetEmpty @@ -446,7 +446,7 @@ namespace Microsoft.FSharp.Collections match l1,l2 with | [],[] -> 0 | [],_ -> -1 - | _ ,[] -> 1 + | _,[] -> 1 | (SetEmpty _ :: t1),(SetEmpty :: t2) -> compareStacks comparer t1 t2 | (SetOne(n1k) :: t1),(SetOne(n2k) :: t2) -> let c = comparer.Compare(n1k,n2k) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 011fd9e5932..b361a297500 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. //-------------------------------------------------------------------------- // The ILX generator. @@ -84,7 +84,7 @@ let ChooseParamNames fieldNamesAndTypes = /// Approximation for purposes of optimization and giving a warning when compiling definition-only files as EXEs let rec CheckCodeDoesSomething (code: ILCode) = - code.Instrs |> Array.exists (function AI_ldnull | AI_nop | AI_pop | I_ret | I_seqpoint _ -> false | _ -> true) + code.Instrs |> Array.exists (function AI_ldnull | AI_nop | AI_pop | I_ret | I_seqpoint _ -> false | _ -> true) /// Choose the field names for variables captured by closures let ChooseFreeVarNames takenNames ts = @@ -92,22 +92,22 @@ let ChooseFreeVarNames takenNames ts = let rec chooseName names (t, nOpt) = let tn = match nOpt with None -> t | Some n -> t + string n if Zset.contains tn names then - chooseName names (t, Some(match nOpt with None -> 0 | Some n -> (n+1))) + chooseName names (t, Some(match nOpt with None -> 0 | Some n -> (n+1))) else let names = Zset.add tn names tn, names - let names = Zset.empty String.order |> Zset.addList takenNames + let names = Zset.empty String.order |> Zset.addList takenNames let ts, _names = List.mapFold chooseName names tns ts /// +++GLOBAL STATE: a name generator used by IlxGen for static fields, some generated arguments and other things. -/// REVIEW: this will mean the hosted compiler service is not deterministic. We should at least create a new one +/// REVIEW: this will mean the hosted compiler service is not deterministic. We should at least create a new one /// of these for each compilation. let ilxgenGlobalNng = NiceNameGenerator () /// We can't tailcall to methods taking byrefs. This helper helps search for them -let IsILTypeByref = function ILType.Byref _ -> true | _ -> false +let IsILTypeByref = function ILType.Byref _ -> true | _ -> false let mainMethName = CompilerGeneratedName "main" @@ -118,15 +118,15 @@ type AttributeDecoder (namedArgs) = 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 + member __.FindInt16 x dflt = match findConst x with | Some(Const.Int16 x) -> x | _ -> dflt - member __.FindInt32 x dflt = match findConst x with | Some(Const.Int32 x) -> x | _ -> dflt + member __.FindInt32 x dflt = match findConst x with | Some(Const.Int32 x) -> x | _ -> dflt - member __.FindBool x dflt = match findConst x with | Some(Const.Bool x) -> x | _ -> dflt + member __.FindBool x dflt = match findConst x with | Some(Const.Bool x) -> x | _ -> dflt 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 @@ -229,7 +229,7 @@ type cenv = /// The ImportMap for reading IL amap: ImportMap - /// A callback for TcVal in the typechecker. Used to generalize values when finding witnesses. + /// A callback for TcVal in the typechecker. Used to generalize values when finding witnesses. /// It is unfortunate this is needed but it is until we supply witnesses through the compiation. TcVal: ConstraintSolver.TcValF @@ -254,7 +254,7 @@ type cenv = let mkTypeOfExpr cenv m ilty = - mkAsmExpr ([ mkNormalCall (mspec_Type_GetTypeFromHandle cenv.g) ], [], + mkAsmExpr ([ mkNormalCall (mspec_Type_GetTypeFromHandle cenv.g) ], [], [mkAsmExpr ([ I_ldtoken (ILToken.ILType ilty) ], [], [], [cenv.g.system_RuntimeTypeHandle_ty], m)], [cenv.g.system_Type_ty], m) @@ -294,7 +294,7 @@ let CompLocForFragment fragName (ccu: CcuThunk) = Namespace = None Enclosing = []} -let CompLocForCcu (ccu: CcuThunk) = CompLocForFragment ccu.AssemblyName ccu +let CompLocForCcu (ccu: CcuThunk) = CompLocForFragment ccu.AssemblyName ccu let CompLocForSubModuleOrNamespace cloc (submod: ModuleOrNamespace) = let n = submod.CompiledName @@ -306,7 +306,7 @@ let CompLocForFixedPath fragName qname (CompPath(sref, cpath)) = let ns, t = List.takeUntil (fun (_, mkind) -> mkind <> Namespace) cpath let ns = List.map fst ns let ns = textOfPath ns - let encl = t |> List.map (fun (s , _)-> s) + let encl = t |> List.map (fun (s, _)-> s) let ns = if ns = "" then None else Some ns { QualifiedNameOfFile = fragName TopImplQualifiedName = qname @@ -352,7 +352,7 @@ let CompLocForPrivateImplementationDetails cloc = Enclosing=[TypeNameForPrivateImplementationDetails cloc]; Namespace=None} /// Compute an ILTypeRef for a CompilationLocation -let rec TypeRefForCompLoc cloc = +let rec TypeRefForCompLoc cloc = match cloc.Enclosing with | [] -> mkILTyRef(cloc.Scope, TypeNameForPrivateImplementationDetails cloc) @@ -392,7 +392,7 @@ type TypeReprEnv(reprs: Map, count: int) = // Random value for post-hoc diagnostic analysis on generated tree * uint16 666 - /// Add an additional type parameter to the environment. If the parameter is a units-of-measure parameter + /// Add an additional type parameter to the environment. If the parameter is a units-of-measure parameter /// then it is ignored, since it doesn't corespond to a .NET type parameter. member tyenv.AddOne (tp: Typar) = if IsNonErasedTypar tp then @@ -470,7 +470,7 @@ let GenReadOnlyModReqIfNecessary (g: TcGlobals) ty ilTy = let rec GenTypeArgAux amap m tyenv tyarg = GenTypeAux amap m tyenv VoidNotOK PtrTypesNotOK tyarg -and GenTypeArgsAux amap m tyenv tyargs = +and GenTypeArgsAux amap m tyenv tyargs = List.map (GenTypeArgAux amap m tyenv) (DropErasedTyargs tyargs) and GenTyAppAux amap m tyenv repr tinst = @@ -520,7 +520,7 @@ and GenTypeAux amap m (tyenv: TypeReprEnv) voidOK ptrsOK ty = | TType_tuple (tupInfo, args) -> GenTypeAux amap m tyenv VoidNotOK ptrsOK (mkCompiledTupleTy g (evalTupInfoIsStruct tupInfo) args) - | TType_fun (dty, returnTy) -> EraseClosures.mkILFuncTy g.ilxPubCloEnv (GenTypeArgAux amap m tyenv dty) (GenTypeArgAux amap m tyenv returnTy) + | TType_fun (dty, returnTy) -> EraseClosures.mkILFuncTy g.ilxPubCloEnv (GenTypeArgAux amap m tyenv dty) (GenTypeArgAux amap m tyenv returnTy) | TType_anon (anonInfo, tinst) -> let tref = anonInfo.ILTypeRef @@ -583,7 +583,7 @@ and ComputeUnionHasHelpers g (tcref: TyconRef) = match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with | Some(Attrib(_, _, [ AttribBoolArg (b) ], _, _, _, _)) -> if b then AllHelpers else NoHelpers - | Some (Attrib(_, _, _, _, _, _, m)) -> + | Some (Attrib(_, _, _, _, _, _, m)) -> errorR(Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded(), m)) AllHelpers | _ -> @@ -735,14 +735,14 @@ type ValStorage = | Null /// Indicates the value is stored in a static field. - | StaticField of ILFieldSpec * ValRef * (*hasLiteralAttr:*)bool * ILType * string * ILType * ILMethodRef * ILMethodRef * OptionalShadowLocal + | StaticField of ILFieldSpec * ValRef * (*hasLiteralAttr:*)bool * ILType * string * ILType * ILMethodRef * ILMethodRef * OptionalShadowLocal /// Indicates the value is "stored" as a property that recomputes it each time it is referenced. Used for simple constants that do not cause initialization triggers - | StaticProperty of ILMethodSpec * OptionalShadowLocal + | StaticProperty of ILMethodSpec * OptionalShadowLocal /// Indicates the value is "stored" as a IL static method (in a "main" class for a F# /// compilation unit, or as a member) according to its inferred or specified arity. - | Method of ValReprInfo * ValRef * ILMethodSpec * Range.range * ArgReprInfo list * TType list * ArgReprInfo + | Method of ValReprInfo * ValRef * ILMethodSpec * Range.range * ArgReprInfo list * TType list * ArgReprInfo /// Indicates the value is stored at the given position in the closure environment accessed via "ldarg 0" | Env of ILType * int * ILFieldSpec * NamedLocalIlxClosureInfo ref option @@ -759,7 +759,7 @@ and OptionalShadowLocal = | NoShadowLocal | ShadowLocal of ValStorage -/// The representation of a NamedLocalClosure is based on a cloinfo. However we can't generate a cloinfo until we've +/// The representation of a NamedLocalClosure is based on a cloinfo. However we can't generate a cloinfo until we've /// decided the representations of other items in the recursive set. Hence we use two phases to decide representations in /// a recursive set. Yuck. and NamedLocalIlxClosureInfo = @@ -778,7 +778,7 @@ and ModuleStorage = and BranchCallItem = | BranchCallClosure of ArityInfo | BranchCallMethod of - // Argument counts for compiled form of F# method or value + // Argument counts for compiled form of F# method or value ArityInfo * // Arg infos for compiled form of F# method or value (TType * ArgReprInfo) list list * @@ -814,11 +814,11 @@ and IlxGenEnv = /// All values in scope valsInScope: ValMap> - /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. + /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. /// REVIEW: generalize to arbitrary nested local loops?? innerVals: (ValRef * (BranchCallItem * Mark)) list - /// Full list of enclosing bound values. First non-compiler-generated element is used to help give nice names for closures and other expressions. + /// Full list of enclosing bound values. First non-compiler-generated element is used to help give nice names for closures and other expressions. letBoundVars: ValRef list /// The set of IL local variable indexes currently in use by lexically scoped variables, to allow reuse on different branches. @@ -831,7 +831,7 @@ and IlxGenEnv = let ReplaceTyenv tyenv (eenv: IlxGenEnv) = {eenv with tyenv = tyenv } -let EnvForTypars tps eenv = {eenv with tyenv = TypeReprEnv.ForTypars tps } +let EnvForTypars tps eenv = {eenv with tyenv = TypeReprEnv.ForTypars tps } let AddTyparsToEnv typars (eenv: IlxGenEnv) = {eenv with tyenv = eenv.tyenv.Add typars} @@ -840,7 +840,7 @@ let AddSignatureRemapInfo _msg (rpi, mhi) eenv = let OutputStorage (pps: TextWriter) s = match s with - | StaticField _ -> pps.Write "(top)" + | StaticField _ -> pps.Write "(top)" | StaticProperty _ -> pps.Write "(top)" | Method _ -> pps.Write "(top)" | Local _ -> pps.Write "(local)" @@ -864,7 +864,7 @@ let AddStorageForVal (g: TcGlobals) (v, s) eenv = if g.compilingFslib then // Passing an empty remap is sufficient for FSharp.Core.dll because it turns out the remapped type signature can // still be resolved. - match tryRescopeVal g.fslibCcu Remap.Empty v with + match tryRescopeVal g.fslibCcu Remap.Empty v with | ValueNone -> eenv | ValueSome vref -> match vref.TryDeref with @@ -940,7 +940,7 @@ let GetMethodSpecForMemberVal amap g (memberInfo: ValMemberInfo) (vref: ValRef) (fun gtp ty2 -> if not (typeEquiv g (mkTyparTy gtp) ty2) then warning(InternalError("CodeGen check: type checking did not quantify the correct type variables for this method: generalization list contained " - + gtp.Name + "#" + string gtp.Stamp + " and list from 'this' pointer contained " + (showL(typeL ty2)), m))) + + gtp.Name + "#" + string gtp.Stamp + " and list from 'this' pointer contained " + (showL(typeL ty2)), m))) ctps thisArgTys let methodArgTys, paramInfos = List.unzip flatArgInfos @@ -1017,7 +1017,7 @@ let IsFSharpValCompiledAsMethod g (v: Val) = | None -> false | Some topValInfo -> not (isUnitTy g v.Type && not v.IsMemberOrModuleBinding && not v.IsMutable) && - not v.IsCompiledAsStaticPropertyWithoutField && + not v.IsCompiledAsStaticPropertyWithoutField && match GetTopValTypeInFSharpForm g topValInfo v.Type v.Range with | [], [], _, _ when not v.IsMember -> false | _ -> true @@ -1025,11 +1025,11 @@ let IsFSharpValCompiledAsMethod g (v: Val) = /// Determine how a top level value is represented, when it is being represented /// as a method. This depends on its type and other representation inforrmation. /// If it's a function or is polymorphic, then it gets represented as a -/// method (possibly and instance method). Otherwise it gets represented as a +/// method (possibly and instance method). Otherwise it gets represented as a /// static field and property. let ComputeStorageForTopVal (amap, g, optIntraAssemblyInfo: IlxGenIntraAssemblyInfo option, isInteractive, optShadowLocal, vref: ValRef, cloc) = - if isUnitTy g vref.Type && not vref.IsMemberOrModuleBinding && not vref.IsMutable then + if isUnitTy g vref.Type && not vref.IsMemberOrModuleBinding && not vref.IsMutable then Null else let topValInfo = @@ -1065,7 +1065,7 @@ let ComputeStorageForTopVal (amap, g, optIntraAssemblyInfo: IlxGenIntraAssemblyI ComputeStorageForFSharpFunctionOrFSharpExtensionMember amap g cloc topValInfo vref m /// Determine how an F#-declared value, function or member is represented, if it is in the assembly being compiled. -let ComputeAndAddStorageForLocalTopVal (amap, g, intraAssemblyFieldTable, isInteractive, optShadowLocal) cloc (v: Val) eenv = +let ComputeAndAddStorageForLocalTopVal (amap, g, intraAssemblyFieldTable, isInteractive, optShadowLocal) cloc (v: Val) eenv = let storage = ComputeStorageForTopVal (amap, g, Some intraAssemblyFieldTable, isInteractive, optShadowLocal, mkLocalValRef v, cloc) AddStorageForVal g (v, notlazy storage) eenv @@ -1076,7 +1076,7 @@ let ComputeStorageForNonLocalTopVal amap g cloc modref (v: Val) = | Some _ -> ComputeStorageForTopVal (amap, g, None, false, NoShadowLocal, mkNestedValRef modref v, cloc) /// Determine how all the F#-decalred top level values, functions and members are represented, for an external module or namespace. -let rec AddStorageForNonLocalModuleOrNamespaceRef amap g cloc acc (modref: ModuleOrNamespaceRef) (modul: ModuleOrNamespace) = +let rec AddStorageForNonLocalModuleOrNamespaceRef amap g cloc acc (modref: ModuleOrNamespaceRef) (modul: ModuleOrNamespace) = let acc = (acc, modul.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions) ||> List.fold (fun acc smodul -> AddStorageForNonLocalModuleOrNamespaceRef amap g (CompLocForSubModuleOrNamespace cloc smodul) acc (modref.NestedTyconRef smodul) smodul) @@ -1094,7 +1094,7 @@ let AddStorageForExternalCcu amap g eenv (ccu: CcuThunk) = List.foldBack (fun smodul acc -> let cloc = CompLocForSubModuleOrNamespace cloc smodul - let modref = mkNonLocalCcuRootEntityRef ccu smodul + let modref = mkNonLocalCcuRootEntityRef ccu smodul AddStorageForNonLocalModuleOrNamespaceRef amap g cloc acc modref smodul) ccu.RootModulesAndNamespaces eenv @@ -1115,7 +1115,7 @@ let AddExternalCcusToIlxGenEnv amap g eenv ccus = List.fold (AddStorageForExternalCcu amap g) eenv ccus /// Record how all the unrealized abstract slots are represented, for a type definition. -let AddBindingsForTycon allocVal (cloc: CompileLocation) (tycon: Tycon) eenv = +let AddBindingsForTycon allocVal (cloc: CompileLocation) (tycon: Tycon) eenv = let unrealizedSlots = if tycon.IsFSharpObjectModelTycon then tycon.FSharpObjectModelTypeInfo.fsobjmodel_vslots @@ -1123,7 +1123,7 @@ let AddBindingsForTycon allocVal (cloc: CompileLocation) (tycon: Tycon) eenv = (eenv, unrealizedSlots) ||> List.fold (fun eenv vref -> allocVal cloc vref.Deref eenv) /// Record how constructs are represented, for a sequence of definitions in a module or namespace fragment. -let rec AddBindingsForModuleDefs allocVal (cloc: CompileLocation) eenv mdefs = +let rec AddBindingsForModuleDefs allocVal (cloc: CompileLocation) eenv mdefs = List.fold (AddBindingsForModuleDef allocVal cloc) eenv mdefs /// Record how constructs are represented, for a module or namespace fragment definition. @@ -1139,9 +1139,9 @@ and AddBindingsForModuleDef allocVal cloc eenv x = | TMDefDo _ -> eenv | TMAbstract(ModuleOrNamespaceExprWithSig(mtyp, _, _)) -> - AddBindingsForLocalModuleType allocVal cloc eenv mtyp + AddBindingsForLocalModuleType allocVal cloc eenv mtyp | TMDefs(mdefs) -> - AddBindingsForModuleDefs allocVal cloc eenv mdefs + AddBindingsForModuleDefs allocVal cloc eenv mdefs /// Record how constructs are represented, for a module or namespace. and AddBindingsForModule allocVal cloc x eenv = @@ -1162,8 +1162,8 @@ and AddBindingsForModuleTopVals _g allocVal _cloc eenv vs = /// Put the partial results for a generated fragment (i.e. a part of a CCU generated by FSI) /// into the stored results for the whole CCU. -/// isIncrementalFragment = true --> "typed input" -/// isIncrementalFragment = false --> "#load" +/// isIncrementalFragment = true --> "typed input" +/// isIncrementalFragment = false --> "#load" let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap: ImportMap, isIncrementalFragment, g, ccu, fragName, intraAssemblyInfo, eenv, typedImplFiles) = let cloc = CompLocForFragment fragName ccu let allocVal = ComputeAndAddStorageForLocalTopVal (amap, g, intraAssemblyInfo, true, NoShadowLocal) @@ -1183,7 +1183,7 @@ let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap: ImportMap, isIncrement let GenILSourceMarker (g: TcGlobals) (m: range) = ILSourceMarker.Create(document=g.memoize_file m.FileIndex, line=m.StartLine, - /// NOTE: .NET && VS measure first column as column 1 + /// NOTE: .NET && VS measure first column as column 1 column= m.StartColumn+1, endLine= m.EndLine, endColumn=m.EndColumn+1) @@ -1247,17 +1247,17 @@ let MergePropertyDefs m ilPropertyDefs = /// Information collected imperatively for each type definition type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = - let gmethods = new ResizeArray(0) - let gfields = new ResizeArray(0) + let gmethods = new ResizeArray(0) + let gfields = new ResizeArray(0) let gproperties: Dictionary = new Dictionary<_, _>(3, HashIdentity.Structural) - let gevents = new ResizeArray(0) - let gnested = new TypeDefsBuilder() + let gevents = new ResizeArray(0) + let gnested = new TypeDefsBuilder() member b.Close() = tdef.With(methods = mkILMethods (tdef.Methods.AsList @ ResizeArray.toList gmethods), - fields = mkILFields (tdef.Fields.AsList @ ResizeArray.toList gfields), + fields = mkILFields (tdef.Fields.AsList @ ResizeArray.toList gfields), properties = mkILProperties (tdef.Properties.AsList @ HashRangeSorted gproperties ), - events = mkILEvents (tdef.Events.AsList @ ResizeArray.toList gevents), + events = mkILEvents (tdef.Events.AsList @ ResizeArray.toList gevents), nestedTypes = mkILTypeDefs (tdef.NestedTypes.AsList @ gnested.Close())) member b.AddEventDef(edef) = gevents.Add edef @@ -1288,7 +1288,7 @@ type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = member b.PrependInstructionsToSpecificMethodDef(cond, instrs, tag) = match ResizeArray.tryFindIndex cond gmethods with - | Some idx -> gmethods.[idx] <- prependInstrsToMethod instrs gmethods.[idx] + | Some idx -> gmethods.[idx] <- prependInstrsToMethod instrs gmethods.[idx] | None -> gmethods.Add(mkILClassCtor (mkMethodBody (false, [], 1, nonBranchingInstrsToCode instrs, tag))) @@ -1310,10 +1310,10 @@ and TypeDefsBuilder() = || not tdef.Events.AsList.IsEmpty || not tdef.Properties.AsList.IsEmpty || not (Array.isEmpty tdef.Methods.AsArray) then - yield tdef ] + yield tdef ] member b.FindTypeDefBuilder(nm) = - try tdefs.[nm] |> snd |> fst + try tdefs.[nm] |> snd |> fst with :? KeyNotFoundException -> failwith ("FindTypeDefBuilder: " + nm + " not found") member b.FindNestedTypeDefsBuilder(path) = @@ -1340,10 +1340,10 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu // A memoization table for generating value types for big constant arrays let rawDataValueTypeGenerator = - new MemoizationTable<(CompileLocation * int) , ILTypeSpec> + new MemoizationTable<(CompileLocation * int), ILTypeSpec> ((fun (cloc, size) -> - let name = CompilerGeneratedName ("T" + string(newUnique()) + "_" + string size + "Bytes") // Type names ending ...$T_37Bytes - let vtdef = mkRawDataValueTypeDef cenv.g.iltyp_ValueType (name, size, 0us) + let name = CompilerGeneratedName ("T" + string(newUnique()) + "_" + string size + "Bytes") // Type names ending ...$T_37Bytes + let vtdef = mkRawDataValueTypeDef cenv.g.iltyp_ValueType (name, size, 0us) let vtref = NestedTypeRefForCompLoc cloc vtdef.Name let vtspec = mkILTySpec(vtref, []) let vtdef = vtdef.WithAccess(ComputeTypeAccess vtref true) @@ -1376,7 +1376,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu mkILFields [ for (_, fldName, fldTy) in flds -> let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Private) - fdef.With(customAttrs = mkILCustomAttrs [ cenv.g.DebuggerBrowsableNeverAttribute ]) ] + fdef.With(customAttrs = mkILCustomAttrs [ cenv.g.DebuggerBrowsableNeverAttribute ]) ] // Generate property definitions for the fields compiled as properties let ilProperties = @@ -1385,7 +1385,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu ILPropertyDef(name=propName, attributes=PropertyAttributes.None, setMethod=None, - getMethod=Some(mkILMethRef(ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], fldTy )), + getMethod=Some(mkILMethRef(ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], fldTy )), callingConv=ILCallingConv.Instance.ThisConv, propertyType=fldTy, init= None, @@ -1434,7 +1434,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu (cenv.g.mk_IComparable_ty, true, m) (mkAppTy cenv.g.system_GenericIComparable_tcref [typ], true, m) (cenv.g.mk_IStructuralEquatable_ty, true, m) - (mkAppTy cenv.g.system_GenericIEquatable_tcref [typ], true, m) ] + (mkAppTy cenv.g.system_GenericIEquatable_tcref [typ], true, m) ] let vspec1, vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation cenv.g tcref let evspec1, evspec2, evspec3 = AugmentWithHashCompare.MakeValsForEqualityWithComparerAugmentation cenv.g tcref @@ -1446,7 +1446,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) tcaug.SetHashAndEqualsWith (mkLocalValRef evspec1, mkLocalValRef evspec2, mkLocalValRef evspec3) - // Build the ILTypeDef. We don't rely on the normal record generation process because we want very specific field names + // Build the ILTypeDef. We don't rely on the normal record generation process because we want very specific field names let ilTypeDefAttribs = mkILCustomAttrs [ cenv.g.CompilerGeneratedAttribute; mkCompilationMappingAttr cenv.g (int SourceConstructFlags.RecordType) ] @@ -1474,7 +1474,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu (ilCtorRef, ilMethodRefs, ilTy) - let mutable explicitEntryPointInfo: ILTypeRef option = None + let mutable explicitEntryPointInfo: ILTypeRef option = None /// static init fields on script modules. let mutable scriptInitFspecs: (ILFieldSpec * range) list = [] @@ -1545,7 +1545,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field // Doing both a store and load keeps FxCop happier because it thinks the field is useful let instrs = - [ yield! (if condition "NO_ADD_FEEFEE_TO_CCTORS" then [] elif condition "ADD_SEQPT_TO_CCTORS" then seqpt else feefee) // mark start of hidden code + [ yield! (if condition "NO_ADD_FEEFEE_TO_CCTORS" then [] elif condition "ADD_SEQPT_TO_CCTORS" then seqpt else feefee) // mark start of hidden code yield mkLdcInt32 0 yield mkNormalStsfld fspec yield mkNormalLdsfld fspec @@ -1618,7 +1618,7 @@ type CodeGenBuffer(m: range, let mutable lastSeqPoint = None // Add a nop to make way for the first sequence point. - do if mgbuf.cenv.opts.generateDebugSymbols then + do if mgbuf.cenv.opts.generateDebugSymbols then let doc = mgbuf.cenv.g.memoize_file m.FileIndex let i = FeeFeeInstr mgbuf.cenv doc codebuf.Add(i) // for the FeeFee or a better sequence point @@ -1780,7 +1780,7 @@ type CodeGenBuffer(m: range, let codeLabels = let dict = Dictionary.newWithSize (codeLabelToPC.Count + codeLabelToCodeLabel.Count) - for kvp in codeLabelToPC do dict.Add(kvp.Key, lab2pc 0 kvp.Key) + for kvp in codeLabelToPC do dict.Add(kvp.Key, lab2pc 0 kvp.Key) for kvp in codeLabelToCodeLabel do dict.Add(kvp.Key, lab2pc 0 kvp.Key) dict @@ -1792,7 +1792,7 @@ module CG = 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 SetMarkToHere (cgbuf: CodeGenBuffer) m1 = cgbuf.SetMarkToHere(m1) let SetStack (cgbuf: CodeGenBuffer) s = cgbuf.SetStack(s) let GenerateMark (cgbuf: CodeGenBuffer) s = cgbuf.Mark(s) @@ -1812,7 +1812,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())) @@ -1864,7 +1864,7 @@ let discardAndReturnVoid = DiscardThen ReturnVoid //------------------------------------------------------------------------- -// This is the main code generation routine. It is used to generate +// This is the main code generation routine. It is used to generate // the bodies of methods in a couple of places //------------------------------------------------------------------------- @@ -1917,7 +1917,7 @@ let CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, let locals, maxStack, lab2pc, instrs, exns, localDebugSpecs, hasSequencePoints = CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, codeGenFunction, m) - let code = IL.buildILCode methodName lab2pc instrs exns localDebugSpecs + let code = IL.buildILCode methodName lab2pc instrs exns localDebugSpecs // Attach a source range to the method. Only do this is it has some sequence points, because .NET 2.0/3.5 // ILDASM has issues if you emit symbols with a source range but without any sequence points @@ -1990,13 +1990,13 @@ let BindingEmitsSequencePoint g bind = | _, None, SPSuppress -> false | _ -> true -let BindingIsInvisible (TBind(_, _, spBind)) = +let BindingIsInvisible (TBind(_, _, spBind)) = match spBind with | NoSequencePointAtInvisibleBinding _ -> true | _ -> false /// Determines if the code generated for a binding is to be marked as hidden, e.g. the 'newobj' for a local function definition. -let BindingEmitsHiddenCode (TBind(_, e, spBind)) = +let BindingEmitsHiddenCode (TBind(_, e, spBind)) = match spBind, stripExpr e with | _, (Expr.Lambda _ | Expr.TyLambda _) -> true | _ -> false @@ -2020,11 +2020,11 @@ let rec FirstEmittedCodeWillBeSequencePoint g sp expr = | SequencePointsAtSeq -> true | SuppressSequencePointOnExprOfSequential -> true | SuppressSequencePointOnStmtOfSequential -> false - | Expr.Match (SequencePointAtBinding _, _, _, _, _, _) -> true - | Expr.Op(( TOp.TryCatch (SequencePointAtTry _, _) - | TOp.TryFinally (SequencePointAtTry _, _) - | TOp.For (SequencePointAtForLoop _, _) - | TOp.While (SequencePointAtWhileLoop _, _)), _, _, _) -> true + | Expr.Match (SequencePointAtBinding _, _, _, _, _, _) -> true + | Expr.Op((TOp.TryCatch (SequencePointAtTry _, _) + | TOp.TryFinally (SequencePointAtTry _, _) + | TOp.For (SequencePointAtForLoop _, _) + | TOp.While (SequencePointAtWhileLoop _, _)), _, _, _) -> true | _ -> false | SPSuppress -> @@ -2049,14 +2049,14 @@ let EmitSequencePointForWholeExpr g sp expr = // and by inlining 'f' the expression becomes // let someCode () = (let sticky = x in y) // then we place the sequence point for the whole TAST expression 'let sticky = x in y', i.e. textual range 'f x' in the source code, but - // _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. + // _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 // 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 @@ -2079,7 +2079,7 @@ let EmitSequencePointForWholeExpr g sp expr = | Expr.Match _ -> false | Expr.Op(TOp.TryCatch _, _, _, _) -> false | Expr.Op(TOp.TryFinally _, _, _, _) -> false - | Expr.Op(TOp.For _, _, _, _) -> false + | Expr.Op(TOp.For _, _, _, _) -> false | Expr.Op(TOp.While _, _, _, _) -> false | _ -> true | SPSuppress -> @@ -2097,7 +2097,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 @@ -2112,12 +2112,12 @@ 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 /// Used to avoid emitting multiple sequence points in decision tree generation -let DoesGenExprStartWithSequencePoint g sp expr = +let DoesGenExprStartWithSequencePoint g sp expr = FirstEmittedCodeWillBeSequencePoint g sp expr || EmitSequencePointForWholeExpr g sp expr @@ -2127,7 +2127,7 @@ let DoesGenExprStartWithSequencePoint g sp expr = let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = - let expr = stripExpr expr + let expr = stripExpr expr if not (FirstEmittedCodeWillBeSequencePoint cenv.g sp expr) then if EmitSequencePointForWholeExpr cenv.g sp expr then @@ -2147,9 +2147,9 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = GenMatch cenv cgbuf eenv (spBind, exprm, tree, targets, m, ty) sequel | Expr.Sequential(e1, e2, dir, spSeq, m) -> GenSequential cenv cgbuf eenv sp (e1, e2, dir, spSeq, m) sequel - | Expr.LetRec (binds, body, m, _) -> + | Expr.LetRec (binds, body, m, _) -> GenLetRec cenv cgbuf eenv (binds, body, m) sequel - | Expr.Let (bind, body, _, _) -> + | Expr.Let (bind, body, _, _) -> // This case implemented here to get a guaranteed tailcall // Make sure we generate the sequence point outside the scope of the variable let startScope, endScope as scopeMarks = StartDelayedLocalScope "let" cgbuf @@ -2171,7 +2171,7 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = // Generate the body GenExpr cenv cgbuf eenv spBody body (EndLocalScope(sequel, endScope)) - | Expr.Lambda _ | Expr.TyLambda _ -> + | Expr.Lambda _ | Expr.TyLambda _ -> GenLambda cenv cgbuf eenv false None expr sequel | Expr.App(Expr.Val(vref, _, m) as v, _, tyargs, [], _) when List.forall (isMeasureTy cenv.g) tyargs && @@ -2180,10 +2180,10 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = match StorageForValRef m vref eenv with | ValStorage.Local _ -> true | _ -> false - ) -> + ) -> // 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) -> GenGetVal cenv cgbuf eenv (v, m) sequel @@ -2196,9 +2196,9 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | 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), _, _ -> GenAllocRecd cenv cgbuf eenv isCtor (tycon, tyargs, args, m) sequel @@ -2238,9 +2238,9 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = GenAllocTuple cenv cgbuf eenv (tupInfo, args, tyargs, m) sequel | 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] -> GenTryFinally cenv cgbuf eenv (e1, e2, m, resty, spTry, spFinally) sequel @@ -2248,15 +2248,15 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = 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, [] -> 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.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(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.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 GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_Byte bytes (fun buf b -> buf.EmitByte b) @@ -2290,7 +2290,7 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | Expr.Obj(_, ty, _, _, [meth], [], m) when isDelegateTy cenv.g ty -> GenDelegateExpr cenv cgbuf eenv expr (meth, m) sequel | Expr.Obj(_, ty, basev, basecall, overrides, interfaceImpls, m) -> - GenObjectExpr cenv cgbuf eenv expr (ty, basev, basecall, overrides, interfaceImpls, m) sequel + 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.Link _ -> failwith "Unexpected reclink" @@ -2323,9 +2323,9 @@ and sequelIgnoringEndScopesAndDiscard sequel = let sequel = sequelIgnoreEndScopes sequel match sequelAfterDiscard sequel with | Some sq -> sq - | None -> sequel + | None -> sequel -and sequelIgnoreEndScopes sequel = +and sequelIgnoreEndScopes sequel = match sequel with | EndLocalScope(sq, _) -> sequelIgnoreEndScopes sq | sq -> sq @@ -2432,9 +2432,9 @@ and GenUnitTy cenv eenv m = let res = GenType cenv.amap m eenv.tyenv cenv.g.unit_ty cenv.ilUnitTy <- Some res res - | Some res -> res + | Some res -> res -and GenUnit cenv eenv m cgbuf = +and GenUnit cenv eenv m cgbuf = CG.EmitInstr cgbuf (pop 0) (Push [GenUnitTy cenv eenv m]) AI_ldnull and GenUnitThenSequel cenv eenv m cloc cgbuf sequel = @@ -2500,7 +2500,7 @@ and GenAllocUnionCaseCore cenv cgbuf eenv (c,tyargs,n,m) = let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv c tyargs CG.EmitInstrs cgbuf (pop n) (Push [cuspec.DeclaringType]) (EraseUnions.mkNewData cenv.g.ilg (cuspec, idx)) -and GenAllocUnionCase cenv cgbuf eenv (c,tyargs,args,m) sequel = +and GenAllocUnionCase cenv cgbuf eenv (c,tyargs,args,m) sequel = GenExprs cenv cgbuf eenv args GenAllocUnionCaseCore cenv cgbuf eenv (c,tyargs,args.Length,m) GenSequel cenv eenv.cloc cgbuf sequel @@ -2527,7 +2527,7 @@ and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel = |> List.filter (fun f -> not f.IsCompilerGenerated) match ctorInfo with - | RecdExprIsObjInit -> + | RecdExprIsObjInit -> (args, relevantFields) ||> List.iter2 (fun e f -> CG.EmitInstr cgbuf (pop 0) (Push (if tcref.IsStructOrEnumTycon then [ILType.Byref ty] else [ty])) mkLdarg0 GenExpr cenv cgbuf eenv SPSuppress e Continue @@ -2569,15 +2569,15 @@ and GenNewArraySimple cenv cgbuf eenv (elems, elemTy, m) sequel = CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy]) [ (AI_ldc (DT_I4, ILConst.I4 (elems.Length))); I_newarr (ILArrayShape.SingleDimensional, ilElemTy) ] elems |> List.iteri (fun i e -> - CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy; cenv.g.ilg.typ_Int32]) [ AI_dup; (AI_ldc (DT_I4, ILConst.I4 i)) ] + CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy; cenv.g.ilg.typ_Int32]) [ AI_dup; (AI_ldc (DT_I4, ILConst.I4 i)) ] GenExpr cenv cgbuf eenv SPSuppress e Continue - CG.EmitInstr cgbuf (pop 3) Push0 (I_stelem_any (ILArrayShape.SingleDimensional, ilElemTy))) + CG.EmitInstr cgbuf (pop 3) Push0 (I_stelem_any (ILArrayShape.SingleDimensional, ilElemTy))) GenSequel cenv eenv.cloc cgbuf sequel and GenNewArray cenv cgbuf eenv (elems: Expr list, elemTy, m) sequel = // REVIEW: The restriction against enum types here has to do with Dev10/Dev11 bug 872799 - // GenConstArray generates a call to RuntimeHelpers.InitializeArray. On CLR 2.0/x64 and CLR 4.0/x64/x86, + // GenConstArray generates a call to RuntimeHelpers.InitializeArray. On CLR 2.0/x64 and CLR 4.0/x64/x86, // InitializeArray is a JIT intrinsic that will result in invalid runtime CodeGen when initializing an array // of enum types. Until bug 872799 is fixed, we'll need to generate arrays the "simple" way for enum types // Also note - C# never uses InitializeArray for enum types, so this change puts us on equal footing with them. @@ -2588,14 +2588,14 @@ 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 _, _, _) -> - (function Const.Bool _ -> true | _ -> false), - (fun (buf: ByteBuffer) -> function Const.Bool b -> buf.EmitBoolAsByte b | _ -> failwith "unreachable") - | 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 _, _, _) -> - (function Const.Byte _ -> true | _ -> false), + | 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 _, _, _) -> + (function Const.Char _ -> true | _ -> false), + (fun buf -> function Const.Char b -> buf.EmitInt32AsUInt16 (int b) | _ -> failwith "unreachable") + | Expr.Const(Const.Byte _, _, _) -> + (function Const.Byte _ -> true | _ -> false), (fun buf -> function Const.Byte b -> buf.EmitByte b | _ -> failwith "unreachable") | Expr.Const(Const.UInt16 _, _, _) -> (function Const.UInt16 _ -> true | _ -> false), @@ -2606,17 +2606,17 @@ and GenNewArray cenv cgbuf eenv (elems: Expr list, elemTy, m) sequel = | 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 _, _, _) -> - (function Const.SByte _ -> true | _ -> false), + | 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 _, _, _) -> - (function Const.Int16 _ -> true | _ -> false), + | 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 _, _, _) -> - (function Const.Int32 _ -> true | _ -> false), + | Expr.Const(Const.Int32 _, _, _) -> + (function Const.Int32 _ -> true | _ -> false), (fun buf -> function Const.Int32 b -> buf.EmitInt32 b | _ -> failwith "unreachable") - | Expr.Const(Const.Int64 _, _, _) -> - (function Const.Int64 _ -> true | _ -> false), + | 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") @@ -2649,10 +2649,10 @@ and GenCoerce cenv cgbuf eenv (e, tgty, m, srcty) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue if not (isObjTy cenv.g srcty) then let ilFromTy = GenType cenv.amap m eenv.tyenv srcty - CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) [ I_box ilFromTy ] + CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) [ I_box ilFromTy ] if not (isObjTy cenv.g tgty) then let ilToTy = GenType cenv.amap m eenv.tyenv tgty - CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy ] + CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy ] GenSequel cenv eenv.cloc cgbuf sequel and GenReraise cenv cgbuf eenv (rtnty, m) sequel = @@ -2661,7 +2661,7 @@ and GenReraise cenv cgbuf eenv (rtnty, m) sequel = // [See comment related to I_throw]. // Rethrow does not return. Required to push dummy value on the stack. // This follows prior behaviour by prim-types reraise<_>. - CG.EmitInstrs cgbuf (pop 0) (Push [ilReturnTy]) [AI_ldnull; I_unbox_any ilReturnTy ] + CG.EmitInstrs cgbuf (pop 0) (Push [ilReturnTy]) [AI_ldnull; I_unbox_any ilReturnTy ] GenSequel cenv eenv.cloc cgbuf sequel and GenGetExnField cenv cgbuf eenv (e, ecref, fieldNum, m) sequel = @@ -2734,7 +2734,7 @@ and GenGetUnionCaseTag cenv cgbuf eenv (e, tcref, tyargs, m) sequel = let cuspec = GenUnionSpec cenv.amap m eenv.tyenv tcref tyargs let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib tcref EraseUnions.emitLdDataTag cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers, cuspec) - CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Int32]) [ ] // push/pop to match the line above + CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Int32]) [ ] // push/pop to match the line above GenSequel cenv eenv.cloc cgbuf sequel and GenSetUnionCaseField cenv cgbuf eenv (e, ucref, tyargs, n, e2, m) sequel = @@ -2809,11 +2809,11 @@ and GenFieldStore isStatic cenv cgbuf eenv (rfref: RecdFieldRef, tyargs, m) sequ /// Generate arguments to a call, unless the argument is the single lone "unit" value /// to a method or value compiled as a method taking no arguments -and GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos args = - match curriedArgInfos , args with +and GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos args = + match curriedArgInfos, args with // Type.M() // new C() - | [[]], [arg] when numObjArgs = 0 -> + | [[]], [arg] when numObjArgs = 0 -> assert isUnitTy cenv.g (tyOfExpr cenv.g arg) GenExpr cenv cgbuf eenv SPSuppress arg discard // obj.M() @@ -2865,13 +2865,13 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = (* when branch-calling methods we must have the right type parameters *) (match kind with | BranchCallClosure _ -> true - | BranchCallMethod (_, _, tps, _, _) -> + | BranchCallMethod (_, _, tps, _, _) -> (List.lengthsEqAndForall2 (fun ty tp -> typeEquiv cenv.g ty (mkTyparTy tp)) tyargs tps)) && (* must be exact #args, ignoring tupling - we untuple if needed below *) (let arityInfo = match kind with | BranchCallClosure arityInfo - | BranchCallMethod (arityInfo, _, _, _, _) -> arityInfo + | BranchCallMethod (arityInfo, _, _, _, _) -> arityInfo arityInfo.Length = args.Length ) && (* no tailcall out of exception handler, etc. *) @@ -2885,7 +2885,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = let ntmargs = List.foldBack (+) arityInfo 0 GenExprs cenv cgbuf eenv args ntmargs - | BranchCallMethod (arityInfo, curriedArgInfos, _, ntmargs, numObjArgs) -> + | BranchCallMethod (arityInfo, curriedArgInfos, _, ntmargs, numObjArgs) -> assert (curriedArgInfos.Length = arityInfo.Length ) assert (curriedArgInfos.Length = args.Length) //assert (curriedArgInfos.Length = ntmargs ) @@ -2976,7 +2976,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = // For instance method calls chop off some type arguments, which are already - // carried by the class. Also work out if it's a virtual call. + // carried by the class. Also work out if it's a virtual call. let _, virtualCall, newobj, isSuperInit, isSelfInit, _, _, _ = GetMemberCallInfo cenv.g (vref, valUseFlags) in // numEnclILTypeArgs will include unit-of-measure args, unfortunately. For now, just cut-and-paste code from GetMemberCallInfo @@ -2988,7 +2988,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = | _ -> 0 let (ilEnclArgTys, ilMethArgTys) = - if ilTyArgs.Length < numEnclILTypeArgs then error(InternalError("length mismatch", m)) + if ilTyArgs.Length < numEnclILTypeArgs then error(InternalError("length mismatch", m)) List.splitAt numEnclILTypeArgs ilTyArgs let boxity = mspec.DeclaringType.Boxity @@ -2999,7 +2999,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = let ccallInfo = match valUseFlags with - | PossibleConstrainedCall ty -> Some ty + | PossibleConstrainedCall ty -> Some ty | _ -> None let isBaseCall = match valUseFlags with VSlotDirectCall -> true | _ -> false @@ -3050,13 +3050,13 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = let pushes = if mustGenerateUnitAfterCall || isSuperInit || isSelfInit then Push0 else (Push [(GenType cenv.amap m eenv.tyenv actualRetTy)]) CG.EmitInstr cgbuf (pop (nargs + (if mspec.CallingConv.IsStatic || newobj then 0 else 1))) pushes callInstr - // For isSuperInit, load the 'this' pointer as the pretend 'result' of the operation. It will be popped again in most cases + // For isSuperInit, load the 'this' pointer as the pretend 'result' of the operation. It will be popped again in most cases if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [mspec.DeclaringType]) [ mkLdarg0 ] // When generating debug code, generate a 'nop' after a 'call' that returns 'void' // This is what C# does, as it allows the call location to be maintained correctly in the stack frame if cenv.opts.generateDebugSymbols && mustGenerateUnitAfterCall && (isTailCall = Normalcall) then - CG.EmitInstrs cgbuf (pop 0) Push0 [ AI_nop ] + CG.EmitInstrs cgbuf (pop 0) Push0 [ AI_nop ] if isNil laterArgs then assert isNil whereSaved @@ -3064,7 +3064,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = CommitCallSequel cenv eenv m eenv.cloc cgbuf mustGenerateUnitAfterCall sequel else //printfn "%d EXTRA ARGS IN TOP APP at %s" laterArgs.Length (stringOfRange m) - whereSaved |> List.iter (function + whereSaved |> List.iter (function | Choice1Of2 (ilTy, loc) -> EmitGetLocal cgbuf ilTy loc | Choice2Of2 expr -> GenExpr cenv cgbuf eenv SPSuppress expr Continue) GenIndirectCall cenv cgbuf eenv (actualRetTy, [], laterArgs, m) sequel) @@ -3075,7 +3075,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)) | _ -> @@ -3093,9 +3093,9 @@ and CanTailcall (hasStructObjArg, ccallInfo, withinSEH, hasByrefArg, mustGenerat // We can tailcall even if we need to generate "unit", as long as we're about to throw the value away anyway as par of the return. // We can tailcall if we don't need to generate "unit", as long as we're about to return. (match sequelIgnoreEndScopes sequel with - | ReturnVoid | Return -> not mustGenerateUnitAfterCall - | DiscardThen ReturnVoid -> mustGenerateUnitAfterCall - | _ -> false) + | ReturnVoid | Return -> not mustGenerateUnitAfterCall + | DiscardThen ReturnVoid -> mustGenerateUnitAfterCall + | _ -> false) then Tailcall else Normalcall @@ -3117,7 +3117,7 @@ and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv ty cloinfo tyargs m // Local TyFunc are represented as a $contract type. they currently get stored in a value of type object // Recover result (value or reference types) via unbox_any. - CG.EmitInstrs cgbuf (pop 1) (Push [ilContractTy]) [I_unbox_any ilContractTy] + CG.EmitInstrs cgbuf (pop 1) (Push [ilContractTy]) [I_unbox_any ilContractTy] let actualRetTy = applyTys cenv.g ty (tyargs, []) let ilDirectInvokeMethSpec = mkILInstanceMethSpecInTy(ilContractTy, "DirectInvoke", [], ilContractFormalRetTy, ilTyArgs) @@ -3247,7 +3247,7 @@ and GenTryCatch cenv cgbuf eenv (e1, vf: Val, ef, vh: Val, eh, m, resty, spTry, // Why SPSuppress? Because we do not emit a sequence point at the start of the List.filter - we've already put one on // the 'with' keyword above - GenExpr cenv cgbuf eenvinner SPSuppress ef sequelOnBranches + GenExpr cenv cgbuf eenvinner SPSuppress ef sequelOnBranches CG.SetMarkToHere cgbuf afterJoin CG.SetStack cgbuf stackAfterJoin GenSequel cenv eenv.cloc cgbuf sequelAfterJoin @@ -3325,7 +3325,7 @@ and GenTryFinally cenv cgbuf eenv (bodyExpr, handlerExpr, m, resty, spTry, spFin let handlerMarks = (startOfHandler.CodeLabel, endOfHandler.CodeLabel) cgbuf.EmitExceptionClause { Clause = ILExceptionClause.Finally(handlerMarks) - Range = tryMarks } + Range = tryMarks } CG.SetMarkToHere cgbuf afterHandler CG.SetStack cgbuf [] @@ -3356,7 +3356,7 @@ and GenForLoop cenv cgbuf eenv (spFor, v, e1, dir, e2, loopBody, m) sequel = let stack, eenvinner = EmitSaveStack cenv cgbuf eenv m (start, finish) let isUp = (match dir with | FSharpForLoopUp | CSharpForLoopUp -> true | FSharpForLoopDown -> false) - let isFSharpStyle = (match dir with FSharpForLoopUp | FSharpForLoopDown -> true | CSharpForLoopUp -> false) + let isFSharpStyle = (match dir with FSharpForLoopUp | FSharpForLoopDown -> true | CSharpForLoopUp -> false) let finishIdx, eenvinner = if isFSharpStyle then @@ -3367,7 +3367,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 @@ -3400,16 +3400,16 @@ 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 - | NoSequencePointAtForLoop -> () //CG.EmitSeqPoint cgbuf e2.Range + | SequencePointAtForLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart + | NoSequencePointAtForLoop -> () //CG.EmitSeqPoint cgbuf e2.Range GenGetLocalVal cenv cgbuf eenvinner e2.Range v None let cmp = match dir with FSharpForLoopUp | FSharpForLoopDown -> BI_bne_un | CSharpForLoopUp -> BI_blt - let e2Sequel = (CmpThenBrOrContinue (pop 2, [ I_brcmp(cmp, inner.CodeLabel) ])) + let e2Sequel = (CmpThenBrOrContinue (pop 2, [ I_brcmp(cmp, inner.CodeLabel) ])) if isFSharpStyle then - EmitGetLocal cgbuf cenv.g.ilg.typ_Int32 finishIdx + EmitGetLocal cgbuf cenv.g.ilg.typ_Int32 finishIdx CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_Int32]) (mkLdcInt32 1) CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub) GenSequel cenv eenv.cloc cgbuf e2Sequel @@ -3432,7 +3432,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' @@ -3475,11 +3475,11 @@ and GenSequential cenv cgbuf eenv spIn (e1, e2, specialSeqFlag, spSeq, _m) seque and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = let ilTyArgs = GenTypesPermitVoid cenv.amap m eenv.tyenv tyargs - let ilReturnTys = GenTypesPermitVoid cenv.amap m eenv.tyenv returnTys + let ilReturnTys = GenTypesPermitVoid cenv.amap m eenv.tyenv returnTys let ilAfterInst = il |> List.filter (function AI_nop -> false | _ -> true) |> List.map (fun i -> - let err s = + let err s = errorR(InternalError(sprintf "%s: bad instruction: %A" s i, m)) let modFieldSpec fspec = @@ -3491,28 +3491,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_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_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_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_ldfld (al, vol, fspec) , _ -> I_ldfld (al, vol, 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_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_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) | AI_nop, _ -> i // These are embedded in the IL for a an initonly ldfld, i.e. // here's the relevant comment from tc.fs @@ -3553,14 +3553,14 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = GenSequelEndScopes cgbuf sequel // 'throw' instructions are a bit of a problem - e.g. let x = (throw ...) in ... expects a value *) - // to be left on the stack. But dead-code checking by some versions of the .NET verifier *) + // to be left on the stack. But dead-code checking by some versions of the .NET verifier *) // mean that we can't just have fake code after the throw to generate the fake value *) // (nb. a fake value can always be generated by a "ldnull unbox.any ty" sequence *) // So in the worst case we generate a fake (never-taken) branch to a piece of code to generate *) // the fake value *) | [ I_throw ], [arg1], sequel, [ilRetTy] -> match sequelIgnoreEndScopes sequel with - | s when IsSequelImmediate s -> + | s when IsSequelImmediate s -> (* In most cases we can avoid doing this... *) GenExpr cenv cgbuf eenv SPSuppress arg1 Continue CG.EmitInstr cgbuf (pop 1) Push0 I_throw @@ -3572,7 +3572,7 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = CG.EmitInstrs cgbuf (pop 0) Push0 [mkLdcInt32 0; I_brcmp (BI_brfalse, after2.CodeLabel) ] CG.SetMarkToHere cgbuf after1 - CG.EmitInstrs cgbuf (pop 0) (Push [ilRetTy]) [AI_ldnull; I_unbox_any ilRetTy; I_br after3.CodeLabel ] + CG.EmitInstrs cgbuf (pop 0) (Push [ilRetTy]) [AI_ldnull; I_unbox_any ilRetTy; I_br after3.CodeLabel ] CG.SetMarkToHere cgbuf after2 GenExpr cenv cgbuf eenv SPSuppress arg1 Continue @@ -3582,13 +3582,13 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = | _ -> // float or float32 or float<_> or float32<_> let g = cenv.g in - let anyfpType ty = typeEquivAux EraseMeasures g g.float_ty ty || typeEquivAux EraseMeasures g g.float32_ty ty + let anyfpType ty = typeEquivAux EraseMeasures g g.float_ty ty || typeEquivAux EraseMeasures g g.float32_ty ty // Otherwise generate the arguments, and see if we can use a I_brcmp rather than a comparison followed by an I_brfalse/I_brtrue GenExprs cenv cgbuf eenv args match ilAfterInst, sequel with - // NOTE: THESE ARE NOT VALID ON FLOATING POINT DUE TO NaN. Hence INLINE ASM ON FP. MUST BE CAREFULLY WRITTEN + // NOTE: THESE ARE NOT VALID ON FLOATING POINT DUE TO NaN. Hence INLINE ASM ON FP. MUST BE CAREFULLY WRITTEN | [ AI_clt ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge, label1)) @@ -3643,7 +3643,7 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = let astSerializedBytes = QuotationPickler.pickle astSpec - let someTypeInModuleExpr = mkTypeOfExpr cenv m eenv.someTypeInThisAssembly + let someTypeInModuleExpr = mkTypeOfExpr cenv m eenv.someTypeInThisAssembly let rawTy = mkRawQuotedExprTy cenv.g let spliceTypeExprs = List.map (GenType cenv.amap m eenv.tyenv >> (mkTypeOfExpr cenv m)) spliceTypes @@ -3652,7 +3652,7 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = let deserializeExpr = match QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat cenv.g with | QuotationTranslator.QuotationSerializationFormat.FSharp_40_Plus -> - let referencedTypeDefExprs = List.map (mkILNonGenericBoxedTy >> mkTypeOfExpr cenv m) referencedTypeDefs + let referencedTypeDefExprs = List.map (mkILNonGenericBoxedTy >> mkTypeOfExpr cenv m) referencedTypeDefs let referencedTypeDefsExpr = mkArray (cenv.g.system_Type_ty, referencedTypeDefExprs, m) let spliceTypesExpr = mkArray (cenv.g.system_Type_ty, spliceTypeExprs, m) let spliceArgsExpr = mkArray (rawTy, spliceArgExprs, m) @@ -3678,7 +3678,7 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = //-------------------------------------------------------------------------- and GenILCall cenv cgbuf eenv (virt, valu, newobj, valUseFlags, isDllImport, ilMethRef: ILMethodRef, enclArgTys, methArgTys, argExprs, returnTys, m) sequel = - let hasByrefArg = ilMethRef.ArgTypes |> List.exists IsILTypeByref + let hasByrefArg = ilMethRef.ArgTypes |> List.exists IsILTypeByref let isSuperInit = match valUseFlags with CtorValUsedAsSuperInit -> true | _ -> false let isBaseCall = match valUseFlags with VSlotDirectCall -> true | _ -> false let ccallInfo = match valUseFlags with PossibleConstrainedCall ty -> Some ty | _ -> None @@ -3706,7 +3706,7 @@ and GenILCall cenv cgbuf eenv (virt, valu, newobj, valUseFlags, isDllImport, ilM [ I_callconstraint(tail, ilObjArgTy, ilMethSpec, None) ] | None -> if useICallVirt then [ I_callvirt(tail, ilMethSpec, None) ] - else [ I_call(tail, ilMethSpec, None) ] + else [ I_call(tail, ilMethSpec, None) ] CG.EmitInstrs cgbuf (pop (argExprs.Length + (if isSuperInit then 1 else 0))) (if isSuperInit then Push0 else Push ilReturnTys) il @@ -3769,7 +3769,7 @@ and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = | Env (_, _, ilField, _) -> CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ mkLdarg0; mkNormalLdflda ilField ] - | Local (_, _, Some _) | StaticProperty _ | Method _ | Env _ | Null -> + | Local (_, _, Some _) | StaticProperty _ | Method _ | Env _ | Null -> errorR(Error(FSComp.SR.ilAddressOfValueHereIsInvalid(v.DisplayName), m)) CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 669 (* random value for post-hoc diagnostic analysis on generated tree *) ) ] @@ -3819,7 +3819,7 @@ and GenDefaultValue cenv cgbuf eenv (ty, m) = // we can just rely on zeroinit of all IL locals. if realloc then match ilTy with - | ILType.Byref _ -> () + | ILType.Byref _ -> () | _ -> EmitInitLocal cgbuf ilTy locIdx EmitGetLocal cgbuf ilTy locIdx ) @@ -3859,7 +3859,7 @@ and GenGenericParam cenv eenv (tp: Typar) = | "U2" -> "TResult2" | _ -> if nm.TrimEnd([| '0' .. '9' |]).Length = 1 then nm - elif nm.Length >= 1 && nm.[0] = 'T' && (nm.Length = 1 || not (System.Char.IsLower nm.[1])) then nm + elif nm.Length >= 1 && nm.[0] = 'T' && (nm.Length = 1 || not (System.Char.IsLower nm.[1])) then nm else "T" + (String.capitalize nm) else nm @@ -3907,7 +3907,7 @@ and GenFormalSlotsig m cenv eenv (TSlotSig(_, ty, ctps, mtps, paraml, returnTy)) let eenvForSlotSig = EnvForTypars (ctps @ mtps) eenv let ilParams = paraml |> List.map (GenSlotParam m cenv eenvForSlotSig) let ilRetTy = GenReturnType cenv.amap m eenvForSlotSig.tyenv returnTy - let ilRet = mkILReturn ilRetTy + let ilRet = mkILReturn ilRetTy let ilRet = match returnTy with | None -> ilRet @@ -3956,7 +3956,7 @@ and GenMethodImpl cenv eenv (useMethodImpl, (TSlotSig(nameOfOverridenMethod, _, and bindBaseOrThisVarOpt cenv eenv baseValOpt = match baseValOpt with | None -> eenv - | Some basev -> AddStorageForVal cenv.g (basev, notlazy (Arg 0)) eenv + | Some basev -> AddStorageForVal cenv.g (basev, notlazy (Arg 0)) eenv and fixupVirtualSlotFlags (mdef: ILMethodDef) = mdef.WithHideBySig() @@ -3972,7 +3972,7 @@ and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod // Check if we're compiling the property as a .NET event let (TObjExprMethod(slotsig, attribs, methTyparsOfOverridingMethod, methodParams, methodBodyExpr, m)) = tmethod let (TSlotSig(nameOfOverridenMethod, _, _, _, _, _)) = slotsig - if CompileAsEvent cenv.g attribs then + if CompileAsEvent cenv.g attribs then [] else let eenvUnderTypars = AddTyparsToEnv methTyparsOfOverridingMethod eenvinner @@ -3984,7 +3984,7 @@ and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod let ilAttribs = GenAttrs cenv eenvinner attribs // Args are stored starting at #1 - let eenvForMeth = AddStorageForLocalVals cenv.g (methodParams |> List.mapi (fun i v -> (v, Arg i))) eenvUnderTypars + let eenvForMeth = AddStorageForLocalVals cenv.g (methodParams |> List.mapi (fun i v -> (v, Arg i))) eenvUnderTypars let sequel = (if slotSigHasVoidReturnTy slotsig then discardAndReturnVoid else Return) let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], nameOfOverridenMethod, eenvForMeth, 0, methodBodyExpr, sequel) @@ -4004,8 +4004,8 @@ and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod let mdef = mdef.With(customAttrs = mkILCustomAttrs ilAttribs) [(useMethodImpl, methodImplGenerator, methTyparsOfOverridingMethod), mdef] -and GenObjectExpr cenv cgbuf eenvouter expr (baseType, baseValOpt, basecall, overrides, interfaceImpls, m) sequel = - let cloinfo, _, eenvinner = GetIlxClosureInfo cenv m false None eenvouter expr +and GenObjectExpr cenv cgbuf eenvouter expr (baseType, baseValOpt, basecall, overrides, interfaceImpls, m) sequel = + let cloinfo, _, eenvinner = GetIlxClosureInfo cenv m false None eenvouter expr let cloAttribs = cloinfo.cloAttribs let cloFreeVars = cloinfo.cloFreeVars @@ -4199,7 +4199,7 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc selfv expr | Expr.Lambda (_, _, _, _, _, m, _) | Expr.TyLambda(_, _, _, m, _) -> - let cloinfo, body, eenvinner = GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenv expr + let cloinfo, body, eenvinner = GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenv expr let entryPointInfo = match selfv with @@ -4215,7 +4215,7 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc selfv expr let (ilContractGenericParams, ilContractMethTyargs, ilContractTySpec: ILTypeSpec, ilContractFormalRetTy) = GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo let ilContractTypeRef = ilContractTySpec.TypeRef let ilContractTy = mkILFormalBoxedTy ilContractTypeRef ilContractGenericParams - let ilContractCtor = mkILNonGenericEmptyCtor None cenv.g.ilg.typ_Object + let ilContractCtor = mkILNonGenericEmptyCtor None cenv.g.ilg.typ_Object let ilContractMeths = [ilContractCtor; mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, ilContractMethTyargs, [], mkILReturn ilContractFormalRetTy, MethodBody.Abstract) ] let ilContractTypeDef = @@ -4247,7 +4247,7 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc selfv expr cgbuf.mgbuf.AddTypeDef(ilContractTypeRef, ilContractTypeDef, false, false, None) - let ilCtorBody = mkILMethodBody (true, [], 8, nonBranchingInstrsToCode (mkCallBaseConstructor(ilContractTy, [])), None ) + let ilCtorBody = mkILMethodBody (true, [], 8, nonBranchingInstrsToCode (mkCallBaseConstructor(ilContractTy, [])), None ) let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, cloinfo.localTypeFuncDirectILGenericParams, [], mkILReturn (cloinfo.cloILFormalRetTy), MethodBody.IL ilCloBody) ] let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.cloILFreeVars, cloinfo.ilCloLambdas, ilCtorBody, cloMethods, [], ilContractTy, []) cloTypeDefs @@ -4259,7 +4259,7 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc selfv expr cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) cloinfo, m - | _ -> failwith "GenLambda: not a lambda" + | _ -> failwith "GenLambda: not a lambda" and GenLambdaVal cenv (cgbuf: CodeGenBuffer) eenv (cloinfo, m) = GenGetLocalVals cenv cgbuf eenv m cloinfo.cloFreeVars @@ -4312,7 +4312,7 @@ and GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr = NestedTypeRefForCompLoc eenvouter.cloc cloName // Collect the free variables of the closure - let cloFreeVarResults = freeInExpr CollectTyparsAndLocals expr + let cloFreeVarResults = freeInExpr CollectTyparsAndLocals expr // Partition the free variables when some can be accessed from places besides the immediate environment // Also filter out the current value being bound, if any, as it is available from the "this" @@ -4340,7 +4340,7 @@ and GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr = // -- "internal" ones, which get used internally in the implementation let cloContractFreeTyvarSet = (freeInType CollectTypars (tyOfExpr cenv.g expr)).FreeTypars - let cloInternalFreeTyvars = Zset.diff cloFreeVarResults.FreeTyvars.FreeTypars cloContractFreeTyvarSet |> Zset.elements + let cloInternalFreeTyvars = Zset.diff cloFreeVarResults.FreeTyvars.FreeTypars cloContractFreeTyvarSet |> Zset.elements let cloContractFreeTyvars = cloContractFreeTyvarSet |> Zset.elements let cloFreeTyvars = cloContractFreeTyvars @ cloInternalFreeTyvars @@ -4356,7 +4356,7 @@ and GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr = // If generating a named closure, add the closure itself as a var, available via "arg0" . // The latter doesn't apply for the delegate implementation of closures. // Build the environment that is active inside the closure itself - let eenvinner = eenvinner |> AddStorageForLocalVals cenv.g (match selfv with | Some v -> [(v.Deref, Arg 0)] | _ -> []) + let eenvinner = eenvinner |> AddStorageForLocalVals cenv.g (match selfv with | Some v -> [(v.Deref, Arg 0)] | _ -> []) let ilCloFreeVars = let ilCloFreeVarNames = ChooseFreeVarNames takenNames (List.map nameOfVal cloFreeVars) @@ -4396,8 +4396,8 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = getCallStructure ((DropErasedTypars tvs) :: tvacc) vacc (body, bty) | Expr.Lambda (_, _, _, vs, body, _, bty) when not isLocalTypeFunc -> // Transform a lambda taking untupled arguments into one - // taking only a single tupled argument if necessary. REVIEW: do this earlier - let tupledv, body = MultiLambdaToTupledLambda cenv.g vs body + // taking only a single tupled argument if necessary. REVIEW: do this earlier + let tupledv, body = MultiLambdaToTupledLambda cenv.g vs body getCallStructure tvacc (tupledv :: vacc) (body, bty) | _ -> (List.rev tvacc, List.rev vacc, e, ety) @@ -4446,19 +4446,19 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = // abstract DirectInvoke : overall-type // } // - // class ContractImplementation : Contract { + // class ContractImplementation : Contract { // override DirectInvoke : overall-type { expr } // } // // For a non-local type function closure, this becomes // - // class FunctionImplementation : FSharpTypeFunc { + // class FunctionImplementation : FSharpTypeFunc { // override Specialize : overall-type { expr } // } // // For a normal function closure, is empty, and this becomes // - // class FunctionImplementation : overall-type { + // class FunctionImplementation : overall-type { // override Invoke(..) { expr } // } @@ -4473,9 +4473,9 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = // function values. /// Compute the contract if it is a local type function - let ilContractGenericParams = GenGenericParams cenv eenvinner cloContractFreeTyvars + let ilContractGenericParams = GenGenericParams cenv eenvinner cloContractFreeTyvars let ilContractGenericActuals = GenGenericArgs m eenvouter.tyenv cloContractFreeTyvars - let ilInternalGenericParams = GenGenericParams cenv eenvinner cloInternalFreeTyvars + let ilInternalGenericParams = GenGenericParams cenv eenvinner cloInternalFreeTyvars let ilInternalGenericActuals = GenGenericArgs m eenvouter.tyenv cloInternalFreeTyvars let ilCloGenericFormals = ilContractGenericParams @ ilInternalGenericParams @@ -4485,7 +4485,7 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = if isLocalTypeFunc then let rec strip lambdas acc = match lambdas with - | Lambdas_forall(gp, r) -> strip r (gp::acc) + | Lambdas_forall(gp, r) -> strip r (gp::acc) | Lambdas_return returnTy -> List.rev acc, returnTy, lambdas | _ -> failwith "AdjustNamedLocalTypeFuncIlxClosureInfo: local functions can currently only be type functions" strip ilCloLambdas [] @@ -4524,9 +4524,9 @@ and IsNamedLocalTypeFuncVal g (v: Val) expr = and GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo = let ilCloTypeRef = cloinfo.cloSpec.TypeRef let ilContractTypeRef = ILTypeRef.Create(scope=ilCloTypeRef.Scope, enclosing=ilCloTypeRef.Enclosing, name=ilCloTypeRef.Name + "$contract") - let eenvForContract = EnvForTypars cloinfo.localTypeFuncContractFreeTypars eenv + let eenvForContract = EnvForTypars cloinfo.localTypeFuncContractFreeTypars eenv let ilContractGenericParams = GenGenericParams cenv eenv cloinfo.localTypeFuncContractFreeTypars - let tvs, contractRetTy = + let tvs, contractRetTy = match cloinfo.cloExpr with | Expr.TyLambda(_, tvs, _, _, bty) -> tvs, bty | e -> [], tyOfExpr cenv.g e @@ -4574,11 +4574,11 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_, deleg let numthis = 1 let tmvs, body = BindUnitVars cenv.g (tmvs, List.replicate (List.concat slotsig.FormalParams).Length ValReprInfo.unnamedTopArg1, body) - // The slot sig contains a formal instantiation. When creating delegates we're only + // The slot sig contains a formal instantiation. When creating delegates we're only // interested in the actual instantiation since we don't have to emit a method impl. let ilDelegeeParams, ilDelegeeRet = GenActualSlotsig m cenv envForDelegeeUnderTypars slotsig methTyparsOfOverridingMethod tmvs - let envForDelegeeMeth = AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v, Arg (i+numthis))) tmvs) envForDelegeeUnderTypars + let envForDelegeeMeth = AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v, Arg (i+numthis))) tmvs) envForDelegeeUnderTypars let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], delegeeMethName, envForDelegeeMeth, 1, body, (if slotSigHasVoidReturnTy slotsig then discardAndReturnVoid else Return)) let delegeeInvokeMeth = mkILNonGenericInstanceMethod @@ -4619,11 +4619,11 @@ and GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, _m) sequel = // Generate discrimination trees //------------------------------------------------------------------------- -and IsSequelImmediate sequel = +and IsSequelImmediate sequel = match sequel with (* All of these can be done at the end of each branch - we don't need a real join point *) - | Return | ReturnVoid | Br _ | LeaveHandler _ -> true - | DiscardThen sequel -> IsSequelImmediate sequel + | Return | ReturnVoid | Br _ | LeaveHandler _ -> true + | DiscardThen sequel -> IsSequelImmediate sequel | _ -> false /// Generate a point where several branches of control flow can merge back together, e.g. after a conditional @@ -4646,7 +4646,7 @@ and GenJoinPoint cenv cgbuf pos eenv ty m sequel = // If something non-trivial happens after a discard then generate a join point, but first discard the value (often this means we won't generate it at all) | DiscardThen sequel -> - let stackAfterJoin = cgbuf.GetCurrentStack() + let stackAfterJoin = cgbuf.GetCurrentStack() let afterJoin = CG.GenerateDelayMark cgbuf (pos + "_join") DiscardThen (Br afterJoin), afterJoin, stackAfterJoin, sequel @@ -4722,7 +4722,7 @@ and GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeat GenPostponedDecisionTreeTargets cenv cgbuf stackAtTargets targetInfos sequel and TryFindTargetInfo targetInfos n = - match IntMap.tryFind n targetInfos with + match IntMap.tryFind n targetInfos with | Some (targetInfo, _) -> Some targetInfo | None -> None @@ -4739,7 +4739,7 @@ and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind let sp = GenSequencePointForBind cenv cgbuf bind GenBindingAfterSequencePoint cenv cgbuf eenv sp bind (Some startScope) - // We don't get the scope marks quite right for dtree-bound variables. This is because + // We don't get the scope marks quite right for dtree-bound variables. This is because // we effectively lose an EndLocalScope for all dtrees that go to the same target // So we just pretend that the variable goes out of scope here. CG.SetMarkToHere cgbuf endScope @@ -4748,7 +4748,7 @@ and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree | TDSuccess (es, targetIdx) -> GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets repeatSP targetInfos sequel - | TDSwitch(e, cases, dflt, m) -> + | TDSwitch(e, cases, dflt, m) -> GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases dflt m targets repeatSP targetInfos sequel and GetTarget (targets:_[]) n = @@ -4838,18 +4838,18 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau repeatSP() match cases with // optimize a test against a boolean value, i.e. the all-important if-then-else - | TCase(DecisionTreeTest.Const(Const.Bool b), successTree) :: _ -> + | TCase(DecisionTreeTest.Const(Const.Bool b), successTree) :: _ -> let failureTree = (match defaultTargetOpt with None -> cases.Tail.Head.CaseTree | Some d -> d) - GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e None eenv (if b then successTree else failureTree) (if b then failureTree else successTree) targets repeatSP targetInfos sequel + GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e None eenv (if b then successTree else failureTree) (if b then failureTree else successTree) targets repeatSP targetInfos sequel // // Remove a single test for a union case . Union case tests are always exa - //| [ TCase(DecisionTreeTest.UnionCase _, successTree) ] when (defaultTargetOpt.IsNone) -> + //| [ TCase(DecisionTreeTest.UnionCase _, successTree) ] when (defaultTargetOpt.IsNone) -> // GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv successTree targets repeatSP targetInfos sequel // //GenDecisionTree cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_Bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel // Optimize a single test for a union case to an "isdata" test - much // more efficient code, and this case occurs in the generated equality testers where perf is important - | TCase(DecisionTreeTest.UnionCase(c, tyargs), successTree) :: rest when rest.Length = (match defaultTargetOpt with None -> 1 | Some _ -> 0) -> + | TCase(DecisionTreeTest.UnionCase(c, tyargs), successTree) :: rest when rest.Length = (match defaultTargetOpt with None -> 1 | Some _ -> 0) -> let failureTree = match defaultTargetOpt with | None -> rest.Head.CaseTree @@ -4861,7 +4861,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau | _ -> let caseLabels = List.map (fun _ -> CG.GenerateDelayMark cgbuf "switch_case") cases - let firstDiscrim = cases.Head.Discriminator + let firstDiscrim = cases.Head.Discriminator match firstDiscrim with // Iterated tests, e.g. exception constructors, nulltests, typetests and active patterns. // These should always have one positive and one negative branch @@ -4896,7 +4896,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau let cuspec = GenUnionSpec cenv.amap m eenv.tyenv hdc.TyconRef tyargs let dests = if cases.Length <> caseLabels.Length then failwith "internal error: DecisionTreeTest.UnionCase" - (cases , caseLabels) ||> List.map2 (fun case label -> + (cases, caseLabels) ||> List.map2 (fun case label -> match case with | TCase(DecisionTreeTest.UnionCase (c, _), _) -> (c.Index, label.CodeLabel) | _ -> failwith "error: mixed constructor/const test?") @@ -4904,7 +4904,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib hdc.TyconRef EraseUnions.emitDataSwitch cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers, cuspec, dests) CG.EmitInstrs cgbuf (pop 1) Push0 [ ] // push/pop to match the line above - GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel + GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel | DecisionTreeTest.Const c -> GenExpr cenv cgbuf eenv SPSuppress e Continue @@ -4919,7 +4919,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau | Const.Char _ -> if List.length cases <> List.length caseLabels then failwith "internal error: " let dests = - (cases, caseLabels) ||> List.map2 (fun case label -> + (cases, caseLabels) ||> List.map2 (fun case label -> let i = match case.Discriminator with DecisionTreeTest.Const c' -> @@ -4947,7 +4947,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau CG.EmitInstr cgbuf (pop 1) Push0 (I_switch destinationLabels) else error(InternalError("non-dense integer matches not implemented in codegen - these should have been removed by the pattern match compiler", switchm)) - GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel + GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel | _ -> error(InternalError("these matches should never be needed", switchm)) and GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel = @@ -4971,7 +4971,7 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree match successTree, failureTree with // Peephole: if generating a boolean value or its negation then just leave it on the stack - // This comes up in the generated equality functions. REVIEW: do this as a peephole optimization elsewhere + // This comes up in the generated equality functions. REVIEW: do this as a peephole optimization elsewhere | TDSuccess(es1, n1), TDSuccess(es2, n2) when isNil es1 && isNil es2 && @@ -5013,7 +5013,7 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree match i with | Choice1Of2 (avoidHelpers, cuspec, idx) -> CG.EmitInstrs cgbuf pops pushes (EraseUnions.mkIsData cenv.g.ilg (avoidHelpers, cuspec, idx)) | Choice2Of2 i -> CG.EmitInstr cgbuf pops pushes i - CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (BI_brfalse, failure.CodeLabel)) + CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (BI_brfalse, failure.CodeLabel)) let targetInfos = GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv successTree targets repeatSP targetInfos sequel @@ -5021,9 +5021,9 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree /// Generate fixups for letrec bindings and GenLetRecFixup cenv cgbuf eenv (ilxCloSpec: IlxClosureSpec, e, ilField: ILFieldSpec, e2, _m) = - GenExpr cenv cgbuf eenv SPSuppress e Continue + GenExpr cenv cgbuf eenv SPSuppress e Continue CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass ilxCloSpec.ILType ] - GenExpr cenv cgbuf eenv SPSuppress e2 Continue + GenExpr cenv cgbuf eenv SPSuppress e2 Continue CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalStfld (mkILFieldSpec(ilField.FieldRef, ilxCloSpec.ILType)) ] /// Generate letrec bindings @@ -5044,17 +5044,17 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) = | Expr.Lambda _ | Expr.TyLambda _ | Expr.Obj _ -> let isLocalTypeFunc = Option.isSome selfv && (IsNamedLocalTypeFuncVal cenv.g (Option.get selfv) e) let selfv = (match e with Expr.Obj _ -> None | _ when isLocalTypeFunc -> None | _ -> Option.map mkLocalValRef selfv) - let clo, _, eenvclo = GetIlxClosureInfo cenv m isLocalTypeFunc selfv {eenv with letBoundVars=(mkLocalValRef boundv)::eenv.letBoundVars} e + let clo, _, eenvclo = GetIlxClosureInfo cenv m isLocalTypeFunc selfv {eenv with letBoundVars=(mkLocalValRef boundv)::eenv.letBoundVars} e clo.cloFreeVars |> List.iter (fun fv -> if Zset.contains fv forwardReferenceSet then match StorageForVal m fv eenvclo with | Env (_, _, ilField, _) -> fixups := (boundv, fv, (fun () -> GenLetRecFixup cenv cgbuf eenv (clo.cloSpec, access, ilField, exprForVal m fv, m))) :: !fixups | _ -> error (InternalError("GenLetRec: " + fv.LogicalName + " was not in the environment", m)) ) - | Expr.Val (vref, _, _) -> + | Expr.Val (vref, _, _) -> let fv = vref.Deref let needsFixup = Zset.contains fv forwardReferenceSet - if needsFixup then fixups := (boundv, fv, (fun () -> GenExpr cenv cgbuf eenv SPSuppress (set e) discard)) :: !fixups + if needsFixup then fixups := (boundv, fv, (fun () -> GenExpr cenv cgbuf eenv SPSuppress (set e) discard)) :: !fixups | _ -> failwith "compute real fixup vars" @@ -5078,7 +5078,7 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) = // Record the variable as defined let forwardReferenceSet = Zset.remove bind.Var forwardReferenceSet // Execute and discard any fixups that can now be committed - fixups := !fixups |> List.filter (fun (boundv, fv, action) -> if (Zset.contains boundv forwardReferenceSet || Zset.contains fv forwardReferenceSet) then true else (action(); false)) + fixups := !fixups |> List.filter (fun (boundv, fv, action) -> if (Zset.contains boundv forwardReferenceSet || Zset.contains fv forwardReferenceSet) then true else (action(); false)) forwardReferenceSet) () @@ -5121,7 +5121,7 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) s // There is no real reason we're doing this so late in the day match vspec.PublicPath, vspec.ReflectedDefinition with | Some _, Some e -> cgbuf.mgbuf.AddReflectedDefinition(vspec, e) - | _ -> () + | _ -> () let eenv = {eenv with letBoundVars= (mkLocalValRef vspec) :: eenv.letBoundVars} @@ -5150,7 +5150,7 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) s CommitStartScope cgbuf startScopeMarkOpt GenExpr cenv cgbuf eenv SPSuppress cctorBody discard - | Method (topValInfo, _, mspec, _, paramInfos, methodArgTys, retInfo) -> + | Method (topValInfo, _, mspec, _, paramInfos, methodArgTys, retInfo) -> let tps, ctorThisValOpt, baseValOpt, vsl, body', bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo rhsExpr let methodVars = List.concat vsl CommitStartScope cgbuf startScopeMarkOpt @@ -5184,7 +5184,7 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) s match optShadowLocal with | NoShadowLocal -> () | ShadowLocal storage -> - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) GenSetStorage m cgbuf storage | StaticField (fspec, vref, hasLiteralAttr, ilTyForProperty, ilPropName, fty, ilGetterMethRef, ilSetterMethRef, optShadowLocal) -> @@ -5202,7 +5202,7 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) s let ilFieldDef = match vref.LiteralValue with | Some konst -> ilFieldDef.WithLiteralDefaultValue( Some (GenFieldInit m konst) ) - | None -> ilFieldDef + | None -> ilFieldDef let ilFieldDef = let isClassInitializer = (cgbuf.MethodName = ".cctor") @@ -5261,7 +5261,7 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) s EmitSetStaticField cgbuf fspec | ShadowLocal storage-> CommitStartScope cgbuf startScopeMarkOpt - CG.EmitInstr cgbuf (pop 0) (Push [fty]) AI_dup + CG.EmitInstr cgbuf (pop 0) (Push [fty]) AI_dup EmitSetStaticField cgbuf fspec GenSetStorage m cgbuf storage @@ -5292,11 +5292,11 @@ and GenMarshal cenv attribs = attribs |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_MarshalAsAttribute >> not) match TryFindFSharpAttributeOpt cenv.g cenv.g.attrib_MarshalAsAttribute attribs with - | Some (Attrib(_, _, [ AttribInt32Arg unmanagedType ], namedArgs, _, _, m)) -> + | Some (Attrib(_, _, [ AttribInt32Arg unmanagedType ], namedArgs, _, _, m)) -> let decoder = AttributeDecoder namedArgs let rec decodeUnmanagedType unmanagedType = // enumeration values for System.Runtime.InteropServices.UnmanagedType taken from mscorlib.il - match unmanagedType with + match unmanagedType with | 0x0 -> ILNativeType.Empty | 0x01 -> ILNativeType.Void | 0x02 -> ILNativeType.Bool @@ -5372,7 +5372,7 @@ and GenMarshal cenv attribs = | "" -> 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) + | 0x1E -> ILNativeType.FixedArray (decoder.FindInt32 "SizeConst" 0x0) | 0x1F -> ILNativeType.Int | 0x20 -> ILNativeType.UInt | 0x22 -> ILNativeType.ByValStr @@ -5400,7 +5400,7 @@ and GenMarshal cenv attribs = | 0x30 -> ILNativeType.LPUTF8STR | _ -> ILNativeType.Empty Some(decodeUnmanagedType unmanagedType), otherAttribs - | Some (Attrib(_, _, _, _, _, _, m)) -> + | Some (Attrib(_, _, _, _, _, _, m)) -> errorR(Error(FSComp.SR.ilMarshalAsAttributeCannotBeDecoded(), m)) None, attribs | _ -> @@ -5424,7 +5424,7 @@ and GenParamAttribs cenv paramTy attribs = |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_OptionalAttribute >> not) |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_DefaultParameterValueAttribute >> not) - let Marshal, attribs = GenMarshal cenv attribs + let Marshal, attribs = GenMarshal cenv attribs inFlag, outFlag, optionalFlag, defaultValue, Marshal, attribs /// Generate IL parameters @@ -5491,7 +5491,7 @@ and GenReturnInfo cenv eenv ilRetTy (retInfo: ArgReprInfo) : ILReturn = /// Generate an IL property for a member and GenPropertyForMethodDef compileAsInstance tref mdef (v: Val) (memberInfo: ValMemberInfo) ilArgTys ilPropTy ilAttrs compiledName = - let name = match compiledName with | Some n -> n | _ -> v.PropertyName in (* chop "get_" *) + let name = match compiledName with | Some n -> n | _ -> v.PropertyName in (* chop "get_" *) ILPropertyDef(name = name, attributes = PropertyAttributes.None, @@ -5509,7 +5509,7 @@ and GenEventForProperty cenv eenvForMeth (mspec: ILMethodSpec) (v: Val) ilAttrsT let delegateTy = Infos.FindDelegateTypeOfPropertyEvent cenv.g cenv.amap evname m returnTy let ilDelegateTy = GenType cenv.amap m eenvForMeth.tyenv delegateTy let ilThisTy = mspec.DeclaringType - let addMethRef = mkILMethRef (ilThisTy.TypeRef, mspec.CallingConv, "add_" + evname, 0, [ilDelegateTy], ILType.Void) + let addMethRef = mkILMethRef (ilThisTy.TypeRef, mspec.CallingConv, "add_" + evname, 0, [ilDelegateTy], ILType.Void) let removeMethRef = mkILMethRef (ilThisTy.TypeRef, mspec.CallingConv, "remove_" + evname, 0, [ilDelegateTy], ILType.Void) ILEventDef(eventType = Some ilDelegateTy, name= evname, @@ -5559,7 +5559,7 @@ and ComputeFlagFixupsForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) = and ComputeMethodImplAttribs cenv (_v: Val) attrs = let implflags = match TryFindFSharpAttribute cenv.g cenv.g.attrib_MethodImplAttribute attrs with - | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags + | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags | _ -> 0x0 let hasPreserveSigAttr = @@ -5595,7 +5595,7 @@ and GenMethodForBinding match methodVars with | [] -> error(InternalError("Internal error: empty argument list for instance method", v.Range)) | h::t -> [h], t, true - | _ -> [], methodVars, false + | _ -> [], methodVars, false let nonUnitNonSelfMethodVars, body = BindUnitVars cenv.g (nonSelfMethodVars, paramInfos, body) let nonUnitMethodVars = selfMethodVars@nonUnitNonSelfMethodVars @@ -5609,7 +5609,7 @@ and GenMethodForBinding let eenvUnderMethLambdaTypars = EnvForTypars tps eenv let eenvUnderMethTypeTypars = EnvForTypars cmtps eenv - // Add the arguments to the environment. We add an implicit 'this' argument to constructors + // Add the arguments to the environment. We add an implicit 'this' argument to constructors let isCtor = v.IsConstructor let eenvForMeth = let eenvForMeth = eenvUnderMethLambdaTypars @@ -5628,12 +5628,12 @@ and GenMethodForBinding // Now generate the code. let hasPreserveSigNamedArg, ilMethodBody, hasDllImport = match TryFindFSharpAttributeOpt cenv.g cenv.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 - | Some (Attrib(_, _, _, _, _, _, m)) -> + | Some (Attrib(_, _, _, _, _, _, m)) -> error(Error(FSComp.SR.ilDllImportAttributeCouldNotBeDecoded(), m)) | _ -> @@ -5663,7 +5663,7 @@ and GenMethodForBinding let sourceNameAttribs, compiledName = match v.Attribs |> List.tryFind (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_CompiledNameAttribute) with - | Some (Attrib(_, _, [ AttribStringArg(b) ], _, _, _, _)) -> [ mkCompilationSourceNameAttr cenv.g v.LogicalName ], Some b + | Some (Attrib(_, _, [ AttribStringArg(b) ], _, _, _, _)) -> [ mkCompilationSourceNameAttr cenv.g v.LogicalName ], Some b | _ -> [], None // check if the hasPreserveSigNamedArg and hasSynchronizedImplFlag implementation flags have been specified @@ -5676,7 +5676,7 @@ and GenMethodForBinding let secDecls = if List.isEmpty securityAttributes then emptyILSecurityDecls else mkILSecurityDecls permissionSets // Do not push the attributes to the method for events and properties - let ilAttrsCompilerGenerated = if v.IsCompilerGenerated then [ cenv.g.CompilerGeneratedAttribute ] else [] + let ilAttrsCompilerGenerated = if v.IsCompilerGenerated then [ cenv.g.CompilerGeneratedAttribute ] else [] let ilAttrsThatGoOnPrimaryItem = [ yield! GenAttrs cenv eenv attrs @@ -5757,7 +5757,7 @@ and GenMethodForBinding let isAbstract = memberInfo.MemberFlags.IsDispatchSlot && - let tcref = v.MemberApparentEntity + let tcref = v.MemberApparentEntity not tcref.Deref.IsFSharpDelegateTycon let mdef = @@ -5767,12 +5767,12 @@ and GenMethodForBinding match memberInfo.MemberFlags.MemberKind with - | (MemberKind.PropertySet | MemberKind.PropertyGet) -> + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> if not (isNil ilMethTypars) then error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression", v.Range)) // Check if we're compiling the property as a .NET event - if CompileAsEvent cenv.g v.Attribs then + if CompileAsEvent cenv.g v.Attribs then // Emit the pseudo-property as an event, but not if its a private method impl if mdef.Access <> ILMemberAccess.Private then @@ -5804,7 +5804,7 @@ and GenMethodForBinding match v.MemberInfo with | Some memberInfo when v.IsExtensionMember -> match memberInfo.MemberFlags.MemberKind with - | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter | _ -> ilAttrsThatGoOnPrimaryItem | _ -> ilAttrsThatGoOnPrimaryItem @@ -5834,7 +5834,7 @@ and GenPInvokeMethod (nm, dll, namedArgs) = | 2 -> PInvokeCharEncoding.Ansi | 3 -> PInvokeCharEncoding.Unicode | 4 -> PInvokeCharEncoding.Auto - | _ -> PInvokeCharEncoding.None + | _ -> PInvokeCharEncoding.None NoMangle= decoder.FindBool "ExactSpelling" false LastError= decoder.FindBool "SetLastError" false ThrowOnUnmappableChar= if (decoder.FindBool "ThrowOnUnmappableChar" false) then PInvokeThrowOnUnmappableChar.Enabled else PInvokeThrowOnUnmappableChar.UseAssembly @@ -5859,7 +5859,7 @@ and GenSetVal cenv cgbuf eenv (vref, e, m) sequel = and GenGetValRefAndSequel cenv cgbuf eenv m (v: ValRef) fetchSequel = let ty = v.Type - GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) (StorageForValRef m v eenv) fetchSequel + GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) (StorageForValRef m v eenv) fetchSequel and GenGetVal cenv cgbuf eenv (v: ValRef, m) sequel = GenGetValRefAndSequel cenv cgbuf eenv m v None @@ -5893,7 +5893,7 @@ and CommitStartScope cgbuf startScopeMarkOpt = | None -> () | Some ss -> cgbuf.SetMarkToHere(ss) -and EmitInitLocal cgbuf ty idx = CG.EmitInstrs cgbuf (pop 0) Push0 [I_ldloca (uint16 idx); (I_initobj ty) ] +and EmitInitLocal cgbuf ty idx = CG.EmitInstrs cgbuf (pop 0) Push0 [I_ldloca (uint16 idx); (I_initobj ty) ] and EmitSetLocal cgbuf idx = CG.EmitInstr cgbuf (pop 1) Push0 (mkStloc (uint16 idx)) @@ -5912,7 +5912,7 @@ and GenSetStorage m cgbuf storage = | StaticField (_, _, hasLiteralAttr, ilContainerTy, _, _, _, ilSetterMethRef, _) -> if hasLiteralAttr then errorR(Error(FSComp.SR.ilLiteralFieldsCannotBeSet(), m)) - CG.EmitInstr cgbuf (pop 1) Push0 (I_call(Normalcall, mkILMethSpecForMethRefInTy(ilSetterMethRef, ilContainerTy, []), None)) + CG.EmitInstr cgbuf (pop 1) Push0 (I_call(Normalcall, mkILMethSpecForMethRefInTy(ilSetterMethRef, ilContainerTy, []), None)) | StaticProperty (ilGetterMethSpec, _) -> error(Error(FSComp.SR.ilStaticMethodIsNotLambda(ilGetterMethSpec.Name), m)) @@ -5928,7 +5928,7 @@ and GenSetStorage m cgbuf storage = | Env (_, _, ilField, _) -> // Note: ldarg0 has already been emitted in GenSetVal - CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld ilField) + CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld ilField) and CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel = match localCloInfo, storeSequel with @@ -5953,11 +5953,11 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = if hasLiteralAttr then EmitGetStaticField cgbuf ilTy fspec else - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call(Normalcall, mkILMethSpecForMethRefInTy (ilGetterMethRef, ilContainerTy, []), None)) + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call(Normalcall, mkILMethSpecForMethRefInTy (ilGetterMethRef, ilContainerTy, []), None)) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel | StaticProperty (ilGetterMethSpec, _) -> - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel | Method (topValInfo, vref, mspec, _, _, _, _) -> @@ -5980,7 +5980,7 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = MakeApplicationAndBetaReduce cenv.g (expr, exprty, [tyargs'], args, m) GenExpr cenv cgbuf eenv SPSuppress specializedExpr sequel - | Null -> + | Null -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldnull) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel @@ -6015,7 +6015,7 @@ and AllocLocal cenv cgbuf eenv compgen (v, ty, isFixed) (scopeMarks: Mark * Mark cgbuf.ReallocLocal((fun i (_, ty', isFixed') -> not isFixed' && not isFixed && not (IntMap.mem i eenv.liveLocals) && (ty = ty')), ranges, ty, isFixed) else cgbuf.AllocLocal(ranges, ty, isFixed), false - j, realloc, { eenv with liveLocals = IntMap.add j () eenv.liveLocals } + j, realloc, { eenv with liveLocals = IntMap.add j () eenv.liveLocals } /// Decide storage for local value and if necessary allocate an ILLocal for it and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = @@ -6103,7 +6103,7 @@ and AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v eenv = /// Save the stack /// - [gross] because IL flushes the stack at the exn. handler -/// - and because IL requires empty stack following a forward br (jump). +/// - and because IL requires empty stack following a forward br (jump). and EmitSaveStack cenv cgbuf eenv m scopeMarks = let savedStack = (cgbuf.GetCurrentStack()) let savedStackLocals, eenvinner = @@ -6128,7 +6128,7 @@ 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 @@ -6138,28 +6138,28 @@ and GenAttribArg amap g eenv x (ilArgTy: ILType) = match c with | Const.Bool b -> ILAttribElem.Bool b - | Const.Int32 i when isobj || tynm = "System.Int32" -> ILAttribElem.Int32 ( i) - | Const.Int32 i when tynm = "System.SByte" -> ILAttribElem.SByte (sbyte i) - | Const.Int32 i when tynm = "System.Int16" -> ILAttribElem.Int16 (int16 i) - | Const.Int32 i when tynm = "System.Byte" -> ILAttribElem.Byte (byte i) + | Const.Int32 i when isobj || tynm = "System.Int32" -> ILAttribElem.Int32 ( i) + | Const.Int32 i when tynm = "System.SByte" -> ILAttribElem.SByte (sbyte i) + | Const.Int32 i when tynm = "System.Int16" -> ILAttribElem.Int16 (int16 i) + | Const.Int32 i when tynm = "System.Byte" -> ILAttribElem.Byte (byte i) | Const.Int32 i when tynm = "System.UInt16" ->ILAttribElem.UInt16 (uint16 i) | Const.Int32 i when tynm = "System.UInt32" ->ILAttribElem.UInt32 (uint32 i) | Const.Int32 i when tynm = "System.UInt64" ->ILAttribElem.UInt64 (uint64 (int64 i)) - | Const.SByte i -> ILAttribElem.SByte i - | Const.Int16 i -> ILAttribElem.Int16 i - | Const.Int32 i -> ILAttribElem.Int32 i - | Const.Int64 i -> ILAttribElem.Int64 i - | Const.Byte i -> ILAttribElem.Byte i - | Const.UInt16 i -> ILAttribElem.UInt16 i - | Const.UInt32 i -> ILAttribElem.UInt32 i - | Const.UInt64 i -> ILAttribElem.UInt64 i - | Const.Double i -> ILAttribElem.Double i + | Const.SByte i -> ILAttribElem.SByte i + | Const.Int16 i -> ILAttribElem.Int16 i + | Const.Int32 i -> ILAttribElem.Int32 i + | Const.Int64 i -> ILAttribElem.Int64 i + | Const.Byte i -> ILAttribElem.Byte i + | Const.UInt16 i -> ILAttribElem.UInt16 i + | Const.UInt32 i -> ILAttribElem.UInt32 i + | Const.UInt64 i -> ILAttribElem.UInt64 i + | Const.Double i -> ILAttribElem.Double i | Const.Single i -> ILAttribElem.Single i - | Const.Char i -> ILAttribElem.Char i - | Const.Zero when isobj -> ILAttribElem.Null - | Const.Zero when tynm = "System.String" -> ILAttribElem.String None - | Const.Zero when tynm = "System.Type" -> ILAttribElem.Type None - | Const.String i when isobj || tynm = "System.String" -> ILAttribElem.String (Some i) + | Const.Char i -> ILAttribElem.Char i + | Const.Zero when isobj -> ILAttribElem.Null + | Const.Zero when tynm = "System.String" -> ILAttribElem.String None + | Const.Zero when tynm = "System.Type" -> ILAttribElem.Type None + | Const.String i when isobj || tynm = "System.String" -> ILAttribElem.String (Some i) | _ -> error (InternalError ( "The type '" + tynm + "' may not be used as a custom attribute value", m)) // Detect '[| ... |]' nodes @@ -6168,11 +6168,11 @@ and GenAttribArg amap g eenv x (ilArgTy: ILType) = ILAttribElem.Array (ilElemTy, List.map (fun arg -> GenAttribArg amap g eenv arg ilElemTy) args) // Detect 'typeof' calls - | TypeOfExpr g ty, _ -> + | TypeOfExpr g ty, _ -> ILAttribElem.Type (Some (GenType amap x.Range eenv.tyenv ty)) // Detect 'typedefof' calls - | TypeDefOfExpr g ty, _ -> + | TypeDefOfExpr g ty, _ -> ILAttribElem.TypeRef (Some (GenType amap x.Range eenv.tyenv ty).TypeRef) // Ignore upcasts @@ -6198,7 +6198,7 @@ and GenAttribArg amap g eenv x (ilArgTy: ILType) = | ILAttribElem.UInt16 i1, ILAttribElem.UInt16 i2-> ILAttribElem.UInt16 (i1 ||| i2) | ILAttribElem.UInt32 i1, ILAttribElem.UInt32 i2-> ILAttribElem.UInt32 (i1 ||| i2) | ILAttribElem.UInt64 i1, ILAttribElem.UInt64 i2-> ILAttribElem.UInt64 (i1 ||| i2) - | _ -> error (InternalError ("invalid custom attribute value (not a valid constant): " + showL (exprL x), x.Range)) + | _ -> error (InternalError ("invalid custom attribute value (not a valid constant): " + showL (exprL x), x.Range)) // Other expressions are not valid custom attribute values | _ -> @@ -6230,7 +6230,7 @@ and GenCompilationArgumentCountsAttr cenv (v: Val) = let arities = if ValSpecIsCompiledAsInstance cenv.g v then List.tail tvi.AritiesOfArgs else tvi.AritiesOfArgs if arities.Length > 1 then yield mkCompilationArgumentCountsAttr cenv.g arities - | _ -> + | _ -> () ] // Create a permission set for a list of security attributes @@ -6252,7 +6252,7 @@ and CreatePermissionSets cenv eenv (securityAttributes: Attrib list) = //-------------------------------------------------------------------------- /// Generate a static class at the given cloc -and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attribs, initTrigger, eliminateIfEmpty, addAtEnd) = +and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attribs, initTrigger, eliminateIfEmpty, addAtEnd) = let tref = TypeRefForCompLoc cloc let tdef = mkILSimpleClass cenv.g.ilg @@ -6273,11 +6273,11 @@ and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attr mgbuf.AddTypeDef(tref, tdef, eliminateIfEmpty, addAtEnd, None) -and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = +and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = let (ModuleOrNamespaceExprWithSig(mty, def, _)) = x // REVIEW: the scopeMarks are used for any shadow locals we create for the module bindings // We use one scope for all the bindings in the module, which makes them all appear with their "default" values - // rather than incrementally as we step through the initializations in the module. This is a little unfortunate + // rather than incrementally as we step through the initializations in the module. This is a little unfortunate // but stems from the way we add module values all at once before we generate the module itself. LocalScope "module" cgbuf (fun scopeMarks -> let sigToImplRemapInfo = ComputeRemappingFromImplementationToSignature cenv.g def mty @@ -6288,10 +6288,10 @@ and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = AddBindingsForModuleDef allocVal eenv.cloc eenv def GenModuleDef cenv cgbuf qname lazyInitInfo eenv def) -and GenModuleDefs cenv cgbuf qname lazyInitInfo eenv mdefs = +and GenModuleDefs cenv cgbuf qname lazyInitInfo eenv mdefs = mdefs |> List.iter (GenModuleDef cenv cgbuf qname lazyInitInfo eenv) -and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x = +and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x = match x with | TMDefRec(_isRec, tycons, mbinds, m) -> tycons |> List.iter (fun tc -> @@ -6310,7 +6310,7 @@ and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x = GenModuleExpr cenv cgbuf qname lazyInitInfo eenv mexpr | TMDefs(mdefs) -> - GenModuleDefs cenv cgbuf qname lazyInitInfo eenv mdefs + GenModuleDefs cenv cgbuf qname lazyInitInfo eenv mdefs // Generate a module binding @@ -6326,7 +6326,7 @@ and GenModuleBinding cenv (cgbuf: CodeGenBuffer) (qname: QualifiedNameOfFile) la if mspec.IsNamespace then eenv else {eenv with cloc = CompLocForFixedModule cenv.opts.fragName qname.Text mspec } - // Create the class to hold the contents of this module. No class needed if + // Create the class to hold the contents of this module. No class needed if // we're compiling it as a namespace. // // Most module static fields go into the "InitClass" static class. @@ -6351,7 +6351,7 @@ and GenModuleBinding cenv (cgbuf: CodeGenBuffer) (qname: QualifiedNameOfFile) la /// Generate the namespace fragments in a single file -and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplicitEntryPoint, isScript, anonRecdTypes), optimizeDuringCodeGen) = +and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplicitEntryPoint, isScript, anonRecdTypes), optimizeDuringCodeGen) = let m = qname.Range @@ -6409,7 +6409,7 @@ and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile(qname, CG.EmitInstr cgbuf (pop 0) Push0 I_ret), m) // The code generation for the initialization is now complete and the IL code is in topCode. - // Make a .cctor and/or main method to contain the code. This initializes all modules. + // Make a .cctor and/or main method to contain the code. This initializes all modules. // Library file (mainInfoOpt = None) : optional .cctor if topCode has initialization effect // Final file, explicit entry point (mainInfoOpt = Some _, GetExplicitEntryPointInfo() = Some) : main + optional .cctor if topCode has initialization effect // Final file, implicit entry point (mainInfoOpt = Some _, GetExplicitEntryPointInfo() = None) : main + initialize + optional .cctor calling initialize @@ -6470,7 +6470,7 @@ and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile(qname, if doesSomething then // Add the cctor - let cctorMethDef = mkILClassCtor (MethodBody.IL topCode) + let cctorMethDef = mkILClassCtor (MethodBody.IL topCode) mgbuf.AddMethodDef(initClassTy.TypeRef, cctorMethDef) @@ -6503,7 +6503,7 @@ and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile(qname, // We add the module type all over again. Note no shadow locals for static fields needed here since they are only relevant to the main/.cctor let eenvafter = let allocVal = ComputeAndAddStorageForLocalTopVal (cenv.amap, cenv.g, cenv.intraAssemblyInfo, cenv.opts.isInteractive, NoShadowLocal) - AddBindingsForLocalModuleType allocVal clocCcu eenv mexpr.Type + AddBindingsForLocalModuleType allocVal clocCcu eenv mexpr.Type eenvafter @@ -6624,7 +6624,7 @@ and GenToStringMethod cenv eenv ilThisTy m = // call the function returned by sprintf yield mkLdarg0 if ilThisTy.Boxity = ILBoxity.AsValue then - yield mkNormalLdobj ilThisTy ] @ + yield mkNormalLdobj ilThisTy ] @ callInstrs), None)) let mdef = mdef.With(customAttrs = mkILCustomAttrs [ cenv.g.CompilerGeneratedAttribute ]) @@ -6645,15 +6645,15 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let eenvinner = ReplaceTyenv (TypeReprEnv.ForTycon tycon) eenv let thisTy = generalizedTyconRef tcref - let ilThisTy = GenType cenv.amap m eenvinner.tyenv thisTy + let ilThisTy = GenType cenv.amap m eenvinner.tyenv thisTy let tref = ilThisTy.TypeRef - let ilGenParams = GenGenericParams cenv eenvinner tycon.TyparsNoRange - let ilIntfTys = tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenvinner.tyenv) - let ilTypeName = tref.Name + let ilGenParams = GenGenericParams cenv eenvinner tycon.TyparsNoRange + let ilIntfTys = tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenvinner.tyenv) + let ilTypeName = tref.Name - let hidden = IsHiddenTycon eenv.sigToImplRemapInfo tycon + let hidden = IsHiddenTycon eenv.sigToImplRemapInfo tycon let hiddenRepr = hidden || IsHiddenTyconRepr eenv.sigToImplRemapInfo tycon - let access = ComputeTypeAccess tref hidden + let access = ComputeTypeAccess tref hidden // The implicit augmentation doesn't actually create CompareTo(object) or Object.Equals // So we do it here. @@ -6689,12 +6689,12 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let abstractPropDefs = abstractPropDefs |> MergePropertyDefs m - let isAbstract = isAbstractTycon tycon + let isAbstract = isAbstractTycon tycon // Generate all the method impls showing how various abstract slots and interface slots get implemented // REVIEW: no method impl generated for IStructuralHash or ICompare let methodImpls = - [ for vref in tycon.MembersOfFSharpTyconByName |> NameMultiMap.range do + [ for vref in tycon.MembersOfFSharpTyconByName |> NameMultiMap.range do assert(vref.IsMember) let memberInfo = vref.MemberInfo.Value if memberInfo.MemberFlags.IsOverrideOrExplicitImpl && not (CompileAsEvent cenv.g vref.Attribs) then @@ -6729,7 +6729,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = | None -> None | Some memberInfo -> match name, memberInfo.MemberFlags.MemberKind with - | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal cenv.g vref.Deref)) -> + | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal cenv.g vref.Deref)) -> Some( mkILCustomAttribute cenv.g.ilg (cenv.g.FindSysILTypeRef "System.Reflection.DefaultMemberAttribute", [cenv.g.ilg.typ_String], [ILAttribElem.String(Some(name))], []) ) | _ -> None) |> Option.toList @@ -6749,7 +6749,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilDebugDisplayAttributes = [ yield! GenAttrs cenv eenv debugDisplayAttrs if generateDebugDisplayAttribute then - yield cenv.g.mkDebuggerDisplayAttribute ("{" + debugDisplayMethodName + "(),nq}") ] + yield cenv.g.mkDebuggerDisplayAttribute ("{" + debugDisplayMethodName + "(),nq}") ] let ilCustomAttrs = @@ -6757,19 +6757,19 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = yield! normalAttrs |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_StructLayoutAttribute >> not) |> GenAttrs cenv eenv - yield! ilDebugDisplayAttributes ] + yield! ilDebugDisplayAttributes ] let reprAccess = ComputeMemberAccess hiddenRepr let ilTypeDefKind = - match tyconRepr with + match tyconRepr with | TFSharpObjectRepr o -> match o.fsobjmodel_kind with - | TTyconClass -> ILTypeDefKind.Class - | TTyconStruct -> ILTypeDefKind.ValueType - | TTyconInterface -> ILTypeDefKind.Interface - | TTyconEnum -> ILTypeDefKind.Enum + | TTyconClass -> ILTypeDefKind.Class + | TTyconStruct -> ILTypeDefKind.ValueType + | TTyconInterface -> ILTypeDefKind.Interface + | TTyconEnum -> ILTypeDefKind.Enum | TTyconDelegate _ -> ILTypeDefKind.Delegate | TRecdRepr _ | TUnionRepr _ when tycon.IsStructOrEnumTycon -> ILTypeDefKind.ValueType | _ -> ILTypeDefKind.Class @@ -6784,7 +6784,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = isEmptyStruct && cenv.opts.workAroundReflectionEmitBugs && not tycon.TyparsNoRange.IsEmpty // Compute a bunch of useful things for each field - let isCLIMutable = (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_CLIMutableAttribute tycon.Attribs = Some true) + let isCLIMutable = (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_CLIMutableAttribute tycon.Attribs = Some true) let fieldSummaries = [ for fspec in tycon.AllFieldsArray do @@ -6812,9 +6812,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilFieldOffset = match TryFindFSharpAttribute cenv.g cenv.g.attrib_FieldOffsetAttribute fspec.FieldAttribs with - | Some (Attrib(_, _, [ AttribInt32Arg(fieldOffset) ], _, _, _, _)) -> + | Some (Attrib(_, _, [ AttribInt32Arg(fieldOffset) ], _, _, _, _)) -> Some fieldOffset - | Some (Attrib(_, _, _, _, _, _, m)) -> + | Some (Attrib(_, _, _, _, _, _, m)) -> errorR(Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded(), m)) None | _ -> @@ -6852,14 +6852,14 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let literalValue = Option.map (GenFieldInit m) fspec.LiteralValue let fdef = - ILFieldDef(name = ilFieldName, - fieldType = ilPropType, - attributes = enum 0, - data = None, - literalValue = None, - offset = ilFieldOffset, - marshal = None, - customAttrs = mkILCustomAttrs (GenAttrs cenv eenv fattribs @ extraAttribs)) + ILFieldDef(name = ilFieldName, + fieldType = ilPropType, + attributes = enum 0, + data = None, + literalValue = None, + offset = ilFieldOffset, + marshal = None, + customAttrs = mkILCustomAttrs (GenAttrs cenv eenv fattribs @ extraAttribs)) .WithAccess(access) .WithStatic(isStatic) .WithSpecialName(ilFieldName="value__" && tycon.IsEnumTycon) @@ -6888,7 +6888,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = propertyType= ilPropType, init= None, args= [], - customAttrs = mkILCustomAttrs ilFieldAttrs) ] + customAttrs = mkILCustomAttrs ilFieldAttrs) ] let methodDefs = [ // Generate property getter methods for those fields that have properties @@ -6954,7 +6954,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = // call the function returned by sprintf yield mkLdarg0 if ilThisTy.Boxity = ILBoxity.AsValue then - yield mkNormalLdobj ilThisTy ] @ + yield mkNormalLdobj ilThisTy ] @ callInstrs), None)) yield ilMethodDef.WithSpecialName |> AddNonUserCompilerGeneratedAttribs cenv.g @@ -6989,7 +6989,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilMethodDef = mkILSimpleStorageCtorWithParamNames(None, spec, ilThisTy, [], ChooseParamNames fieldNamesAndTypes, reprAccess) yield ilMethodDef - // FSharp 1.0 bug 1988: Explicitly setting the ComVisible(true) attribute on an F# type causes an F# record to be emitted in a way that enables mutation for COM interop scenarios + // FSharp 1.0 bug 1988: Explicitly setting the ComVisible(true) attribute on an F# type causes an F# record to be emitted in a way that enables mutation for COM interop scenarios // FSharp 3.0 feature: adding CLIMutable to a record type causes emit of default constructor, and all fields get property setters // Records that are value types do not create a default constructor with CLIMutable or ComVisible if not isStructRecord && (isCLIMutable || (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) then @@ -7032,7 +7032,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let tdef = tdef.With(customAttrs = mkILCustomAttrs ilCustomAttrs, genericParams = ilGenParams) tdef, None - | TRecdRepr _ | TFSharpObjectRepr _ as tyconRepr -> + | TRecdRepr _ | TFSharpObjectRepr _ as tyconRepr -> let super = superOfTycon cenv.g tycon let ilBaseTy = GenType cenv.amap m eenvinner.tyenv super @@ -7075,7 +7075,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let tdLayout, tdEncoding = match TryFindFSharpAttribute cenv.g cenv.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 @@ -7096,7 +7096,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = | 0x2 -> ILTypeDefLayout.Explicit layoutInfo | _ -> ILTypeDefLayout.Auto tdLayout, tdEncoding - | Some (Attrib(_, _, _, _, _, _, m)) -> + | Some (Attrib(_, _, _, _, _, _, m)) -> errorR(Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded(), m)) ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi @@ -7171,7 +7171,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = else SourceConstructFlags.SumType)) ]) let tdef = ILTypeDef(name = ilTypeName, - layout = layout, + layout = layout, attributes = enum 0, genericParams = ilGenParams, customAttrs = cattrs, @@ -7204,7 +7204,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = (cuinfo.cudHasHelpers = SpecialFSharpOptionHelpers && (md.Name = "get_Value" || md.Name = "get_None" || md.Name = "Some"))), (fun (pd: ILPropertyDef) -> - (cuinfo.cudHasHelpers = SpecialFSharpListHelpers && (pd.Name = "Empty" || pd.Name = "IsEmpty" )) || + (cuinfo.cudHasHelpers = SpecialFSharpListHelpers && (pd.Name = "Empty" || pd.Name = "IsEmpty" )) || (cuinfo.cudHasHelpers = SpecialFSharpOptionHelpers && (pd.Name = "Value" || pd.Name = "None")))) tdef2, tdefDiscards @@ -7228,7 +7228,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = /// Generate the type for an F# exception declaration. and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = - let exncref = mkLocalEntityRef exnc + let exncref = mkLocalEntityRef exnc match exnc.ExceptionInfo with | TExnAbbrevRepr _ | TExnAsmRepr _ | TExnNone -> () | TExnFresh _ -> @@ -7284,8 +7284,8 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = [ mkLdarg0 mkLdarg 1us mkLdarg 2us - mkNormalCall (mkILCtorMethSpecForTy (cenv.g.iltyp_Exception, [serializationInfoType; streamingContextType])) ] - , None)) + mkNormalCall (mkILCtorMethSpecForTy (cenv.g.iltyp_Exception, [serializationInfoType; streamingContextType])) ], + None)) //#if BE_SECURITY_TRANSPARENT [ilCtorDefForSerialziation] @@ -7321,7 +7321,7 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = let ilTypeName = tref.Name - let interfaces = exnc.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenv.tyenv) + let interfaces = exnc.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenv.tyenv) let tdef = mkILGenericClass (ilTypeName, access, [], cenv.g.iltyp_Exception, @@ -7343,7 +7343,7 @@ let CodegenAssembly cenv eenv mgbuf fileImpls = let eenv = List.fold (GenTopImpl cenv mgbuf None) eenv a let eenv = GenTopImpl cenv mgbuf cenv.opts.mainMethodInfo eenv b - // Some constructs generate residue types and bindings. Generate these now. They don't result in any + // Some constructs generate residue types and bindings. Generate these now. They don't result in any // top-level initialization code. begin let extraBindings = mgbuf.GrabExtraBindingsToGenerate() @@ -7570,7 +7570,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai /// Register a fragment of the current assembly with the ILX code generator. If 'isIncrementalFragment' is true then the input /// is assumed to be a fragment 'typed' into FSI.EXE, otherwise the input is assumed to be the result of a '#load' - member __.AddIncrementalLocalAssemblyFragment (isIncrementalFragment, fragName, typedImplFiles) = + member __.AddIncrementalLocalAssemblyFragment (isIncrementalFragment, fragName, typedImplFiles) = ilxGenEnv <- AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap, isIncrementalFragment, tcGlobals, ccu, fragName, intraAssemblyInfo, ilxGenEnv, typedImplFiles) /// Generate ILX code for an assembly fragment diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index 1c5525722e0..2a2bfd7ea67 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -108,7 +108,7 @@ type PropertyCollector(g, amap, m, ty, optFilter, ad) = let add pinfo = match props.TryGetValue(pinfo), pinfo with - | (true, FSProp (_, ty, Some vref1 , _)), FSProp (_, _, _, Some vref2) + | (true, FSProp (_, ty, Some vref1, _)), FSProp (_, _, _, Some vref2) | (true, FSProp (_, ty, _, Some vref2)), FSProp (_, _, Some vref1, _) -> let pinfo = FSProp (g, ty, Some vref1, Some vref2) props.[pinfo] <- pinfo @@ -217,7 +217,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = let st = info.ProvidedType match optFilter with | None -> - [ for fi in st.PApplyArray((fun st -> st.GetFields()), "GetFields" , m) -> ProvidedField(amap, fi, m) ] + [ for fi in st.PApplyArray((fun st -> st.GetFields()), "GetFields", m) -> ProvidedField(amap, fi, m) ] | Some name -> match st.PApply ((fun st -> st.GetField name), m) with | Tainted.Null -> [] @@ -242,7 +242,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = let st = info.ProvidedType match optFilter with | None -> - [ for ei in st.PApplyArray((fun st -> st.GetEvents()), "GetEvents" , m) -> ProvidedEvent(amap, ei, m) ] + [ for ei in st.PApplyArray((fun st -> st.GetEvents()), "GetEvents", m) -> ProvidedEvent(amap, ei, m) ] | Some name -> match st.PApply ((fun st -> st.GetEvent name), m) with | Tainted.Null -> [] diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index d66610c3c10..53fa7baa3a7 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -63,9 +63,9 @@ let emptyTR = TreeNode[] // and combined form, so this function should not be needed let destApp (f, fty, tys, args, m) = match stripExpr f with - | Expr.App (f2, fty2, tys2, [] , _) -> (f2, fty2, tys2 @ tys, args, m) - | Expr.App _ -> (f, fty, tys, args, m) (* has args, so not combine ty args *) - | f -> (f, fty, tys, args, m) + | Expr.App (f2, fty2, tys2, [], _) -> (f2, fty2, tys2 @ tys, args, m) + | Expr.App _ -> (f, fty, tys, args, m) (* has args, so not combine ty args *) + | f -> (f, fty, tys, args, m) #if DEBUG let showTyparSet tps = showL (commaListL (List.map typarL (Zset.elements tps))) @@ -320,7 +320,7 @@ type ReqdItem = let reqdItemOrder = let rep = function - | ReqdSubEnv v -> true , v + | ReqdSubEnv v -> true, v | ReqdVal v -> false, v Order.orderOn rep (Pair.order (Bool.order, valOrder)) diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 279376b3d62..9e8206ca7f0 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. /// LexFilter - process the token stream prior to parsing. /// Implements the offside rule and a copule of other lexical transformations. @@ -46,15 +46,15 @@ type Context = | CtxtInterfaceHead of Position | CtxtTypeDefns of Position // 'type =', not removed when we find the "=" - | CtxtNamespaceHead of Position * token - | CtxtModuleHead of Position * token + | CtxtNamespaceHead of Position * token + | CtxtModuleHead of Position * token | CtxtMemberHead of Position | CtxtMemberBody of Position // If bool is true then this is "whole file" // module A.B // If bool is false, this is a "module declaration" // module A = ... - | CtxtModuleBody of Position * bool + | CtxtModuleBody of Position * bool | CtxtNamespaceBody of Position | CtxtException of Position | CtxtParen of Parser.token * Position @@ -152,12 +152,12 @@ let isNonAssocInfixToken token = let infixTokenLength token = match token with - | COMMA -> 1 + | COMMA -> 1 | AMP -> 1 | OR -> 1 | DOLLAR -> 1 | MINUS -> 1 - | STAR -> 1 + | STAR -> 1 | BAR -> 1 | LESS false -> 1 | GREATER false -> 1 @@ -184,13 +184,13 @@ let infixTokenLength token = let rec isIfBlockContinuator token = match token with // The following tokens may align with the "if" without closing the "if", e.g. - // if ... - // then ... + // if ... + // then ... // elif ... // else ... | THEN | ELSE | ELIF -> true // Likewise - // if ... then ( + // if ... then ( // ) elif begin // end else ... | END | RPAREN -> true @@ -259,7 +259,7 @@ let rec isTypeContinuator token = // type X = // | A // | B - // and Y = c <--- 'and' HERE + // and Y = c <--- 'and' HERE // // type X = { // x: int @@ -367,7 +367,7 @@ let isAtomicExprEndToken token = | IDENT _ | INT8 _ | INT16 _ | INT32 _ | INT64 _ | NATIVEINT _ | UINT8 _ | UINT16 _ | UINT32 _ | UINT64 _ | UNATIVEINT _ - | DECIMAL _ | BIGNUM _ | STRING _ | BYTEARRAY _ | CHAR _ + | DECIMAL _ | BIGNUM _ | STRING _ | BYTEARRAY _ | CHAR _ | IEEE32 _ | IEEE64 _ | RPAREN | RBRACK | RBRACE | BAR_RBRACE | BAR_RBRACK | END | NULL | FALSE | TRUE | UNDERSCORE -> true @@ -395,7 +395,7 @@ let parenTokensBalance t1 t2 = /// Used to save some aspects of the lexbuffer state [] type LexbufState(startPos: Position, - endPos : Position, + endPos : Position, pastEOF : bool) = member x.StartPos = startPos member x.EndPos = endPos @@ -452,14 +452,14 @@ let (|TyparsCloseOp|_|) (txt: string) = | "]" -> Some RBRACK | "-" -> Some MINUS | ".." -> Some DOT_DOT - | "?" -> Some QMARK + | "?" -> Some QMARK | "??" -> Some QMARK_QMARK | ":=" -> Some COLON_EQUALS | "::" -> Some COLON_COLON | "*" -> Some STAR | "&" -> Some AMP | "->" -> Some RARROW - | "<-" -> Some LARROW + | "<-" -> Some LARROW | "=" -> Some EQUALS | "<" -> Some (LESS false) | "$" -> Some DOLLAR @@ -467,7 +467,7 @@ let (|TyparsCloseOp|_|) (txt: string) = | "%%" -> Some (PERCENT_OP("%%")) | "" -> None | s -> - match List.ofSeq afterAngles with + match List.ofSeq afterAngles with | ('=' :: _) | ('!' :: '=' :: _) | ('<' :: _) @@ -498,23 +498,23 @@ type PositionWithColumn = //---------------------------------------------------------------------------- // build a LexFilter //--------------------------------------------------------------------------*) -type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: UnicodeLexing.Lexbuf) = +type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: UnicodeLexing.Lexbuf) = //---------------------------------------------------------------------------- // Part I. Building a new lex stream from an old // // A lexbuf is a stateful object that can be enticed to emit tokens by calling - // 'lexer' functions designed to work with the lexbuf. Here we fake a new stream - // coming out of an existing lexbuf. Ideally lexbufs would be abstract interfaces + // 'lexer' functions designed to work with the lexbuf. Here we fake a new stream + // coming out of an existing lexbuf. Ideally lexbufs would be abstract interfaces // and we could just build a new abstract interface that wraps an existing one. // However that is not how F# lexbufs currently work. // // Part of the fakery we perform involves buffering a lookahead token which - // we eventually pass on to the client. However, this client also looks at + // we eventually pass on to the client. However, this client also looks at // other aspects of the 'state' of lexbuf directly, e.g. F# lexbufs have a triple // (start-pos, end-pos, eof-reached) // - // You may ask why the F# parser reads this lexbuf state directly. Well, the + // You may ask why the F# parser reads this lexbuf state directly. Well, the // pars.fsy code itself it doesn't, but the parser engines (prim-parsing.fs) // certainly do for F#. e.g. when these parsers read a token // from the lexstream they also read the position information and keep this @@ -541,13 +541,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // EOF token is processed as if on column -1 // This forces the closure of all contexts. | Parser.EOF _ -> tokenTup.LexbufState.StartPos.ColumnMinusOne - | _ -> tokenTup.LexbufState.StartPos + | _ -> tokenTup.LexbufState.StartPos //---------------------------------------------------------------------------- // Part II. The state of the new lex stream object. //-------------------------------------------------------------------------- - // Ok, we're going to the wrapped lexbuf. Set the lexstate back so that the lexbuf + // Ok, we're going to the wrapped lexbuf. Set the lexstate back so that the lexbuf // appears consistent and correct for the wrapped lexer function. let mutable savedLexbufState = Unchecked.defaultof let mutable haveLexbufState = false @@ -587,7 +587,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, //---------------------------------------------------------------------------- // Part III. Initial configuration of state. // - // We read a token. In F# Interactive the parser thread will be correctly blocking + // We read a token. In F# Interactive the parser thread will be correctly blocking // here. //-------------------------------------------------------------------------- @@ -596,7 +596,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let mutable prevWasAtomicEnd = false let peekInitial() = - let initialLookaheadTokenTup = popNextTokenTup() + let initialLookaheadTokenTup = popNextTokenTup() if debug then dprintf "first token: initialLookaheadTokenLexbufState = %a\n" outputPos (startPosOfTokenTup initialLookaheadTokenTup) delayToken initialLookaheadTokenTup @@ -653,18 +653,18 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // let f x = function // | Case1 -> ... // | Case2 -> ... - | (CtxtMatchClauses _), (CtxtFunction _ :: CtxtSeqBlock _ :: (CtxtLetDecl _ as limitCtxt) :: _rest) + | (CtxtMatchClauses _), (CtxtFunction _ :: CtxtSeqBlock _ :: (CtxtLetDecl _ as limitCtxt) :: _rest) -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) - // Otherwise 'function ...' places no limit until we hit a CtxtLetDecl etc... (Recursive) + // Otherwise 'function ...' places no limit until we hit a CtxtLetDecl etc... (Recursive) | (CtxtMatchClauses _), (CtxtFunction _ :: rest) -> unindentationLimit false rest - // 'try ... with' limited by 'try' + // 'try ... with' limited by 'try' | _, (CtxtMatchClauses _ :: (CtxtTry _ as limitCtxt) :: _rest) -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) - // 'fun ->' places no limit until we hit a CtxtLetDecl etc... (Recursive) + // 'fun ->' places no limit until we hit a CtxtLetDecl etc... (Recursive) | _, (CtxtFun _ :: rest) -> unindentationLimit false rest @@ -682,7 +682,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // x + x // This is a serious thing to allow, but is required since there is no "return" in this language. // Without it there is no way of escaping special cases in large bits of code without indenting the main case. - | CtxtSeqBlock _, (CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _rest) + | CtxtSeqBlock _, (CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _rest) -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // Permitted inner-construct precise block alignment: @@ -693,7 +693,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // type ... // with ... // end - | CtxtWithAsAugment _, ((CtxtInterfaceHead _ | CtxtMemberHead _ | CtxtException _ | CtxtTypeDefns _) as limitCtxt :: _rest) + | CtxtWithAsAugment _, ((CtxtInterfaceHead _ | CtxtMemberHead _ | CtxtException _ | CtxtTypeDefns _) as limitCtxt :: _rest) -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // Permit unindentation via parentheses (or begin/end) following a 'then', 'else' or 'do': @@ -718,7 +718,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // ... <-- this is before the "with" // end - | _, ((CtxtWithAsAugment _ | CtxtThen _ | CtxtElse _ | CtxtDo _ ) :: rest) + | _, ((CtxtWithAsAugment _ | CtxtThen _ | CtxtElse _ | CtxtDo _ ) :: rest) -> unindentationLimit false rest @@ -750,26 +750,26 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // 'if ... else {' limited by 'if' // 'if ... else [' limited by 'if' // 'if ... else [|' limited by 'if' - | _, (CtxtParen ((SIG | STRUCT | BEGIN), _) :: CtxtSeqBlock _ :: (CtxtModuleBody (_, false) as limitCtxt) :: _) - | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR) , _) :: CtxtSeqBlock _ :: CtxtThen _ :: (CtxtIf _ as limitCtxt) :: _) - | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR | LBRACK_LESS) , _) :: CtxtSeqBlock _ :: CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _) + | _, (CtxtParen ((SIG | STRUCT | BEGIN), _) :: CtxtSeqBlock _ :: (CtxtModuleBody (_, false) as limitCtxt) :: _) + | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR), _) :: CtxtSeqBlock _ :: CtxtThen _ :: (CtxtIf _ as limitCtxt) :: _) + | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR | LBRACK_LESS), _) :: CtxtSeqBlock _ :: CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _) // 'f ... (' in seqblock limited by 'f' // 'f ... {' in seqblock limited by 'f' NOTE: this is covered by the more generous case above // 'f ... [' in seqblock limited by 'f' // 'f ... [|' in seqblock limited by 'f' // 'f ... Foo<' in seqblock limited by 'f' - | _, (CtxtParen ((BEGIN | LPAREN | LESS true | LBRACK | LBRACK_BAR) , _) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _) + | _, (CtxtParen ((BEGIN | LPAREN | LESS true | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _) // 'type C = class ... ' limited by 'type' // 'type C = interface ... ' limited by 'type' // 'type C = struct ... ' limited by 'type' - | _, (CtxtParen ((CLASS | STRUCT | INTERFACE), _) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _) + | _, (CtxtParen ((CLASS | STRUCT | INTERFACE), _) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _) -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) // REVIEW: document these | _, (CtxtSeqBlock _ :: CtxtParen((BEGIN | LPAREN | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _) - | (CtxtSeqBlock _), (CtxtParen ((BEGIN | LPAREN | LBRACE | LBRACE_BAR | LBRACK | LBRACK_BAR) , _) :: CtxtSeqBlock _ :: ((CtxtTypeDefns _ | CtxtLetDecl _ | CtxtMemberBody _ | CtxtWithAsLet _) as limitCtxt) :: _) + | (CtxtSeqBlock _), (CtxtParen ((BEGIN | LPAREN | LBRACE | LBRACE_BAR | LBRACK | LBRACK_BAR), _) :: CtxtSeqBlock _ :: ((CtxtTypeDefns _ | CtxtLetDecl _ | CtxtMemberBody _ | CtxtWithAsLet _) as limitCtxt) :: _) -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) // Permitted inner-construct (e.g. "then" block and "else" block in overall @@ -778,13 +778,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // then expr // elif expr // else expr - | (CtxtIf _ | CtxtElse _ | CtxtThen _), (CtxtIf _ as limitCtxt) :: _rest + | (CtxtIf _ | CtxtElse _ | CtxtThen _), (CtxtIf _ as limitCtxt) :: _rest -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // Permitted inner-construct precise block alignment: // while ... // do expr // done - | (CtxtDo _), ((CtxtFor _ | CtxtWhile _) as limitCtxt) :: _rest + | (CtxtDo _), ((CtxtFor _ | CtxtWhile _) as limitCtxt) :: _rest -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) @@ -793,7 +793,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) // These contexts can have their contents exactly aligning - | _, ((CtxtParen _ | CtxtFor _ | CtxtWhen _ | CtxtWhile _ | CtxtTypeDefns _ | CtxtMatch _ | CtxtModuleBody (_, true) | CtxtNamespaceBody _ | CtxtTry _ | CtxtMatchClauses _ | CtxtSeqBlock _) as limitCtxt :: _) + | _, ((CtxtParen _ | CtxtFor _ | CtxtWhen _ | CtxtWhile _ | CtxtTypeDefns _ | CtxtMatch _ | CtxtModuleBody (_, true) | CtxtNamespaceBody _ | CtxtTry _ | CtxtMatchClauses _ | CtxtSeqBlock _) as limitCtxt :: _) -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) match newCtxt with @@ -816,7 +816,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let popCtxt() = match offsideStack with - | [] -> () + | [] -> () | h :: rest -> if debug then dprintf "<-- popping Context(%A), stack = %A\n" h rest offsideStack <- rest @@ -879,7 +879,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, false | GREATER _ | GREATER_RBRACK | GREATER_BAR_RBRACK -> let nParen = nParen - 1 - let hasAfterOp = (match lookaheadToken with GREATER _ -> false | _ -> true) + let hasAfterOp = (match lookaheadToken with GREATER _ -> false | _ -> true) if nParen > 0 then // Don't smash the token if there is an after op and we're in a nested paren stack := (lookaheadTokenTup, not hasAfterOp) :: (!stack).Tail @@ -902,7 +902,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 afterOp.IsNone && (match nextTokenIsAdjacentLParenOrLBrack lookaheadTokenTup with Some LPAREN -> true | _ -> false) then + if afterOp.IsNone && (match nextTokenIsAdjacentLParenOrLBrack lookaheadTokenTup with Some LPAREN -> true | _ -> false) then let dotTokenTup = peekNextTokenTup() stack := (dotTokenTup.UseLocation(HIGH_PRECEDENCE_PAREN_APP), false) :: !stack true @@ -938,7 +938,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | NULL | INT8 _ | INT16 _ | INT32 _ | INT64 _ | NATIVEINT _ | UINT8 _ | UINT16 _ | UINT32 _ | UINT64 _ | UNATIVEINT _ - | DECIMAL _ | BIGNUM _ | STRING _ | BYTEARRAY _ | CHAR _ | TRUE | FALSE + | DECIMAL _ | BIGNUM _ | STRING _ | BYTEARRAY _ | CHAR _ | TRUE | FALSE | IEEE32 _ | IEEE64 _ | DOT | UNDERSCORE | EQUALS | IDENT _ | COMMA | RARROW | HASH @@ -996,26 +996,26 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let tokenBalancesHeadContext token stack = match token, stack with - | END, (CtxtWithAsAugment(_) :: _) + | END, (CtxtWithAsAugment(_) :: _) | (ELSE | ELIF), (CtxtIf _ :: _) - | DONE , (CtxtDo _ :: _) + | DONE, (CtxtDo _ :: _) // WITH balances except in the following contexts.... Phew - an overused keyword! - | WITH , ( ((CtxtMatch _ | CtxtException _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtTry _ | CtxtTypeDefns _ | CtxtMemberBody _) :: _) + | WITH, ( ((CtxtMatch _ | CtxtException _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtTry _ | CtxtTypeDefns _ | CtxtMemberBody _) :: _) // This is the nasty record/object-expression case - | (CtxtSeqBlock _ :: CtxtParen((LBRACE | LBRACE_BAR), _) :: _) ) - | FINALLY , (CtxtTry _ :: _) -> + | (CtxtSeqBlock _ :: CtxtParen((LBRACE | LBRACE_BAR), _) :: _) ) + | FINALLY, (CtxtTry _ :: _) -> true // for x in ienum ... // let x = ... in - | IN , ((CtxtFor _ | CtxtLetDecl _) :: _) -> + | IN, ((CtxtFor _ | CtxtLetDecl _) :: _) -> true // 'query { join x in ys ... }' // 'query { ... // join x in ys ... }' // 'query { for ... do // join x in ys ... }' - | IN , stack when detectJoinInCtxt stack -> + | IN, stack when detectJoinInCtxt stack -> true // NOTE: ;; does not terminate a 'namespace' body. @@ -1025,8 +1025,8 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtModuleBody (_, true) :: _) -> true - | t2 , (CtxtParen(t1, _) :: _) -> - parenTokensBalance t1 t2 + | t2, (CtxtParen(t1, _) :: _) -> + parenTokensBalance t1 t2 | _ -> false @@ -1113,11 +1113,11 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let isSemiSemi = match token with SEMICOLON_SEMICOLON -> true | _ -> false // If you see a 'member' keyword while you are inside the body of another member, then it usually means there is a syntax error inside this method - // and the upcoming 'member' is the start of the next member in the class. For better parser recovery and diagnostics, it is best to pop out of the + // and the upcoming 'member' is the start of the next member in the class. For better parser recovery and diagnostics, it is best to pop out of the // existing member context so the parser can recover. // - // However there are two places where 'member' keywords can appear inside expressions inside the body of a member. The first is object expressions, and - // the second is static inline constraints. We must not pop the context stack in those cases, or else legal code will not parse. + // However there are two places where 'member' keywords can appear inside expressions inside the body of a member. The first is object expressions, and + // the second is static inline constraints. We must not pop the context stack in those cases, or else legal code will not parse. // // It is impossible to decide for sure if we're in one of those two cases, so we must err conservatively if we might be. let thereIsACtxtMemberBodyOnTheStackAndWeShouldPopStackForUpcomingMember ctxtStack = @@ -1137,10 +1137,10 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, match ctxt with | CtxtFun _ | CtxtMatchClauses _ - | CtxtWithAsLet _ -> + | CtxtWithAsLet _ -> Some OEND - | CtxtWithAsAugment _ -> + | CtxtWithAsAugment _ -> Some ODECLEND | CtxtDo _ @@ -1164,7 +1164,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, not (isNil stack) && match token with | Parser.EOF _ -> true - | SEMICOLON_SEMICOLON -> not (tokenBalancesHeadContext token stack) + | SEMICOLON_SEMICOLON -> not (tokenBalancesHeadContext token stack) | END | ELSE | ELIF @@ -1178,7 +1178,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | BAR_RBRACK | WITH | FINALLY - | RQUOTE _ -> + | RQUOTE _ -> not (tokenBalancesHeadContext token stack) && // Only close the context if some context is going to match at some point in the stack. // If none match, the token will go through, and error recovery will kick in in the parser and report the extra token, @@ -1188,7 +1188,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | _ -> false // The TYPE and MODULE keywords cannot be used in expressions, but the parser has a hard time recovering on incomplete-expression-code followed by - // a TYPE or MODULE. So the lexfilter helps out by looking ahead for these tokens and (1) closing expression contexts and (2) inserting extra 'coming soon' tokens + // a TYPE or MODULE. So the lexfilter helps out by looking ahead for these tokens and (1) closing expression contexts and (2) inserting extra 'coming soon' tokens // that the expression rules in the FsYacc parser can 'shift' to make progress parsing the incomplete expressions, without using the 'recover' action. let insertComingSoonTokens(keywordName, comingSoon, isHere) = // compiling the source for FSharp.Core.dll uses crazy syntax like @@ -1220,7 +1220,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // preserve all other contexts | _ -> false) do match offsideStack.Head with - | CtxtParen _ -> + | CtxtParen _ -> if debug then dprintf "%s at %a terminates CtxtParen()\n" keywordName outputPos tokenStartPos popCtxt() | CtxtSeqBlock(_, _, AddBlockEnd) -> @@ -1242,7 +1242,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | _ -> 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. // 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. + // 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)) @@ -1257,7 +1257,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, tokensThatNeedNoProcessingCount <- tokensThatNeedNoProcessingCount - 1 returnToken tokenLexbufState token - | _ when tokenForcesHeadContextClosure token offsideStack -> + | _ when tokenForcesHeadContextClosure token offsideStack -> let ctxt = offsideStack.Head if debug then dprintf "IN/ELSE/ELIF/DONE/RPAREN/RBRACE/END at %a terminates context at position %a\n" outputPos tokenStartPos outputPos ctxt.StartPos popCtxt() @@ -1269,12 +1269,12 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, reprocess() // reset on ';;' rule. A ';;' terminates ALL entries - | SEMICOLON_SEMICOLON, [] -> + | SEMICOLON_SEMICOLON, [] -> if debug then dprintf ";; scheduling a reset\n" delayToken(tokenTup.UseLocation(ORESET)) returnToken tokenLexbufState SEMICOLON_SEMICOLON - | ORESET, [] -> + | ORESET, [] -> if debug then dprintf "performing a reset after a ;; has been swallowed\n" // 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. @@ -1282,12 +1282,12 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, hwTokenFetch(true) - | IN, stack when detectJoinInCtxt stack -> + | IN, stack when detectJoinInCtxt stack -> returnToken tokenLexbufState JOIN_IN // Balancing rule. Encountering an 'in' balances with a 'let'. i.e. even a non-offside 'in' closes a 'let' // The 'IN' token is thrown away and becomes an ODECLEND - | IN, (CtxtLetDecl (blockLet, offsidePos) :: _) -> + | IN, (CtxtLetDecl (blockLet, offsidePos) :: _) -> if debug then dprintf "IN at %a (becomes %s)\n" outputPos tokenStartPos (if blockLet then "ODECLEND" else "IN") if tokenStartCol < offsidePos.Column then warn tokenTup (FSComp.SR.lexfltIncorrentIndentationOfIn()) popCtxt() @@ -1297,7 +1297,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // Balancing rule. Encountering a 'done' balances with a 'do'. i.e. even a non-offside 'done' closes a 'do' // The 'DONE' token is thrown away and becomes an ODECLEND - | DONE, (CtxtDo offsidePos :: _) -> + | DONE, (CtxtDo offsidePos :: _) -> 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 @@ -1305,8 +1305,8 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, 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, _) :: _) - when parenTokensBalance t1 t2 -> + | ((END | RPAREN | RBRACE | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ | GREATER true) as t2), (CtxtParen (t1, _) :: _) + when parenTokensBalance t1 t2 -> 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 @@ -1314,7 +1314,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, 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() @@ -1347,7 +1347,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // Transition rule. CtxtModuleHead ~~~> push CtxtModuleBody; push CtxtSeqBlock // Applied when a ':' or '=' token is seen // Otherwise it's a 'head' module declaration, so ignore it - | _, (CtxtModuleHead (moduleTokenPos, prevToken) :: _) -> + | _, (CtxtModuleHead (moduleTokenPos, prevToken) :: _) -> match prevToken, token with | MODULE, GLOBAL when moduleTokenPos.Column < tokenStartPos.Column -> replaceCtxt tokenTup (CtxtModuleHead (moduleTokenPos, token)) @@ -1468,7 +1468,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // This is the first token in a block, or a token immediately // following an infix operator (see above). // Return the token, but only after processing any additional rules - // applicable for this token. Don't apply the CtxtSeqBlock rule for + // applicable for this token. Don't apply the CtxtSeqBlock rule for // this token, but do apply it on subsequent tokens. if debug then dprintf "repull for CtxtSeqBlockStart\n" replaceCtxt tokenTup (CtxtSeqBlock (NotFirstInSeqBlock, offsidePos, addBlockEnd)) @@ -1493,13 +1493,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // ... // ~~> insert OBLOCKSEP | _, (CtxtSeqBlock (NotFirstInSeqBlock, offsidePos, addBlockEnd) :: rest) - when useBlockRule + when useBlockRule && not (let isTypeCtxt = (match rest with | (CtxtTypeDefns _ :: _) -> true | _ -> false) // Don't insert 'OBLOCKSEP' between namespace declarations let isNamespaceCtxt = (match rest with | (CtxtNamespaceBody _ :: _) -> true | _ -> false) if isNamespaceCtxt then (match token with NAMESPACE -> true | _ -> false) elif isTypeCtxt then isTypeSeqBlockElementContinuator token - else isSeqBlockElementContinuator token) + else isSeqBlockElementContinuator token) && (tokenStartCol = offsidePos.Column) && (tokenStartPos.OriginalLine <> offsidePos.OriginalLine) -> if debug then dprintf "offside at column %d matches start of block(%a)! delaying token, returning OBLOCKSEP\n" tokenStartCol outputPos offsidePos @@ -1555,7 +1555,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // module M = ... // ... // NOTE: ;; does not terminate a whole file module body. - | _, ((CtxtModuleBody (offsidePos, wholeFile)) :: _) when (isSemiSemi && not wholeFile) || tokenStartCol <= offsidePos.Column -> + | _, ((CtxtModuleBody (offsidePos, wholeFile)) :: _) when (isSemiSemi && not wholeFile) || tokenStartCol <= offsidePos.Column -> if debug then dprintf "token at column %d is offside from MODULE with offsidePos %a! delaying token\n" tokenStartCol outputPos offsidePos popCtxt() reprocess() @@ -1571,7 +1571,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, popCtxt() reprocess() - // Pop CtxtMemberBody when offside. Insert an ODECLEND to indicate the end of the member + // Pop CtxtMemberBody when offside. Insert an ODECLEND to indicate the end of the member | _, ((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() @@ -1584,19 +1584,19 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, reprocess() | _, (CtxtIf offsidePos :: _) - when isSemiSemi || (if isIfBlockContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> + when isSemiSemi || (if isIfBlockContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> if debug then dprintf "offside from CtxtIf\n" popCtxt() reprocess() | _, (CtxtWithAsLet offsidePos :: _) - when isSemiSemi || (if isLetContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> + when isSemiSemi || (if isLetContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> if debug then dprintf "offside from CtxtWithAsLet\n" popCtxt() insertToken OEND | _, (CtxtWithAsAugment(offsidePos) :: _) - when isSemiSemi || (if isWithAugmentBlockContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> + 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() insertToken ODECLEND @@ -1608,13 +1608,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, reprocess() | _, (CtxtFor offsidePos :: _) - when isSemiSemi || (if isForLoopContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> + when isSemiSemi || (if isForLoopContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> if debug then dprintf "offside from CtxtFor\n" popCtxt() reprocess() | _, (CtxtWhile offsidePos :: _) - when isSemiSemi || (if isWhileBlockContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> + when isSemiSemi || (if isWhileBlockContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> if debug then dprintf "offside from CtxtWhile\n" popCtxt() reprocess() @@ -1637,7 +1637,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, reprocess() | _, (CtxtTry offsidePos :: _) - when isSemiSemi || (if isTryBlockContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> + when isSemiSemi || (if isTryBlockContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> if debug then dprintf "offside from CtxtTry\n" popCtxt() reprocess() @@ -1648,7 +1648,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // // then // ... - | _, (CtxtThen offsidePos :: _) when isSemiSemi || (if isThenBlockContinuator token then tokenStartCol + 1 else tokenStartCol)<= offsidePos.Column -> + | _, (CtxtThen offsidePos :: _) when isSemiSemi || (if isThenBlockContinuator token then tokenStartCol + 1 else tokenStartCol)<= offsidePos.Column -> if debug then dprintf "offside from CtxtThen, popping\n" popCtxt() reprocess() @@ -1667,33 +1667,33 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, (match token with // BAR occurs in pattern matching 'with' blocks | BAR -> - let cond1 = tokenStartCol + (if leadingBar then 0 else 2) < offsidePos.Column - let cond2 = tokenStartCol + (if leadingBar then 1 else 2) < offsidePos.Column + let cond1 = tokenStartCol + (if leadingBar then 0 else 2) < offsidePos.Column + let cond2 = tokenStartCol + (if leadingBar then 1 else 2) < offsidePos.Column if (cond1 <> cond2) then errorR(Lexhelp.IndentationProblem(FSComp.SR.lexfltSeparatorTokensOfPatternMatchMisaligned(), mkSynRange (startPosOfTokenTup tokenTup) tokenTup.LexbufState.EndPos)) cond1 | END -> tokenStartCol + (if leadingBar then -1 else 1) < offsidePos.Column - | _ -> tokenStartCol + (if leadingBar then -1 else 1) < offsidePos.Column)) -> + | _ -> tokenStartCol + (if leadingBar then -1 else 1) < offsidePos.Column)) -> if debug then dprintf "offside from WITH, tokenStartCol = %d, offsidePos = %a, delaying token, returning OEND\n" tokenStartCol outputPos offsidePos popCtxt() insertToken OEND // namespace ... ~~~> CtxtNamespaceHead - | NAMESPACE, (_ :: _) -> + | NAMESPACE, (_ :: _) -> if debug then dprintf "NAMESPACE: entering CtxtNamespaceHead, awaiting end of long identifier to push CtxtSeqBlock\n" pushCtxt tokenTup (CtxtNamespaceHead (tokenStartPos, token)) returnToken tokenLexbufState token // module ... ~~~> CtxtModuleHead - | MODULE, (_ :: _) -> + | MODULE, (_ :: _) -> 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) // exception ... ~~~> CtxtException - | EXCEPTION, (_ :: _) -> + | EXCEPTION, (_ :: _) -> if debug then dprintf "EXCEPTION: entering CtxtException(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtException tokenStartPos) returnToken tokenLexbufState token @@ -1727,7 +1727,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxt tokenTup (CtxtLetDecl(blockLet, tokenStartPos)) returnToken tokenLexbufState (if blockLet then OBINDER b else token) - | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), ctxtStack when thereIsACtxtMemberBodyOnTheStackAndWeShouldPopStackForUpcomingMember ctxtStack -> + | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), ctxtStack when thereIsACtxtMemberBodyOnTheStackAndWeShouldPopStackForUpcomingMember ctxtStack -> if debug then dprintf "STATIC/MEMBER/OVERRIDE/DEFAULT: already inside CtxtMemberBody, popping all that context before starting next member...\n" // save this token, we'll consume it again later... delayTokenNoProcessing tokenTup @@ -1751,19 +1751,19 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // override ... ~~~> CtxtMemberHead // default ... ~~~> CtxtMemberHead // val ... ~~~> CtxtMemberHead - | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), (ctxt :: _) when (match ctxt with CtxtMemberHead _ -> false | _ -> true) -> + | (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)) returnToken tokenLexbufState token // public new... ~~~> CtxtMemberHead - | (PUBLIC | PRIVATE | INTERNAL), (_ctxt :: _) when (match peekNextToken() with NEW -> true | _ -> false) -> + | (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)) 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) -> + | 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)) returnToken tokenLexbufState token @@ -1783,7 +1783,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, if isControlFlowOrNotSameLine() then if debug then dprintf "LAZY/ASSERT, pushing CtxtSeqBlock\n" pushCtxtSeqBlock(true, AddBlockEnd) - returnToken tokenLexbufState (match token with LAZY -> OLAZY | _ -> OASSERT) + returnToken tokenLexbufState (match token with LAZY -> OLAZY | _ -> OASSERT) else returnToken tokenLexbufState token @@ -1852,13 +1852,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // comprehension | (CtxtSeqBlock _ :: CtxtParen ((LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR), _) :: _) -> true // comprehension - | (CtxtSeqBlock _ :: (CtxtDo _ | CtxtWhile _ | CtxtFor _ | CtxtWhen _ | CtxtMatchClauses _ | CtxtTry _ | CtxtThen _ | CtxtElse _) :: _) -> true + | (CtxtSeqBlock _ :: (CtxtDo _ | CtxtWhile _ | CtxtFor _ | CtxtWhen _ | CtxtMatchClauses _ | CtxtTry _ | CtxtThen _ | CtxtElse _) :: _) -> true | _ -> false) -> if debug then dprintf "RARROW, pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos pushCtxtSeqBlock(false, AddOneSidedBlockEnd) returnToken tokenLexbufState token - | LARROW, _ when isControlFlowOrNotSameLine() -> + | LARROW, _ when isControlFlowOrNotSameLine() -> if debug then dprintf "LARROW, pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token @@ -1887,7 +1887,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxtSeqBlock(false, NoAddBlockEnd) returnToken tokenLexbufState token - | WITH, ((CtxtTry _ | CtxtMatch _) :: _) -> + | WITH, ((CtxtTry _ | CtxtMatch _) :: _) -> let lookaheadTokenTup = peekNextTokenTup() let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup let leadingBar = match (peekNextToken()) with BAR -> true | _ -> false @@ -1895,13 +1895,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxt lookaheadTokenTup (CtxtMatchClauses(leadingBar, lookaheadTokenStartPos)) returnToken tokenLexbufState OWITH - | FINALLY, (CtxtTry _ :: _) -> + | FINALLY, (CtxtTry _ :: _) -> if debug then dprintf "FINALLY, pushing pushCtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | WITH, (((CtxtException _ | CtxtTypeDefns _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtMemberBody _) as limCtxt) :: _) - | WITH, ((CtxtSeqBlock _) as limCtxt :: CtxtParen((LBRACE | LBRACE_BAR), _) :: _) -> + | WITH, ((CtxtSeqBlock _) as limCtxt :: CtxtParen((LBRACE | LBRACE_BAR), _) :: _) -> let lookaheadTokenTup = peekNextTokenTup() let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup match lookaheadTokenTup.Token with @@ -1920,7 +1920,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | PUBLIC | PRIVATE | INTERNAL | INLINE -> let offsidePos = - if lookaheadTokenStartPos.Column > tokenTup.LexbufState.EndPos.Column then + if lookaheadTokenStartPos.Column > tokenTup.LexbufState.EndPos.Column then // This detects: // { new Foo // with M() = 1 @@ -1968,7 +1968,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // For attributes on properties: // member x.PublicGetSetProperty // with [] get() = "Ralf" - if (match lookaheadTokenTup.Token with LBRACK_LESS -> true | _ -> false) && (lookaheadTokenStartPos.OriginalLine = tokenTup.StartPos.OriginalLine) then + if (match lookaheadTokenTup.Token with LBRACK_LESS -> true | _ -> false) && (lookaheadTokenStartPos.OriginalLine = tokenTup.StartPos.OriginalLine) then let offsidePos = tokenStartPos pushCtxt tokenTup (CtxtWithAsLet(offsidePos)) returnToken tokenLexbufState OWITH @@ -1995,14 +1995,14 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token - | WITH, stack -> + | 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)) pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token - | FUNCTION, _ -> + | FUNCTION, _ -> let lookaheadTokenTup = peekNextTokenTup() let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup let leadingBar = match (peekNextToken()) with BAR -> true | _ -> false @@ -2010,13 +2010,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxt lookaheadTokenTup (CtxtMatchClauses(leadingBar, lookaheadTokenStartPos)) returnToken tokenLexbufState OFUNCTION - | THEN, _ -> + | THEN, _ -> if debug then dprintf "THEN, replacing THEN with OTHEN, pushing CtxtSeqBlock;CtxtThen(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtThen(tokenStartPos)) pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState OTHEN - | ELSE, _ -> + | ELSE, _ -> let lookaheadTokenTup = peekNextTokenTup() let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup match peekNextToken() with @@ -2037,42 +2037,42 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState OELSE - | (ELIF | IF), _ -> + | (ELIF | IF), _ -> if debug then dprintf "IF, pushing CtxtIf(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtIf (tokenStartPos)) returnToken tokenLexbufState token - | (MATCH | MATCH_BANG), _ -> + | (MATCH | MATCH_BANG), _ -> if debug then dprintf "MATCH, pushing CtxtMatch(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtMatch (tokenStartPos)) returnToken tokenLexbufState token - | FOR, _ -> + | FOR, _ -> if debug then dprintf "FOR, pushing CtxtFor(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtFor (tokenStartPos)) returnToken tokenLexbufState token - | WHILE, _ -> + | WHILE, _ -> if debug then dprintf "WHILE, pushing CtxtWhile(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtWhile (tokenStartPos)) returnToken tokenLexbufState token - | WHEN, ((CtxtSeqBlock _) :: _) -> + | WHEN, ((CtxtSeqBlock _) :: _) -> if debug then dprintf "WHEN, pushing CtxtWhen(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtWhen (tokenStartPos)) returnToken tokenLexbufState token - | FUN, _ -> + | FUN, _ -> if debug then dprintf "FUN, pushing CtxtFun(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtFun (tokenStartPos)) returnToken tokenLexbufState OFUN - | INTERFACE, _ -> + | INTERFACE, _ -> let lookaheadTokenTup = peekNextTokenTup() let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup match lookaheadTokenTup.Token with // type I = interface .... end - | DEFAULT | OVERRIDE | INTERFACE | NEW | TYPE | STATIC | END | MEMBER | ABSTRACT | INHERIT | LBRACK_LESS -> + | DEFAULT | OVERRIDE | INTERFACE | NEW | TYPE | STATIC | END | MEMBER | ABSTRACT | INHERIT | LBRACK_LESS -> if debug then dprintf "INTERFACE, pushing CtxtParen, tokenStartPos = %a, lookaheadTokenStartPos = %a\n" outputPos tokenStartPos outputPos lookaheadTokenStartPos pushCtxt tokenTup (CtxtParen (token, tokenStartPos)) pushCtxtSeqBlock(true, AddBlockEnd) @@ -2084,49 +2084,49 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxt tokenTup (CtxtInterfaceHead(tokenStartPos)) returnToken tokenLexbufState OINTERFACE_MEMBER - | CLASS, _ -> + | CLASS, _ -> if debug then dprintf "CLASS, pushing CtxtParen(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtParen (token, tokenStartPos)) pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token - | TYPE, _ -> + | 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) - | TRY, _ -> + | TRY, _ -> if debug then dprintf "Try, pushing CtxtTry(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtTry (tokenStartPos)) // The ideal spec would be to push a begin/end block pair here, but we can only do that - // if we are able to balance the WITH with the TRY. We can't do that because of the numerous ways + // if we are able to balance the WITH with the TRY. We can't do that because of the numerous ways // WITH is used in the grammar (see what happens when we hit a WITH below. // This hits in the single line case: "try make ef1 t with _ -> make ef2 t". pushCtxtSeqBlock(false, AddOneSidedBlockEnd) returnToken tokenLexbufState token - | OBLOCKBEGIN, _ -> + | OBLOCKBEGIN, _ -> returnToken tokenLexbufState token - | ODUMMY(_), _ -> + | ODUMMY(_), _ -> if debug then dprintf "skipping dummy token as no offside rules apply\n" hwTokenFetch (useBlockRule) // Ordinary tokens start a vanilla block - | _, CtxtSeqBlock _ :: _ -> + | _, CtxtSeqBlock _ :: _ -> pushCtxt tokenTup (CtxtVanilla(tokenStartPos, isLongIdentEquals token)) if debug then dprintf "pushing CtxtVanilla at tokenStartPos = %a\n" outputPos tokenStartPos returnToken tokenLexbufState token - | _ -> + | _ -> returnToken tokenLexbufState token and rulesForBothSoftWhiteAndHardWhite(tokenTup: TokenTup) = match tokenTup.Token with // Insert HIGH_PRECEDENCE_PAREN_APP if needed - | IDENT _ when (nextTokenIsAdjacentLParenOrLBrack tokenTup).IsSome -> + | IDENT _ when (nextTokenIsAdjacentLParenOrLBrack tokenTup).IsSome -> let dotTokenTup = peekNextTokenTup() if debug then dprintf "inserting HIGH_PRECEDENCE_PAREN_APP at dotTokenPos = %a\n" outputPos (startPosOfTokenTup dotTokenTup) let hpa = @@ -2139,7 +2139,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, true // Insert HIGH_PRECEDENCE_TYAPP if needed - | (DELEGATE | IDENT _ | IEEE64 _ | IEEE32 _ | DECIMAL _ | INT8 _ | INT16 _ | INT32 _ | INT64 _ | NATIVEINT _ | UINT8 _ | UINT16 _ | UINT32 _ | UINT64 _ | BIGNUM _) when peekAdjacentTypars false tokenTup -> + | (DELEGATE | IDENT _ | IEEE64 _ | IEEE32 _ | DECIMAL _ | INT8 _ | INT16 _ | INT32 _ | INT64 _ | NATIVEINT _ | UINT8 _ | UINT16 _ | UINT32 _ | UINT64 _ | BIGNUM _) when peekAdjacentTypars false tokenTup -> let lessTokenTup = popNextTokenTup() delayToken (lessTokenTup.UseLocation(match lessTokenTup.Token with LESS _ -> LESS true | _ -> failwith "unreachable")) @@ -2150,21 +2150,21 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, true // Split this token to allow "1..2" for range specification - | INT32_DOT_DOT (i, v) -> + | INT32_DOT_DOT (i, v) -> let dotdotPos = new LexbufState(tokenTup.EndPos.ShiftColumnBy(-2), tokenTup.EndPos, false) delayToken(new TokenTup(DOT_DOT, dotdotPos, tokenTup.LastTokenPos)) delayToken(tokenTup.UseShiftedLocation(INT32(i, v), 0, -2)) true // Split @>. and @@>. into two - | RQUOTE_DOT (s, raw) -> + | RQUOTE_DOT (s, raw) -> let dotPos = new LexbufState(tokenTup.EndPos.ShiftColumnBy(-1), tokenTup.EndPos, false) delayToken(new TokenTup(DOT, dotPos, tokenTup.LastTokenPos)) delayToken(tokenTup.UseShiftedLocation(RQUOTE(s, raw), 0, -1)) true - | MINUS | PLUS_MINUS_OP _ | PERCENT_OP _ | AMP | AMP_AMP + | MINUS | PLUS_MINUS_OP _ | PERCENT_OP _ | AMP | AMP_AMP when ((match tokenTup.Token with - | PLUS_MINUS_OP s -> (s = "+") || (s = "+.") || (s = "-.") + | PLUS_MINUS_OP s -> (s = "+") || (s = "+.") || (s = "-.") | PERCENT_OP s -> (s = "%") || (s = "%%") | _ -> true) && nextTokenIsAdjacent tokenTup && @@ -2197,16 +2197,16 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, if plusOrMinus then match nextTokenTup.Token with - | INT8(v, bad) -> delayMergedToken(INT8((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not - | INT16(v, bad) -> delayMergedToken(INT16((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not - | INT32(v, bad) -> delayMergedToken(INT32((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not + | INT8(v, bad) -> delayMergedToken(INT8((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not + | INT16(v, bad) -> delayMergedToken(INT16((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not + | 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)) - | BIGNUM(v, s) -> delayMergedToken(BIGNUM((if plus then v else "-" + v), s)) + | 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)) + | BIGNUM(v, s) -> delayMergedToken(BIGNUM((if plus then v else "-" + v), s)) | _ -> noMerge() else noMerge() @@ -2246,7 +2246,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // LexFilterImpl does the majority of the work for offsides rules and other magic. // LexFilter just wraps it with light post-processing that introduces a few more 'coming soon' symbols, to // make it easier for the parser to 'look ahead' and safely shift tokens in a number of recovery scenarios. -type LexFilter (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: UnicodeLexing.Lexbuf) = +type LexFilter (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: UnicodeLexing.Lexbuf) = let inner = new LexFilterImpl (lightSyntaxStatus, compilingFsLib, lexer, lexbuf) // We don't interact with lexbuf state at all, any inserted tokens have same state/location as the real one read, so diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 0744fd720b9..bafcc706db6 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -84,7 +84,7 @@ type AssignedCalledArg<'T> = CallerArg: CallerArg<'T> } member x.Position = x.CalledArg.Position -/// Represents the possibilities for a named-setter argument (a property, field , or a record field setter) +/// Represents the possibilities for a named-setter argument (a property, field, or a record field setter) type AssignedItemSetterTarget = | AssignedPropSetter of PropInfo * MethInfo * TypeInst (* the MethInfo is a non-indexer setter property *) | AssignedILFieldSetter of ILFieldInfo @@ -1253,8 +1253,8 @@ module ProvidedMethodCalls = | [objArg] -> let erasedThisTy = eraseSystemType (amap, m, mi.PApply((fun mi -> mi.DeclaringType), m)) let thisVar = erasedThisTy.PApply((fun ty -> ProvidedVar.Fresh("this", ty)), m) - Some objArg , Array.append [| thisVar |] paramVars - | [] -> None , paramVars + Some objArg, Array.append [| thisVar |] paramVars + | [] -> None, paramVars | _ -> failwith "multiple objArgs?" let ea = mi.PApplyWithProvider((fun (methodInfo, provider) -> ExtensionTyping.GetInvokerExpression(provider, methodInfo, [| for p in paramVars -> p.PUntaintNoFailure id |])), m) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index bca1d50d60c..ff9dbbe52e2 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -3387,7 +3387,7 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes AfterResolution.RecordResolution (None, (fun tpinst -> callSink(item, tpinst)), callSinkWithSpecificOverload, (fun () -> callSink (unrefinedItem, emptyTyparInst))) | true, true -> AfterResolution.RecordResolution (Some unrefinedItem, (fun tpinst -> callSink(item, tpinst)), callSinkWithSpecificOverload, (fun () -> callSink (unrefinedItem, emptyTyparInst))) - | _ , false -> + | _, false -> callSink (unrefinedItem, emptyTyparInst) AfterResolution.DoNothing diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index fdd35321e45..c718bf91050 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -1542,7 +1542,7 @@ module private TastDefinitionPrinting = (not v.IsConstructor, not v.IsInstance, // instance first v.DisplayName, // sort by name - List.sum v.NumArgs , // sort by #curried + List.sum v.NumArgs, // sort by #curried v.NumArgs.Length) // sort by arity let shouldShow (valRef: ValRef option) = diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index ae818cb9e84..250fda33d06 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. //------------------------------------------------------------------------- // The F# expression simplifier. The main aim is to inline simple, known functions @@ -35,7 +35,7 @@ open System.Collections.Generic #if DEBUG let verboseOptimizationInfo = - try not (System.String.IsNullOrEmpty (System.Environment.GetEnvironmentVariable "FSHARP_verboseOptimizationInfo")) with _ -> false + try not (System.String.IsNullOrEmpty (System.Environment.GetEnvironmentVariable "FSHARP_verboseOptimizationInfo")) with _ -> false let verboseOptimizations = try not (System.String.IsNullOrEmpty (System.Environment.GetEnvironmentVariable "FSHARP_verboseOptimizations")) with _ -> false #else @@ -43,7 +43,7 @@ let [] verboseOptimizationInfo = false let [] verboseOptimizations = false #endif -let i_ldlen = [ I_ldlen; (AI_conv DT_I4) ] +let i_ldlen = [ I_ldlen; (AI_conv DT_I4) ] /// size of a function call let [] callSize = 1 @@ -76,7 +76,7 @@ type ExprValueInfo = /// SizeValue(size, value) /// /// Records size info (maxDepth) for an ExprValueInfo - | SizeValue of int * ExprValueInfo + | SizeValue of int * ExprValueInfo /// ValValue(vref, value) /// @@ -101,7 +101,7 @@ type ExprValueInfo = /// the number of args in each bunch. NOTE: This include type arguments. /// expr: The value, a lambda term. /// ty: The type of lamba term - | CurriedLambdaValue of Unique * int * int * Expr * TType + | CurriedLambdaValue of Unique * int * int * Expr * TType /// ConstExprValue(size, value) | ConstExprValue of int * Expr @@ -169,20 +169,20 @@ type CcuOptimizationInfo = LazyModuleInfo #if DEBUG let braceL x = leftL (tagText "{") ^^ x ^^ rightL (tagText "}") -let seqL xL xs = Seq.fold (fun z x -> z @@ xL x) emptyL xs -let namemapL xL xmap = NameMap.foldBack (fun nm x z -> xL nm x @@ z) xmap emptyL +let seqL xL xs = Seq.fold (fun z x -> z @@ xL x) emptyL xs +let namemapL xL xmap = NameMap.foldBack (fun nm x z -> xL nm x @@ z) xmap emptyL let rec exprValueInfoL g exprVal = match exprVal with - | ConstValue (x, ty) -> NicePrint.layoutConst g ty x - | UnknownValue -> wordL (tagText "?") - | SizeValue (_, vinfo) -> exprValueInfoL g vinfo - | ValValue (vr, vinfo) -> bracketL ((valRefL vr ^^ wordL (tagText "alias")) --- exprValueInfoL g vinfo) - | TupleValue vinfos -> bracketL (exprValueInfosL g vinfos) - | RecdValue (_, vinfos) -> braceL (exprValueInfosL g vinfos) + | ConstValue (x, ty) -> NicePrint.layoutConst g ty x + | UnknownValue -> wordL (tagText "?") + | SizeValue (_, vinfo) -> exprValueInfoL g vinfo + | ValValue (vr, vinfo) -> bracketL ((valRefL vr ^^ wordL (tagText "alias")) --- exprValueInfoL g vinfo) + | TupleValue vinfos -> bracketL (exprValueInfosL g vinfos) + | RecdValue (_, vinfos) -> braceL (exprValueInfosL g vinfos) | UnionCaseValue (ucr, vinfos) -> unionCaseRefL ucr ^^ bracketL (exprValueInfosL g vinfos) | CurriedLambdaValue(_lambdaId, _arities, _bsize, expr, _ety) -> wordL (tagText "lam") ++ exprL expr (* (sprintf "lam(size=%d)" bsize) *) - | ConstExprValue (_size, x) -> exprL x + | ConstExprValue (_size, x) -> exprL x and exprValueInfosL g vinfos = commaListL (List.map (exprValueInfoL g) (Array.toList vinfos)) @@ -224,10 +224,10 @@ let rec SizeOfValueInfos (arr:_[]) = and SizeOfValueInfo x = match x with - | SizeValue (vdepth, _v) -> vdepth // terminate recursion at CACHED size nodes - | ConstValue (_x, _) -> 1 - | UnknownValue -> 1 - | ValValue (_vr, vinfo) -> SizeOfValueInfo vinfo + 1 + | SizeValue (vdepth, _v) -> vdepth // terminate recursion at CACHED size nodes + | ConstValue (_x, _) -> 1 + | UnknownValue -> 1 + | ValValue (_vr, vinfo) -> SizeOfValueInfo vinfo + 1 | TupleValue vinfos | RecdValue (_, vinfos) | UnionCaseValue (_, vinfos) -> 1 + SizeOfValueInfos vinfos @@ -254,13 +254,13 @@ let BoundValueInfoBySize vinfo = | SizeValue (vdepth, vinfo) -> if vdepth < depth then x else MakeSizedValueInfo (bound depth vinfo) | ValValue (vr, vinfo) -> ValValue (vr, bound (depth-1) vinfo) | TupleValue vinfos -> TupleValue (Array.map (bound (depth-1)) vinfos) - | RecdValue (tcref, vinfos) -> RecdValue (tcref, Array.map (bound (depth-1)) vinfos) + | RecdValue (tcref, vinfos) -> RecdValue (tcref, Array.map (bound (depth-1)) vinfos) | UnionCaseValue (ucr, vinfos) -> UnionCaseValue (ucr, Array.map (bound (depth-1)) vinfos) | ConstValue _ -> x | UnknownValue -> x | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> x | ConstExprValue (_size, _) -> x - let maxDepth = 6 (* beware huge constants! *) + let maxDepth = 6 (* beware huge constants! *) let trimDepth = 3 let vdepth = SizeOfValueInfo vinfo if vdepth > maxDepth @@ -431,7 +431,7 @@ let CheckInlineValueIsComplete (v: Val) res = errorR(Error(FSComp.SR.optValueMarkedInlineButIncomplete(v.DisplayName), v.Range)) //System.Diagnostics.Debug.Assert(false, sprintf "Break for incomplete inline value %s" v.DisplayName) -let check (vref: ValRef) (res: ValInfo) = +let check (vref: ValRef) (res: ValInfo) = CheckInlineValueIsComplete vref.Deref res.ValExprInfo (vref, res) @@ -450,7 +450,7 @@ let rec UnionOptimizationInfos (minfos : seq) = ModuleOrNamespaceInfos = minfos |> Seq.map (fun m -> m.Force().ModuleOrNamespaceInfos) - |> NameMap.union UnionOptimizationInfos } + |> NameMap.union UnionOptimizationInfos } let FindOrCreateModuleInfo n (ss: Map<_, _>) = match ss.TryFind n with @@ -463,18 +463,18 @@ let FindOrCreateGlobalModuleInfo n (ss: LayeredMap<_, _>) = | None -> EmptyModuleInfo let rec BindValueInSubModuleFSharpCore (mp: string[]) i (v: Val) vval ss = - if i < mp.Length then + if i < mp.Length then {ss with ModuleOrNamespaceInfos = BindValueInModuleForFslib mp.[i] mp (i+1) v vval ss.ModuleOrNamespaceInfos } else // REVIEW: this line looks quadratic for performance when compiling FSharp.Core {ss with ValInfos = ValInfos(Seq.append ss.ValInfos.Entries (Seq.singleton (mkLocalValRef v, vval))) } and BindValueInModuleForFslib n mp i v vval (ss: NameMap<_>) = - let old = FindOrCreateModuleInfo n ss + let old = FindOrCreateModuleInfo n ss Map.add n (notlazy (BindValueInSubModuleFSharpCore mp i v vval (old.Force()))) ss and BindValueInGlobalModuleForFslib n mp i v vval (ss: LayeredMap<_, _>) = - let old = FindOrCreateGlobalModuleInfo n ss + let old = FindOrCreateGlobalModuleInfo n ss ss.Add(n, notlazy (BindValueInSubModuleFSharpCore mp i v vval (old.Force()))) let BindValueForFslib (nlvref : NonLocalValOrMemberRef) v vval env = @@ -482,7 +482,7 @@ let BindValueForFslib (nlvref : NonLocalValOrMemberRef) v vval env = let UnknownValInfo = { ValExprInfo=UnknownValue; ValMakesNoCriticalTailcalls=false } -let mkValInfo info (v: Val) = { ValExprInfo=info.Info; ValMakesNoCriticalTailcalls= v.MakesNoCriticalTailcalls } +let mkValInfo info (v: Val) = { ValExprInfo=info.Info; ValMakesNoCriticalTailcalls= v.MakesNoCriticalTailcalls } (* Bind a value *) let BindInternalLocalVal cenv (v: Val) vval env = @@ -509,7 +509,7 @@ let BindExternalLocalVal cenv (v: Val) vval env = | UnknownValue -> env | _ -> #endif - { env with localExternalVals=env.localExternalVals.Add (v.Stamp, vval) } + { env with localExternalVals=env.localExternalVals.Add (v.Stamp, vval) } // If we're compiling fslib then also bind the value as a non-local path to // allow us to resolve the compiler-non-local-references that arise from env.fs // @@ -530,7 +530,7 @@ let BindExternalLocalVal cenv (v: Val) vval env = let rec BindValsInModuleOrNamespace cenv (mval: LazyModuleInfo) env = let mval = mval.Force() // do all the sub modules - let env = (mval.ModuleOrNamespaceInfos, env) ||> NameMap.foldBackRange (BindValsInModuleOrNamespace cenv) + let env = (mval.ModuleOrNamespaceInfos, env) ||> NameMap.foldBackRange (BindValsInModuleOrNamespace cenv) let env = (env, mval.ValInfos.Entries) ||> Seq.fold (fun env (v: ValRef, vval) -> BindExternalLocalVal cenv v.Deref vval env) env @@ -560,12 +560,12 @@ let BindTypeVarsToUnknown (tps: Typar list) env = // The names chosen are 'a', 'b' etc. These are also the compiled names in the IL code let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) (env.typarInfos |> List.map (fun (tp, _) -> tp.Name) ) tps (tps, nms) ||> List.iter2 (fun tp nm -> - if PrettyTypes.NeedsPrettyTyparName tp then + if PrettyTypes.NeedsPrettyTyparName tp then tp.typar_id <- ident (nm, tp.Range)) List.fold (fun sofar arg -> BindTypeVar arg UnknownTypeValue sofar) env tps let BindCcu (ccu: Tast.CcuThunk) mval env (_g: TcGlobals) = - { env with globalModuleInfos=env.globalModuleInfos.Add(ccu.AssemblyName, mval) } + { env with globalModuleInfos=env.globalModuleInfos.Add(ccu.AssemblyName, mval) } /// Lookup information about values let GetInfoForLocalValue cenv env (v: Val) m = @@ -606,7 +606,7 @@ let TryGetInfoForNonLocalEntityRef env (nleref: NonLocalEntityRef) = let GetInfoForNonLocalVal cenv env (vref: ValRef) = if vref.IsDispatchSlot then UnknownValInfo - // REVIEW: optionally turn x-module on/off on per-module basis or + // 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) -> @@ -645,7 +645,7 @@ let GetInfoForVal cenv env m (vref: ValRef) = let rec stripValue = function | ValValue(_, details) -> stripValue details (* step through ValValue "aliases" *) | SizeValue(_, details) -> stripValue details (* step through SizeValue "aliases" *) - | vinfo -> vinfo + | vinfo -> vinfo let (|StripConstValue|_|) ev = match stripValue ev with @@ -692,18 +692,18 @@ let mkUInt64Val (g: TcGlobals) n = ConstValue(Const.UInt64 n, g.uint64_ty) let (|StripInt32Value|_|) = function StripConstValue(Const.Int32 n) -> Some n | _ -> None -let MakeValueInfoForValue g m vref vinfo = +let MakeValueInfoForValue g m vref vinfo = #if DEBUG let rec check x = match x with - | ValValue (vref2, detail) -> if valRefEq g vref vref2 then error(Error(FSComp.SR.optRecursiveValValue(showL(exprValueInfoL g vinfo)), m)) else check detail + | ValValue (vref2, detail) -> if valRefEq g vref vref2 then error(Error(FSComp.SR.optRecursiveValValue(showL(exprValueInfoL g vinfo)), m)) else check detail | SizeValue (_n, detail) -> check detail | _ -> () check vinfo #else ignore g; ignore m #endif - ValValue (vref, vinfo) |> BoundValueInfoBySize + ValValue (vref, vinfo) |> BoundValueInfoBySize let MakeValueInfoForRecord tcref argvals = RecdValue (tcref, argvals) |> BoundValueInfoBySize @@ -721,12 +721,12 @@ let inline IntegerUnaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a = match a with | 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)) - | Const.Int64 a -> Some(mkInt64Val g (f64 a)) - | Const.Int16 a -> Some(mkInt16Val g (f16 a)) - | Const.SByte a -> Some(mkInt8Val g (f8 a)) - | Const.Byte a -> Some(mkUInt8Val g (fu8 a)) + | Const.Bool a -> Some(mkBoolVal g (f32 (if a then 1 else 0) <> 0)) + | Const.Int32 a -> Some(mkInt32Val g (f32 a)) + | Const.Int64 a -> Some(mkInt64Val g (f64 a)) + | Const.Int16 a -> Some(mkInt16Val g (f16 a)) + | Const.SByte a -> Some(mkInt8Val g (f8 a)) + | Const.Byte a -> Some(mkUInt8Val g (fu8 a)) | Const.UInt32 a -> Some(mkUInt32Val g (fu32 a)) | Const.UInt64 a -> Some(mkUInt64Val g (fu64 a)) | Const.UInt16 a -> Some(mkUInt16Val g (fu16 a)) @@ -741,7 +741,7 @@ let inline SignedIntegerUnaryOp g f8 f16 f32 f64 a = | Const.Int32 a -> Some(mkInt32Val g (f32 a)) | Const.Int64 a -> Some(mkInt64Val g (f64 a)) | Const.Int16 a -> Some(mkInt16Val g (f16 a)) - | Const.SByte a -> Some(mkInt8Val g (f8 a)) + | Const.SByte a -> Some(mkInt8Val g (f8 a)) | _ -> None | _ -> None @@ -750,12 +750,12 @@ let inline IntegerBinaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a b = match a, b with | 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)) - | (Const.Int64 a), (Const.Int64 b) -> Some(mkInt64Val g (f64 a b)) - | (Const.Int16 a), (Const.Int16 b) -> Some(mkInt16Val g (f16 a b)) - | (Const.SByte a), (Const.SByte b) -> Some(mkInt8Val g (f8 a b)) - | (Const.Byte a), (Const.Byte b) -> Some(mkUInt8Val g (fu8 a b)) + | (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)) + | (Const.Int64 a), (Const.Int64 b) -> Some(mkInt64Val g (f64 a b)) + | (Const.Int16 a), (Const.Int16 b) -> Some(mkInt16Val g (f16 a b)) + | (Const.SByte a), (Const.SByte b) -> Some(mkInt8Val g (f8 a b)) + | (Const.Byte a), (Const.Byte b) -> Some(mkUInt8Val g (fu8 a b)) | (Const.UInt16 a), (Const.UInt16 b) -> Some(mkUInt16Val g (fu16 a b)) | (Const.UInt32 a), (Const.UInt32 b) -> Some(mkUInt32Val g (fu32 a b)) | (Const.UInt64 a), (Const.UInt64 b) -> Some(mkUInt64Val g (fu64 a b)) @@ -781,29 +781,29 @@ let mkAssemblyCodeValueInfo g instrs argvals tys = match IntegerBinaryOp g Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) t1 t2 with | Some res -> res | _ -> UnknownValue - | [ AI_mul ], [a;b], _ -> (match IntegerBinaryOp g Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) a b with Some res -> res | None -> UnknownValue) - | [ AI_and ], [a;b], _ -> (match IntegerBinaryOp g (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) a b with Some res -> res | None -> UnknownValue) - | [ AI_or ], [a;b], _ -> (match IntegerBinaryOp g (|||) (|||) (|||) (|||) (|||) (|||) (|||) (|||) a b with Some res -> res | None -> UnknownValue) - | [ AI_xor ], [a;b], _ -> (match IntegerBinaryOp g (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) a b with Some res -> res | None -> UnknownValue) + | [ AI_mul ], [a;b], _ -> (match IntegerBinaryOp g Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) a b with Some res -> res | None -> UnknownValue) + | [ AI_and ], [a;b], _ -> (match IntegerBinaryOp g (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) a b with Some res -> res | None -> UnknownValue) + | [ AI_or ], [a;b], _ -> (match IntegerBinaryOp g (|||) (|||) (|||) (|||) (|||) (|||) (|||) (|||) a b with Some res -> res | None -> UnknownValue) + | [ AI_xor ], [a;b], _ -> (match IntegerBinaryOp g (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) a b with Some res -> res | None -> UnknownValue) | [ AI_not ], [a], _ -> (match IntegerUnaryOp g (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) a with Some res -> res | None -> UnknownValue) | [ AI_neg ], [a], _ -> (match SignedIntegerUnaryOp g (~-) (~-) (~-) (~-) a with Some res -> res | None -> UnknownValue) | [ AI_ceq ], [a;b], _ -> match stripValue a, stripValue b with - | ConstValue(Const.Bool a1, _), ConstValue(Const.Bool a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.SByte a1, _), ConstValue(Const.SByte a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Int16 a1, _), ConstValue(Const.Int16 a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Int32 a1, _), ConstValue(Const.Int32 a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Int64 a1, _), ConstValue(Const.Int64 a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.UInt16 a1, _), ConstValue(Const.UInt16 a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.UInt32 a1, _), ConstValue(Const.UInt32 a2, _) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.UInt64 a1, _), ConstValue(Const.UInt64 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Bool a1, _), ConstValue(Const.Bool a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.SByte a1, _), ConstValue(Const.SByte a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Int16 a1, _), ConstValue(Const.Int16 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Int32 a1, _), ConstValue(Const.Int32 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Int64 a1, _), ConstValue(Const.Int64 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.UInt16 a1, _), ConstValue(Const.UInt16 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.UInt32 a1, _), ConstValue(Const.UInt32 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.UInt64 a1, _), ConstValue(Const.UInt64 a2, _) -> mkBoolVal g (a1 = a2) | _ -> UnknownValue | [ AI_clt ], [a;b], _ -> match stripValue a, stripValue b with - | ConstValue(Const.Bool a1, _), ConstValue(Const.Bool a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.Bool a1, _), ConstValue(Const.Bool a2, _) -> mkBoolVal g (a1 < a2) | ConstValue(Const.Int32 a1, _), ConstValue(Const.Int32 a2, _) -> mkBoolVal g (a1 < a2) | ConstValue(Const.Int64 a1, _), ConstValue(Const.Int64 a2, _) -> mkBoolVal g (a1 < a2) | ConstValue(Const.SByte a1, _), ConstValue(Const.SByte a2, _) -> mkBoolVal g (a1 < a2) @@ -811,137 +811,137 @@ let mkAssemblyCodeValueInfo g instrs argvals tys = | _ -> UnknownValue | [ (AI_conv(DT_U1))], [a], [ty] when typeEquiv g ty g.byte_ty -> match stripValue a with - | ConstValue(Const.SByte a, _) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.Int16 a, _) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.Int32 a, _) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.Int64 a, _) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.Byte a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.SByte a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.Int16 a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.Int32 a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.Int64 a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.Byte a, _) -> mkUInt8Val g (Unchecked.byte a) | ConstValue(Const.UInt16 a, _) -> mkUInt8Val g (Unchecked.byte a) | ConstValue(Const.UInt32 a, _) -> mkUInt8Val g (Unchecked.byte a) | ConstValue(Const.UInt64 a, _) -> mkUInt8Val g (Unchecked.byte a) | _ -> UnknownValue | [ (AI_conv(DT_U2))], [a], [ty] when typeEquiv g ty g.uint16_ty -> match stripValue a with - | ConstValue(Const.SByte a, _) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.Int16 a, _) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.Int32 a, _) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.Int64 a, _) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.Byte a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.SByte a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.Int16 a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.Int32 a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.Int64 a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.Byte a, _) -> mkUInt16Val g (Unchecked.uint16 a) | ConstValue(Const.UInt16 a, _) -> mkUInt16Val g (Unchecked.uint16 a) | ConstValue(Const.UInt32 a, _) -> mkUInt16Val g (Unchecked.uint16 a) | ConstValue(Const.UInt64 a, _) -> mkUInt16Val g (Unchecked.uint16 a) | _ -> UnknownValue | [ (AI_conv(DT_U4))], [a], [ty] when typeEquiv g ty g.uint32_ty -> match stripValue a with - | ConstValue(Const.SByte a, _) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.Int16 a, _) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.Int32 a, _) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.Int64 a, _) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.Byte a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.SByte a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.Int16 a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.Int32 a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.Int64 a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.Byte a, _) -> mkUInt32Val g (Unchecked.uint32 a) | ConstValue(Const.UInt16 a, _) -> mkUInt32Val g (Unchecked.uint32 a) | ConstValue(Const.UInt32 a, _) -> mkUInt32Val g (Unchecked.uint32 a) | ConstValue(Const.UInt64 a, _) -> mkUInt32Val g (Unchecked.uint32 a) | _ -> UnknownValue - | [ (AI_conv(DT_U8))], [a], [ty] when typeEquiv g ty g.uint64_ty -> + | [ (AI_conv(DT_U8))], [a], [ty] when typeEquiv g ty g.uint64_ty -> match stripValue a with - | ConstValue(Const.SByte a, _) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.Int16 a, _) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.Int32 a, _) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.Int64 a, _) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.Byte a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.SByte a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.Int16 a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.Int32 a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.Int64 a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.Byte a, _) -> mkUInt64Val g (Unchecked.uint64 a) | ConstValue(Const.UInt16 a, _) -> mkUInt64Val g (Unchecked.uint64 a) | ConstValue(Const.UInt32 a, _) -> mkUInt64Val g (Unchecked.uint64 a) | ConstValue(Const.UInt64 a, _) -> mkUInt64Val g (Unchecked.uint64 a) | _ -> UnknownValue - | [ (AI_conv(DT_I1))], [a], [ty] when typeEquiv g ty g.sbyte_ty -> + | [ (AI_conv(DT_I1))], [a], [ty] when typeEquiv g ty g.sbyte_ty -> match stripValue a with - | ConstValue(Const.SByte a, _) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.Int16 a, _) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.Int32 a, _) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.Int64 a, _) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.Byte a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.SByte a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.Int16 a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.Int32 a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.Int64 a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.Byte a, _) -> mkInt8Val g (Unchecked.sbyte a) | ConstValue(Const.UInt16 a, _) -> mkInt8Val g (Unchecked.sbyte a) | ConstValue(Const.UInt32 a, _) -> mkInt8Val g (Unchecked.sbyte a) | ConstValue(Const.UInt64 a, _) -> mkInt8Val g (Unchecked.sbyte a) | _ -> UnknownValue - | [ (AI_conv(DT_I2))], [a], [ty] when typeEquiv g ty g.int16_ty -> + | [ (AI_conv(DT_I2))], [a], [ty] when typeEquiv g ty g.int16_ty -> match stripValue a with - | ConstValue(Const.Int32 a, _) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.Int16 a, _) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.SByte a, _) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.Int64 a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.Int32 a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.Int16 a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.SByte a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.Int64 a, _) -> mkInt16Val g (Unchecked.int16 a) | ConstValue(Const.UInt32 a, _) -> mkInt16Val g (Unchecked.int16 a) | ConstValue(Const.UInt16 a, _) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.Byte a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.Byte a, _) -> mkInt16Val g (Unchecked.int16 a) | ConstValue(Const.UInt64 a, _) -> mkInt16Val g (Unchecked.int16 a) | _ -> UnknownValue | [ (AI_conv(DT_I4))], [a], [ty] when typeEquiv g ty g.int32_ty -> match stripValue a with - | ConstValue(Const.Int32 a, _) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.Int16 a, _) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.SByte a, _) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.Int64 a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.Int32 a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.Int16 a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.SByte a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.Int64 a, _) -> mkInt32Val g (Unchecked.int32 a) | ConstValue(Const.UInt32 a, _) -> mkInt32Val g (Unchecked.int32 a) | ConstValue(Const.UInt16 a, _) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.Byte a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.Byte a, _) -> mkInt32Val g (Unchecked.int32 a) | ConstValue(Const.UInt64 a, _) -> mkInt32Val g (Unchecked.int32 a) | _ -> UnknownValue - | [ (AI_conv(DT_I8))], [a], [ty] when typeEquiv g ty g.int64_ty -> + | [ (AI_conv(DT_I8))], [a], [ty] when typeEquiv g ty g.int64_ty -> match stripValue a with - | ConstValue(Const.Int32 a, _) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.Int16 a, _) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.SByte a, _) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.Int64 a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.Int32 a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.Int16 a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.SByte a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.Int64 a, _) -> mkInt64Val g (Unchecked.int64 a) | ConstValue(Const.UInt32 a, _) -> mkInt64Val g (Unchecked.int64 a) | ConstValue(Const.UInt16 a, _) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.Byte a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.Byte a, _) -> mkInt64Val g (Unchecked.int64 a) | ConstValue(Const.UInt64 a, _) -> mkInt64Val g (Unchecked.int64 a) | _ -> UnknownValue - | [ AI_clt_un ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> + | [ AI_clt_un ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> match stripValue a, stripValue b with - | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 < a2) | ConstValue(Const.UInt16 a1, _), ConstValue(Const.UInt16 a2, _) -> mkBoolVal g (a1 < a2) | ConstValue(Const.UInt32 a1, _), ConstValue(Const.UInt32 a2, _) -> mkBoolVal g (a1 < a2) | ConstValue(Const.UInt64 a1, _), ConstValue(Const.UInt64 a2, _) -> mkBoolVal g (a1 < a2) | _ -> UnknownValue - | [ AI_cgt ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> + | [ AI_cgt ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> match stripValue a, stripValue b with - | ConstValue(Const.SByte a1, _), ConstValue(Const.SByte a2, _) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.Int16 a1, _), ConstValue(Const.Int16 a2, _) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.Int32 a1, _), ConstValue(Const.Int32 a2, _) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.Int64 a1, _), ConstValue(Const.Int64 a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.SByte a1, _), ConstValue(Const.SByte a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Int16 a1, _), ConstValue(Const.Int16 a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Int32 a1, _), ConstValue(Const.Int32 a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Int64 a1, _), ConstValue(Const.Int64 a2, _) -> mkBoolVal g (a1 > a2) | _ -> UnknownValue - | [ AI_cgt_un ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> + | [ AI_cgt_un ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> match stripValue a, stripValue b with - | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 > a2) | ConstValue(Const.UInt16 a1, _), ConstValue(Const.UInt16 a2, _) -> mkBoolVal g (a1 > a2) | ConstValue(Const.UInt32 a1, _), ConstValue(Const.UInt32 a2, _) -> mkBoolVal g (a1 > a2) | ConstValue(Const.UInt64 a1, _), ConstValue(Const.UInt64 a2, _) -> mkBoolVal g (a1 > a2) | _ -> UnknownValue | [ AI_shl ], [a;n], _ -> match stripValue a, stripValue n with - | ConstValue(Const.Int64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkInt64Val g (a <<< n)) - | ConstValue(Const.Int32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkInt32Val g (a <<< n)) - | ConstValue(Const.Int16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkInt16Val g (a <<< n)) - | ConstValue(Const.SByte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkInt8Val g (a <<< n)) + | ConstValue(Const.Int64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkInt64Val g (a <<< n)) + | ConstValue(Const.Int32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkInt32Val g (a <<< n)) + | ConstValue(Const.Int16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkInt16Val g (a <<< n)) + | ConstValue(Const.SByte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkInt8Val g (a <<< n)) | ConstValue(Const.UInt64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkUInt64Val g (a <<< n)) | ConstValue(Const.UInt32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkUInt32Val g (a <<< n)) | ConstValue(Const.UInt16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkUInt16Val g (a <<< n)) - | ConstValue(Const.Byte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkUInt8Val g (a <<< n)) + | ConstValue(Const.Byte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkUInt8Val g (a <<< n)) | _ -> UnknownValue | [ AI_shr ], [a;n], _ -> match stripValue a, stripValue n with - | ConstValue(Const.SByte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkInt8Val g (a >>> n)) + | ConstValue(Const.SByte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkInt8Val g (a >>> n)) | ConstValue(Const.Int16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkInt16Val g (a >>> n)) | ConstValue(Const.Int32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkInt32Val g (a >>> n)) | ConstValue(Const.Int64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkInt64Val g (a >>> n)) | _ -> UnknownValue | [ AI_shr_un ], [a;n], _ -> match stripValue a, stripValue n with - | ConstValue(Const.Byte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkUInt8Val g (a >>> n)) + | ConstValue(Const.Byte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkUInt8Val g (a >>> n)) | ConstValue(Const.UInt16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkUInt16Val g (a >>> n)) | ConstValue(Const.UInt32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkUInt32Val g (a >>> n)) | ConstValue(Const.UInt64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkUInt64Val g (a >>> n)) @@ -953,7 +953,7 @@ let mkAssemblyCodeValueInfo g instrs argvals tys = // We're conservative not to apply any actual data-changing conversions here. | [ ], [v], [ty] -> match stripValue v with - | ConstValue(Const.Bool a, _) -> + | ConstValue(Const.Bool a, _) -> if typeEquiv g ty g.bool_ty then v elif typeEquiv g ty g.sbyte_ty then mkInt8Val g (if a then 1y else 0y) elif typeEquiv g ty g.int16_ty then mkInt16Val g (if a then 1s else 0s) @@ -962,37 +962,37 @@ let mkAssemblyCodeValueInfo g instrs argvals tys = elif typeEquiv g ty g.uint16_ty then mkUInt16Val g (if a then 1us else 0us) elif typeEquiv g ty g.uint32_ty then mkUInt32Val g (if a then 1u else 0u) else UnknownValue - | ConstValue(Const.SByte a, _) -> + | ConstValue(Const.SByte a, _) -> if typeEquiv g ty g.sbyte_ty then v elif typeEquiv g ty g.int16_ty then mkInt16Val g (Unchecked.int16 a) elif typeEquiv g ty g.int32_ty then mkInt32Val g (Unchecked.int32 a) else UnknownValue - | ConstValue(Const.Byte a, _) -> + | ConstValue(Const.Byte a, _) -> if typeEquiv g ty g.byte_ty then v elif typeEquiv g ty g.uint16_ty then mkUInt16Val g (Unchecked.uint16 a) elif typeEquiv g ty g.uint32_ty then mkUInt32Val g (Unchecked.uint32 a) else UnknownValue - | ConstValue(Const.Int16 a, _) -> + | ConstValue(Const.Int16 a, _) -> if typeEquiv g ty g.int16_ty then v elif typeEquiv g ty g.int32_ty then mkInt32Val g (Unchecked.int32 a) else UnknownValue - | ConstValue(Const.UInt16 a, _) -> + | ConstValue(Const.UInt16 a, _) -> if typeEquiv g ty g.uint16_ty then v elif typeEquiv g ty g.uint32_ty then mkUInt32Val g (Unchecked.uint32 a) else UnknownValue - | ConstValue(Const.Int32 a, _) -> + | ConstValue(Const.Int32 a, _) -> if typeEquiv g ty g.int32_ty then v elif typeEquiv g ty g.uint32_ty then mkUInt32Val g (Unchecked.uint32 a) else UnknownValue - | ConstValue(Const.UInt32 a, _) -> + | ConstValue(Const.UInt32 a, _) -> if typeEquiv g ty g.uint32_ty then v elif typeEquiv g ty g.int32_ty then mkInt32Val g (Unchecked.int32 a) else UnknownValue - | ConstValue(Const.Int64 a, _) -> + | ConstValue(Const.Int64 a, _) -> if typeEquiv g ty g.int64_ty then v elif typeEquiv g ty g.uint64_ty then mkUInt64Val g (Unchecked.uint64 a) else UnknownValue - | ConstValue(Const.UInt64 a, _) -> + | ConstValue(Const.UInt64 a, _) -> if typeEquiv g ty g.uint64_ty then v elif typeEquiv g ty g.int64_ty then mkInt64Val g (Unchecked.int64 a) else UnknownValue @@ -1021,8 +1021,8 @@ let NoExprs : (Expr list * list>) = [], [] /// Common ways of building new value infos let CombineValueInfos einfos res = - { TotalSize = AddTotalSizes einfos - FunctionSize = AddFunctionSizes einfos + { TotalSize = AddTotalSizes einfos + FunctionSize = AddFunctionSizes einfos HasEffect = OrEffects einfos MightMakeCriticalTailcall = OrTailcalls einfos Info = res } @@ -1060,10 +1060,10 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when (let fvs = freeInExpr CollectAll expr (isAssemblyBoundary && not (freeVarsAllPublic fvs)) || - Zset.exists hiddenVal fvs.FreeLocals || - Zset.exists hiddenTycon fvs.FreeTyvars.FreeTycons || - Zset.exists hiddenTyconRepr fvs.FreeLocalTyconReprs || - Zset.exists hiddenRecdField fvs.FreeRecdFields || + Zset.exists hiddenVal fvs.FreeLocals || + Zset.exists hiddenTycon fvs.FreeTyvars.FreeTycons || + Zset.exists hiddenTyconRepr fvs.FreeLocalTyconReprs || + Zset.exists hiddenRecdField fvs.FreeRecdFields || Zset.exists hiddenUnionCase fvs.FreeUnionCases ) -> UnknownValue @@ -1074,10 +1074,10 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = Zset.exists hiddenTycon ftyvs.FreeTycons) -> UnknownValue - | TupleValue vinfos -> + | TupleValue vinfos -> TupleValue (Array.map abstractExprInfo vinfos) - | RecdValue (tcref, vinfos) -> + | RecdValue (tcref, vinfos) -> if hiddenTyconRepr tcref.Deref || Array.exists (tcref.MakeNestedRecdFieldRef >> hiddenRecdField) tcref.AllFieldsArray then UnknownValue else RecdValue (tcref, Array.map abstractExprInfo vinfos) @@ -1088,13 +1088,13 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = then UnknownValue else UnionCaseValue (ucref, Array.map abstractExprInfo vinfos) - | SizeValue(_vdepth, vinfo) -> + | SizeValue(_vdepth, vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) | UnknownValue | ConstExprValue _ | CurriedLambdaValue _ - | ConstValue _ -> ivalue + | ConstValue _ -> ivalue and abstractValInfo v = { ValExprInfo=abstractExprInfo v.ValExprInfo @@ -1105,7 +1105,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = ValInfos = ValInfos(ss.ValInfos.Entries |> Seq.filter (fun (vref, _) -> not (hiddenVal vref.Deref)) - |> Seq.map (fun (vref, e) -> check (* "its implementation uses a binding hidden by a signature" m *) vref (abstractValInfo e) )) } + |> Seq.map (fun (vref, e) -> check (* "its implementation uses a binding hidden by a signature" m *) vref (abstractValInfo e) )) } and abstractLazyModulInfo (ss: LazyModuleInfo) = ss.Force() |> abstractModulInfo |> notlazy @@ -1117,13 +1117,13 @@ let AbstractOptimizationInfoToEssentials = let rec abstractModulInfo (ss: ModuleInfo) = { ModuleOrNamespaceInfos = NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ss.ModuleOrNamespaceInfos - ValInfos = ss.ValInfos.Filter (fun (v, _) -> v.MustInline) } + ValInfos = ss.ValInfos.Filter (fun (v, _) -> v.MustInline) } and abstractLazyModulInfo ss = ss |> Lazy.force |> abstractModulInfo |> notlazy abstractLazyModulInfo -/// Hide information because of a "let ... in ..." or "let rec ... in ... " +/// Hide information because of a "let ... in ..." or "let rec ... in ... " let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = // Module and member bindings can be skipped when checking abstraction, since abstraction of these values has already been done when // we hit the end of the module and called AbstractLazyModulInfoByHiding. If we don't skip these then we end up quadtratically retraversing @@ -1151,7 +1151,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = ValValue (v2, detailR) // Check for escape in lambda - | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when + | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when (let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr (not (isNil boundVars) && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) || (not (isNil boundTyVars) && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) || @@ -1182,7 +1182,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } and abstractModulInfo ss = - { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) + { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ValInfos = ss.ValInfos.Map (fun (vref, e) -> check vref (abstractValInfo e) ) } @@ -1194,15 +1194,15 @@ let RemapOptimizationInfo g tmenv = let rec remapExprInfo ivalue = match ivalue with - | ValValue (v, detail) -> ValValue (remapValRef tmenv v, remapExprInfo detail) - | TupleValue vinfos -> TupleValue (Array.map remapExprInfo vinfos) - | RecdValue (tcref, vinfos) -> RecdValue (remapTyconRef tmenv.tyconRefRemap tcref, Array.map remapExprInfo vinfos) + | ValValue (v, detail) -> ValValue (remapValRef tmenv v, remapExprInfo detail) + | TupleValue vinfos -> TupleValue (Array.map remapExprInfo vinfos) + | RecdValue (tcref, vinfos) -> RecdValue (remapTyconRef tmenv.tyconRefRemap tcref, Array.map remapExprInfo vinfos) | UnionCaseValue(cspec, vinfos) -> UnionCaseValue (remapUnionCaseRef tmenv.tyconRefRemap cspec, Array.map remapExprInfo vinfos) | SizeValue(_vdepth, vinfo) -> MakeSizedValueInfo (remapExprInfo vinfo) - | UnknownValue -> UnknownValue - | CurriedLambdaValue (uniq, arity, sz, expr, ty) -> CurriedLambdaValue (uniq, arity, sz, remapExpr g CloneAll tmenv expr, remapPossibleForallTy g tmenv ty) - | ConstValue (c, ty) -> ConstValue (c, remapPossibleForallTy g tmenv ty) - | ConstExprValue (sz, expr) -> ConstExprValue (sz, remapExpr g CloneAll tmenv expr) + | UnknownValue -> UnknownValue + | CurriedLambdaValue (uniq, arity, sz, expr, ty) -> CurriedLambdaValue (uniq, arity, sz, remapExpr g CloneAll tmenv expr, remapPossibleForallTy g tmenv ty) + | ConstValue (c, ty) -> ConstValue (c, remapPossibleForallTy g tmenv ty) + | ConstExprValue (sz, expr) -> ConstExprValue (sz, remapExpr g CloneAll tmenv expr) let remapValInfo v = { ValExprInfo=remapExprInfo v.ValExprInfo @@ -1313,10 +1313,10 @@ let rec SplitValuesByIsUsedOrHasEffect cenv fvs x = let IlAssemblyCodeInstrHasEffect i = match i with - | ( AI_nop | AI_ldc _ | AI_add | AI_sub | AI_mul | AI_xor | AI_and | AI_or + | ( AI_nop | AI_ldc _ | AI_add | AI_sub | AI_mul | AI_xor | AI_and | AI_or | AI_ceq | AI_cgt | AI_cgt_un | AI_clt | AI_clt_un | AI_conv _ | AI_shl | AI_shr | AI_shr_un | AI_neg | AI_not | AI_ldnull ) - | I_ldstr _ | I_ldtoken _ -> false + | I_ldstr _ | I_ldtoken _ -> false | _ -> true let IlAssemblyCodeHasEffect instrs = List.exists IlAssemblyCodeInstrHasEffect instrs @@ -1361,8 +1361,8 @@ and OpHasEffect g m op = | 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.ValFieldGetAddr (rfref, _readonly) -> rfref.RecdField.IsMutable + | 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 | TOp.UnionCaseFieldSet _ @@ -1370,19 +1370,19 @@ and OpHasEffect g m op = | TOp.Coerce | TOp.Reraise | TOp.For _ - | TOp.While _ - | TOp.TryCatch _ (* conservative *) + | TOp.While _ + | TOp.TryCatch _ (* conservative *) | TOp.TryFinally _ (* conservative *) | TOp.TraitCall _ | TOp.Goto _ | TOp.Label _ | TOp.Return | TOp.ILCall _ (* conservative *) - | TOp.LValueOp _ (* conservative *) + | TOp.LValueOp _ (* conservative *) | TOp.ValFieldSet _ -> true -let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = +let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = // don't eliminate bindings if we're not optimizing AND the binding is not a compiler generated variable if not (cenv.optimizing && cenv.settings.EliminateImmediatelyConsumedLocals()) && not vspec1.IsCompilerGenerated then @@ -1430,7 +1430,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = | 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([], 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)) | None -> None @@ -1441,7 +1441,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = | Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [arg1;arg2], m2);arg3], m1) -> match GetImmediateUseContext [] [arg1;arg2;arg3] with | Some([], [arg2;arg3]) -> Some (Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [e1;arg2], m2);arg3], m1)) - | Some([arg1], [arg3]) -> Some (Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [arg1;e1], m2);arg3], m1)) + | Some([arg1], [arg3]) -> Some (Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [arg1;e1], m2);arg3], m1)) | Some([arg1;arg2], []) -> Some (Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [arg1;arg2], m2);e1], m1)) | Some _ -> error(InternalError("unexpected return pattern from GetImmediateUseContext", m1)) | None -> None @@ -1458,8 +1458,8 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = let TryEliminateLet cenv env bind e2 m = match TryEliminateBinding cenv env bind e2 m with - | Some e2R -> e2R, -localVarSize (* eliminated a let, hence reduce size estimate *) - | None -> mkLetBind m bind e2 , 0 + | Some e2R -> e2R, -localVarSize (* eliminated a let, hence reduce size estimate *) + | None -> mkLetBind m bind e2, 0 /// Detect the application of a value to an arbitrary number of arguments let rec (|KnownValApp|_|) expr = @@ -1478,7 +1478,7 @@ let (|TDBoolSwitch|_|) dtree = None /// Check target that have a constant bool value -let (|ConstantBoolTarget|_|) target = +let (|ConstantBoolTarget|_|) target = match target with | TTarget([], Expr.Const (Const.Bool b,_,_),_) -> Some b | _ -> None @@ -1486,33 +1486,33 @@ let (|ConstantBoolTarget|_|) target = /// Is this a tree, where each decision is a two-way switch (to prevent later duplication of trees), and each branch returns or true/false, /// apart from one branch which defers to another expression let rec CountBoolLogicTree ((targets: DecisionTreeTarget[], costOuterCaseTree, costOuterDefaultTree, testBool) as data) tree = - match tree with + match tree with | TDSwitch (_expr, [case], Some defaultTree, _range) -> let tc1,ec1 = CountBoolLogicTree data case.CaseTree let tc2, ec2 = CountBoolLogicTree data defaultTree tc1 + tc2, ec1 + ec2 - | TDSuccess([], idx) -> + | TDSuccess([], idx) -> match targets.[idx] with | ConstantBoolTarget result -> (if result = testBool then costOuterCaseTree else costOuterDefaultTree), 0 | TTarget([], _exp, _) -> costOuterCaseTree + costOuterDefaultTree, 10 | _ -> 100, 100 | _ -> 100, 100 -/// Rewrite a decision tree for which CountBoolLogicTree returned a low number (see below). Produce a new decision +/// Rewrite a decision tree for which CountBoolLogicTree returned a low number (see below). Produce a new decision /// tree where at each ConstantBoolSuccessTree tip we replace with either outerCaseTree or outerDefaultTree /// depending on whether the target result was true/false let rec RewriteBoolLogicTree ((targets: DecisionTreeTarget[], outerCaseTree, outerDefaultTree, testBool) as data) tree = - match tree with + match tree with | TDSwitch (expr, cases, defaultTree, range) -> let cases2 = cases |> List.map (RewriteBoolLogicCase data) let defaultTree2 = defaultTree |> Option.map (RewriteBoolLogicTree data) - TDSwitch (expr, cases2, defaultTree2, range) - | TDSuccess([], idx) -> + TDSwitch (expr, cases2, defaultTree2, range) + | TDSuccess([], idx) -> match targets.[idx] with | ConstantBoolTarget result -> if result = testBool then outerCaseTree else outerDefaultTree | TTarget([], exp, _) -> mkBoolSwitch exp.Range exp (if testBool then outerCaseTree else outerDefaultTree) (if testBool then outerDefaultTree else outerCaseTree) | _ -> failwith "CountBoolLogicTree should exclude this case" - | _ -> failwith "CountBoolLogicTree should exclude this case" + | _ -> failwith "CountBoolLogicTree should exclude this case" and RewriteBoolLogicCase data (TCase(test, tree)) = TCase(test, RewriteBoolLogicTree data tree) @@ -1527,9 +1527,9 @@ let rec CombineBoolLogic expr = | Expr.Match(outerSP, outerMatchRange, TDBoolSwitch(Expr.Match(_innerSP, _innerMatchRange, innerTree, innerTargets, _innerDefaultRange, _innerMatchTy), outerTestBool, outerCaseTree, outerDefaultTree, _outerSwitchRange ), - outerTargets, outerDefaultRange, outerMatchTy) -> + outerTargets, outerDefaultRange, outerMatchTy) -> - let costOuterCaseTree = match outerCaseTree with TDSuccess _ -> 0 | _ -> 1 + let costOuterCaseTree = match outerCaseTree with TDSuccess _ -> 0 | _ -> 1 let costOuterDefaultTree = match outerDefaultTree with TDSuccess _ -> 0 | _ -> 1 let tc, ec = CountBoolLogicTree (innerTargets, costOuterCaseTree, costOuterDefaultTree, outerTestBool) innerTree // At most one expression, no overall duplication of TSwitch nodes @@ -1567,7 +1567,7 @@ let ExpandStructuralBindingRaw cenv expr = | Expr.Let (TBind(v, rhs, tgtSeqPtOpt), body, m, _) when (isRefTupleExpr rhs && CanExpandStructuralBinding v) -> - let args = tryDestRefTupleExpr rhs + let args = tryDestRefTupleExpr rhs if List.forall ExprIsValue args then expr (* avoid re-expanding when recursion hits original binding *) else @@ -1615,7 +1615,7 @@ let (|QueryRun|_|) g expr = match expr with | 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 @@ -1630,31 +1630,31 @@ let (|AnyInstanceMethodApp|_|) e = let (|InstanceMethodApp|_|) g (expectedValRef: ValRef) e = match e with | AnyInstanceMethodApp (vref, tyargs, obj, args) when valRefEq g vref expectedValRef -> Some (tyargs, obj, args) - | _ -> None + | _ -> None let (|QuerySourceEnumerable|_|) g = function - | InstanceMethodApp g g.query_source_vref ([resTy], _builder, [res]) -> Some (resTy, res) - | _ -> None + | InstanceMethodApp g g.query_source_vref ([resTy], _builder, [res]) -> Some (resTy, res) + | _ -> None let (|QueryFor|_|) g = function - | InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) - | _ -> None + | InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) + | _ -> None let (|QueryYield|_|) g = function - | InstanceMethodApp g g.query_yield_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) - | _ -> None + | InstanceMethodApp g g.query_yield_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) + | _ -> None let (|QueryYieldFrom|_|) g = function - | InstanceMethodApp g g.query_yield_from_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) - | _ -> None + | InstanceMethodApp g g.query_yield_from_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) + | _ -> None let (|QuerySelect|_|) g = function - | InstanceMethodApp g g.query_select_vref ([srcTy;qTy;resTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) - | _ -> None + | InstanceMethodApp g g.query_select_vref ([srcTy;qTy;resTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) + | _ -> None let (|QueryZero|_|) g = function - | InstanceMethodApp g g.query_zero_vref ([resTy;qTy], _builder, _) -> Some (qTy, resTy) - | _ -> None + | InstanceMethodApp g g.query_zero_vref ([resTy;qTy], _builder, _) -> Some (qTy, resTy) + | _ -> None /// Look for a possible tuple and transform let (|AnyRefTupleTrans|) e = @@ -1667,7 +1667,7 @@ let (|AnyQueryBuilderOpTrans|_|) g = function | 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))) - | _ -> None + | _ -> None let mkUnitDelayLambda (g: TcGlobals) m e = let uv, _ = mkCompGenLocal m "unitVar" g.unit_ty @@ -1676,23 +1676,23 @@ let mkUnitDelayLambda (g: TcGlobals) m e = /// If this returns "Some" then the source is not IQueryable. // := // | query.Select(, ) --> Seq.map(qexprInner', ...) -// | query.For(, ) --> IQueryable if qexprInner is IQueryable, otherwise Seq.collect(qexprInner', ...) -// | query.Yield --> not IQueryable -// | query.YieldFrom --> not IQueryable -// | query.Op(, ) --> IQueryable if qexprInner is IQueryable, otherwise query.Op(qexprInner', ) -// | :> seq<_> --> IQueryable if qexprInner is IQueryable +// | query.For(, ) --> IQueryable if qexprInner is IQueryable, otherwise Seq.collect(qexprInner', ...) +// | query.Yield --> not IQueryable +// | query.YieldFrom --> not IQueryable +// | query.Op(, ) --> IQueryable if qexprInner is IQueryable, otherwise query.Op(qexprInner', ) +// | :> seq<_> --> IQueryable if qexprInner is IQueryable // // := // | query.Select(, ) --> IQueryable if qexprInner is IQueryable, otherwise seq { qexprInner' } -// | query.For(, ) --> IQueryable if qexprInner is IQueryable, otherwise seq { qexprInner' } -// | query.Yield --> not IQueryable, seq { } -// | query.YieldFrom --> not IQueryable, seq { yield! } -// | query.Op(, ) --> IQueryable if qexprOuter is IQueryable, otherwise query.Op(qexpOuter', ) +// | query.For(, ) --> IQueryable if qexprInner is IQueryable, otherwise seq { qexprInner' } +// | query.Yield --> not IQueryable, seq { } +// | query.YieldFrom --> not IQueryable, seq { yield! } +// | query.Op(, ) --> IQueryable if qexprOuter is IQueryable, otherwise query.Op(qexpOuter', ) let rec tryRewriteToSeqCombinators g (e: Expr) = let m = e.Range match e with - // query.Yield --> Seq.singleton - | QueryYield g (_, resultElemTy, vExpr) -> Some (mkCallSeqSingleton g m resultElemTy vExpr) + // query.Yield --> Seq.singleton + | QueryYield g (_, resultElemTy, vExpr) -> Some (mkCallSeqSingleton g m resultElemTy vExpr) // query.YieldFrom (query.Source s) --> s | QueryYieldFrom g (_, _, QuerySourceEnumerable g (_, resExpr)) -> Some resExpr @@ -1796,7 +1796,7 @@ let TryDetectQueryQuoteAndRun cenv (expr: Expr) = match reqdResultInfo, exprIsEnumerableInfo with | Some _, Some _ | None, None -> resultExpr // the expression is a QuerySource, the result is a QuerySource, nothing to do | Some resultElemTy, None -> mkCallGetQuerySourceAsEnumerable cenv.g expr.Range resultElemTy (TType_app(cenv.g.tcref_System_Collections_IEnumerable, [])) resultExpr - | None, Some (resultElemTy, qTy) -> mkCallNewQuerySource cenv.g expr.Range resultElemTy qTy resultExpr + | None, Some (resultElemTy, qTy) -> mkCallNewQuerySource cenv.g expr.Range resultElemTy qTy resultExpr Some resultExprAfterConvertToResultTy | None -> None @@ -1868,12 +1868,12 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = 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 - | Expr.TyChoose _ -> + | Expr.TyChoose _ -> OptimizeExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) | Expr.Match(spMatch, exprm, dtree, targets, m, ty) -> @@ -2015,10 +2015,10 @@ 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, _, _)] -> @@ -2068,8 +2068,8 @@ and OptimizeExprOpReductionsAfter cenv env (op, tyargs, argsR, arginfos, m) = | _ -> None match knownValue with | Some valu -> - match TryOptimizeVal cenv env (false, valu, m) with - | Some res -> OptimizeExpr cenv env res (* discard e1 since guard ensures it has no effects *) + match TryOptimizeVal cenv env (false, valu, m) with + | Some res -> OptimizeExpr cenv env res (* discard e1 since guard ensures it has no effects *) | None -> OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu | None -> OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos UnknownValue @@ -2084,11 +2084,11 @@ and OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu = match op with | TOp.UnionCase c -> 2, MakeValueInfoForUnionCase c (Array.ofList argValues) | TOp.ExnConstr _ -> 2, valu (* REVIEW: information collection possible here *) - | TOp.Tuple tupInfo -> + | TOp.Tuple tupInfo -> let isStruct = evalTupInfoIsStruct tupInfo if isStruct then 0, valu else 1,MakeValueInfoForTuple (Array.ofList argValues) - | TOp.AnonRecd anonInfo -> + | TOp.AnonRecd anonInfo -> let isStruct = evalAnonInfoIsStruct anonInfo if isStruct then 0, valu else 1, valu @@ -2097,22 +2097,22 @@ and OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu = | TOp.TupleFieldGet _ | TOp.UnionCaseFieldGet _ | TOp.ExnFieldGet _ - | TOp.UnionCaseTagGet _ -> + | TOp.UnionCaseTagGet _ -> // REVIEW: reduction possible here, and may be very effective 1, valu - | TOp.UnionCaseProof _ -> + | TOp.UnionCaseProof _ -> // We count the proof as size 0 // We maintain the value of the source of the proof-cast if it is known to be a UnionCaseValue let valu = match argValues.[0] with | StripUnionCaseValue (uc, info) -> UnionCaseValue(uc, info) - | _ -> valu + | _ -> 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 - | TOp.UInt16s bytes -> bytes.Length/10 , valu + | TOp.Bytes bytes -> bytes.Length/10, valu + | TOp.UInt16s bytes -> bytes.Length/10, valu | TOp.ValFieldGetAddr _ | TOp.Array | TOp.For _ | TOp.While _ | TOp.TryCatch _ | TOp.TryFinally _ | TOp.ILCall _ | TOp.TraitCall _ | TOp.LValueOp _ | TOp.ValFieldSet _ @@ -2204,8 +2204,8 @@ and OptimizeFastIntegerForLoop cenv env (spStart, v, e1, dir, e2, e3, m) = let env = BindInternalValToUnknown cenv v env let e3R, e3info = OptimizeExpr cenv env e3 // Try to replace F#-style loops with C# style loops that recompute their bounds but which are compiled more efficiently by the JITs, e.g. - // F# "for x = 0 to arr.Length - 1 do ..." --> C# "for (int x = 0; x < arr.Length; x++) { ... }" - // F# "for x = 0 to 10 do ..." --> C# "for (int x = 0; x < 11; x++) { ... }" + // F# "for x = 0 to arr.Length - 1 do ..." --> C# "for (int x = 0; x < arr.Length; x++) { ... }" + // F# "for x = 0 to 10 do ..." --> C# "for (int x = 0; x < 11; x++) { ... }" 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 @@ -2226,7 +2226,7 @@ and OptimizeFastIntegerForLoop cenv env (spStart, v, e1, dir, e2, e3, m) = let eff = OrEffects einfos (* neither bounds nor body has an effect, and loops always terminate, hence eliminate the loop *) if not eff then - mkUnit cenv.g m , { TotalSize=0; FunctionSize=0; HasEffect=false; MightMakeCriticalTailcall=false; Info=UnknownValue } + mkUnit cenv.g m, { TotalSize=0; FunctionSize=0; HasEffect=false; MightMakeCriticalTailcall=false; Info=UnknownValue } else let exprR = mkFor cenv.g (spStart, v, e1R, dir, e2R, e3R, m) exprR, { TotalSize=AddTotalSizes einfos + forAndWhileLoopSize @@ -2280,7 +2280,7 @@ and OptimizeLinearExpr cenv env expr contf = HasEffect = flag <> NormalSeq || e1info.HasEffect || e2info.HasEffect MightMakeCriticalTailcall = (if flag = NormalSeq then e2info.MightMakeCriticalTailcall - else e1info.MightMakeCriticalTailcall || e2info.MightMakeCriticalTailcall) + else e1info.MightMakeCriticalTailcall || e2info.MightMakeCriticalTailcall) // can't propagate value: must access result of computation for its effects Info = UnknownValue })) @@ -2291,7 +2291,7 @@ and OptimizeLinearExpr cenv env expr contf = // Is it quadratic or quasi-quadtratic? if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr CollectLocals bodyR).FreeLocals) (bindR, bindingInfo) then // Eliminate let bindings on the way back up - let exprR, adjust = TryEliminateLet cenv env bindR bodyR m + let exprR, adjust = TryEliminateLet cenv env bindR bodyR m exprR, { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize + adjust FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize + adjust @@ -2360,8 +2360,8 @@ and OptimizeTryCatch cenv env (e1, vf, ef, vh, eh, m, ty, spTry, spWith) = let efR, efinfo = OptimizeExpr cenv envinner ef let ehR, ehinfo = OptimizeExpr cenv envinner eh let info = - { TotalSize = e1info.TotalSize + efinfo.TotalSize+ ehinfo.TotalSize + tryCatchSize - FunctionSize = e1info.FunctionSize + efinfo.FunctionSize+ ehinfo.FunctionSize + tryCatchSize + { TotalSize = e1info.TotalSize + efinfo.TotalSize+ ehinfo.TotalSize + tryCatchSize + FunctionSize = e1info.FunctionSize + efinfo.FunctionSize+ ehinfo.FunctionSize + tryCatchSize HasEffect = e1info.HasEffect || efinfo.HasEffect || ehinfo.HasEffect MightMakeCriticalTailcall = false Info = UnknownValue } @@ -2369,7 +2369,7 @@ and OptimizeTryCatch cenv env (e1, vf, ef, vh, eh, m, ty, spTry, spWith) = info /// Optimize/analyze a while loop -and OptimizeWhileLoop cenv env (spWhile, marker, e1, e2, m) = +and OptimizeWhileLoop cenv env (spWhile, marker, e1, e2, m) = let e1R, e1info = OptimizeExpr cenv env e1 let e2R, e2info = OptimizeExpr cenv env e2 mkWhile cenv.g (spWhile, marker, e1R, e2R, m), @@ -2383,7 +2383,7 @@ and OptimizeWhileLoop cenv env (spWhile, marker, e1, e2, m) = /// a witness (should always be possible due to compulsory inlining of any /// code that contains calls to member constraints, except when analyzing /// not-yet-inlined generic code) -and OptimizeTraitCall cenv env (traitInfo, args, m) = +and OptimizeTraitCall cenv env (traitInfo, args, m) = // Resolve the static overloading early (during the compulsory rewrite phase) so we can inline. match ConstraintSolver.CodegenWitnessThatTypeSupportsTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo args with @@ -2391,7 +2391,7 @@ and OptimizeTraitCall cenv env (traitInfo, args, m) = | OkResult (_, Some expr) -> OptimizeExpr cenv env expr // 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 @@ -2413,7 +2413,7 @@ and TryOptimizeVal cenv env (mustInline, valInfoForVal, m) = // If the more specific info didn't reveal an inline then use the value match TryOptimizeVal cenv env (mustInline, detail, m) with | Some e -> Some e - | None -> Some(exprForValRef m vR) + | None -> Some(exprForValRef m vR) | ConstExprValue(_size, expr) -> Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) @@ -2432,7 +2432,7 @@ and TryOptimizeVal cenv env (mustInline, valInfoForVal, m) = | _ -> None and TryOptimizeValInfo cenv env m vinfo = - if vinfo.HasEffect then None else TryOptimizeVal cenv env (false, vinfo.Info , m) + if vinfo.HasEffect then None else TryOptimizeVal cenv env (false, vinfo.Info, m) /// Add 'v1 = v2' information into the information stored about a value and AddValEqualityInfo g m (v: ValRef) info = @@ -2466,7 +2466,7 @@ and OptimizeVal cenv env expr (v: ValRef, m) = e, AddValEqualityInfo cenv.g m v einfo | None -> - if v.MustInline then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) + if v.MustInline then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) expr, (AddValEqualityInfo cenv.g m v { Info=valInfoForVal.ValExprInfo HasEffect=false @@ -2484,7 +2484,7 @@ and StripToNominalTyconRef cenv ty = mkCompiledTupleTyconRef cenv.g false (List.length tyargs), tyargs else failwith "StripToNominalTyconRef: unreachable" -and CanDevirtualizeApplication cenv v vref ty args = +and CanDevirtualizeApplication cenv v vref ty args = valRefEq cenv.g v vref && not (isUnitTy cenv.g ty) && isAppTy cenv.g ty @@ -2533,14 +2533,14 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedCompareToValues with - | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) + | 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 -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedCompareToWithComparerValues, args with - | Some vref, [comp; x; y] -> + | Some vref, [comp; x; y] -> // the target takes a tupled argument, so we need to reorder the arg expressions in the // arg list, and create a tuple of y & comp // push the comparer to the end and box the argument @@ -2556,21 +2556,21 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsValues with - | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) + | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty 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 -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with - | Some (_, _, withcEqualsVal), [comp; x; y] -> + | Some (_, _, withcEqualsVal), [comp; x; y] -> // push the comparer to the end and box the argument let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y, cenv.g.obj_ty, m, ty) ; comp]] Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 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] -> @@ -2588,16 +2588,16 @@ 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] -> + | Some (_, withcGetHashCodeVal, _), [comp; x] -> let args2 = [x; comp] Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 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 @@ -2756,7 +2756,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) let isSecureMethod = match finfo.Info with - | ValValue(vref, _) -> + | ValValue(vref, _) -> vref.Attribs |> List.exists (fun a -> (IsSecurityAttribute cenv.g cenv.amap cenv.casApplied a m) || (IsSecurityCriticalAttribute cenv.g a)) | _ -> false @@ -2770,7 +2770,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) if isGetHashCode then None else // Inlining lambda - (* ---------- printf "Inlining lambda near %a = %s\n" outputRange m (showL (exprL f2)) (* JAMES: *) ----------*) + (* ---------- printf "Inlining lambda near %a = %s\n" outputRange m (showL (exprL f2)) (* JAMES: *) ----------*) let f2R = remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated f2) // Optimizing arguments after inlining @@ -2778,7 +2778,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) // inlining kicking into effect let argsR = args |> List.map (fun e -> let eR, _einfo = OptimizeExpr cenv env e in eR) // Beta reduce. MakeApplicationAndBetaReduce cenv.g does all the hard work. - // Inlining: beta reducing + // Inlining: beta reducing let exprR = MakeApplicationAndBetaReduce cenv.g (f2R, f2ty, [tyargs], argsR, m) // Inlining: reoptimizing Some(OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} exprR) @@ -2832,14 +2832,14 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = // Determine if this application is a critical tailcall let mayBeCriticalTailcall = match newf0 with - | KnownValApp(vref, _typeArgs, otherArgs) -> + | KnownValApp(vref, _typeArgs, otherArgs) -> // Check if this is a call to a function of known arity that has been inferred to not be a critical tailcall when used as a direct call // This includes recursive calls to the function being defined (in which case we get a non-critical, closed-world tailcall). // Note we also have to check the argument count to ensure this is a direct call (or a partial application). let doesNotMakeCriticalTailcall = vref.MakesNoCriticalTailcalls || - (let valInfoForVal = GetInfoForVal cenv env m vref in valInfoForVal.ValMakesNoCriticalTailcalls) || + (let valInfoForVal = GetInfoForVal cenv env m vref in valInfoForVal.ValMakesNoCriticalTailcalls) || (match env.functionVal with | None -> false | Some (v, _) -> valEq vref.Deref v) if doesNotMakeCriticalTailcall then let numArgs = otherArgs.Length + newArgs.Length @@ -2847,7 +2847,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = | Some i -> numArgs > i.NumCurriedArgs | None -> match env.functionVal with - | Some (_v, i) -> numArgs > i.NumCurriedArgs + | Some (_v, i) -> numArgs > i.NumCurriedArgs | None -> true // over-application of a known function, which presumably returns a function. This counts as an indirect call else true // application of a function that may make a critical tailcall @@ -2896,9 +2896,9 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = else printfn "value %s at line %d does not make a critical tailcall" v.DisplayName v.Range.StartLine if cenv.settings.reportTotalSizes then - printfn "value %s at line %d has total size %d" v.DisplayName v.Range.StartLine bodyinfo.TotalSize + printfn "value %s at line %d has total size %d" v.DisplayName v.Range.StartLine bodyinfo.TotalSize if cenv.settings.reportFunctionSizes then - printfn "value %s at line %d has method size %d" v.DisplayName v.Range.StartLine bodyinfo.FunctionSize + printfn "value %s at line %d has method size %d" v.DisplayName v.Range.StartLine bodyinfo.FunctionSize if cenv.settings.reportHasEffect then if bodyinfo.HasEffect then printfn "function %s at line %d causes side effects or may not terminate" v.DisplayName v.Range.StartLine @@ -2978,7 +2978,7 @@ and ComputeSplitToMethodCondition flag threshold cenv env (e: Expr, einfo) = // It can't use any protected or base calls, rethrow(), byrefs etc. let m = e.Range (let fvs = freeInExpr CollectLocals e - not fvs.UsesUnboundRethrow && + not fvs.UsesUnboundRethrow && not fvs.UsesMethodLocalConstructs && fvs.FreeLocals |> Zset.forall (fun v -> // no direct-self-recursive references @@ -3084,7 +3084,7 @@ and OptimizeDecisionTree cenv env m x = and TryOptimizeDecisionTreeTest cenv test vinfo = match test, vinfo with - | DecisionTreeTest.UnionCase (c1, _), StripUnionCaseValue(c2, _) -> Some(cenv.g.unionCaseRefEq c1 c2) + | 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) @@ -3100,7 +3100,7 @@ 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 + 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 @@ -3124,7 +3124,7 @@ and OptimizeSwitchFallback cenv env (eR, einfo, cases, dflt, m) = | Some df -> let dfR, einfo = OptimizeDecisionTree cenv env m df in Some dfR, [einfo] let size = (dinfos.Length + cinfos.Length) * 2 let info = CombineValueInfosUnknown (einfo :: cinfos @ dinfos) - let info = { info with TotalSize = info.TotalSize + size; FunctionSize = info.FunctionSize + size; } + let info = { info with TotalSize = info.TotalSize + size; FunctionSize = info.FunctionSize + size; } TDSwitch (eR, casesR, dfltR, m), info and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = @@ -3135,14 +3135,14 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = // any expression that contains a reference to any value in RVS. // This doesn't prevent splitting for mutually recursive references. See FSharp 1.0 bug 2892. let env = - if isRec then { env with dontSplitVars = env.dontSplitVars.Add vref () } + if isRec then { env with dontSplitVars = env.dontSplitVars.Add vref () } else env let exprOptimized, einfo = let env = if vref.IsCompilerGenerated && Option.isSome env.latestBoundId then env else {env with latestBoundId=Some vref.Id} let cenv = if vref.InlineInfo = ValInline.PseudoVal then { cenv with optimizing=false} else cenv let arityInfo = InferArityOfExprBinding cenv.g AllowTypeDirectedDetupling.No vref expr - let exprOptimized, einfo = OptimizeLambdas (Some vref) cenv env arityInfo expr vref.Type + let exprOptimized, einfo = OptimizeLambdas (Some vref) cenv env arityInfo expr vref.Type let size = localVarSize exprOptimized, {einfo with FunctionSize=einfo.FunctionSize+size; TotalSize = einfo.TotalSize+size} @@ -3166,10 +3166,10 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = | TupleValue a -> TupleValue(Array.map cut a) | RecdValue (tcref, a) -> RecdValue(tcref, Array.map cut a) | UnionCaseValue (a, b) -> UnionCaseValue (a, Array.map cut b) - | UnknownValue | ConstValue _ | ConstExprValue _ -> ivalue + | UnknownValue | ConstValue _ | ConstExprValue _ -> ivalue | SizeValue(_, a) -> MakeSizedValueInfo (cut a) - let einfo = if vref.MustInline then einfo else {einfo with Info = cut einfo.Info } + let einfo = if vref.MustInline then einfo else {einfo with Info = cut einfo.Info } let einfo = if (not vref.MustInline && not (cenv.settings.KeepOptimizationValues())) || @@ -3219,7 +3219,7 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = valRefEq cenv.g nvref cenv.g.generic_hash_inner_vref)) then {einfo with Info=UnknownValue} else einfo - if vref.MustInline && IsPartialExprVal einfo.Info then + if vref.MustInline && IsPartialExprVal einfo.Info then errorR(InternalError("the mustinline value '"+vref.LogicalName+"' was not inferred to have a known value", vref.Range)) let env = BindInternalLocalVal cenv vref (mkValInfo einfo vref) env @@ -3287,11 +3287,11 @@ and OptimizeModuleExpr cenv env x = | TMDefRec(isRec, tycons, mbinds, m) -> let mbinds = mbinds |> List.choose elimModuleBinding TMDefRec(isRec, tycons, mbinds, m) - | TMDefLet(bind, m) -> + | TMDefLet(bind, m) -> if Zset.contains bind.Var deadSet then TMDefRec(false, [], [], m) else x - | TMDefDo _ -> x + | TMDefDo _ -> x | TMDefs(defs) -> TMDefs(List.map elimModDef defs) - | TMAbstract _ -> x + | TMAbstract _ -> x and elimModuleBinding x = match x with @@ -3332,17 +3332,17 @@ and OptimizeModuleDef cenv (env, bindInfosColl) x = let env = BindValsInModuleOrNamespace cenv info env (TMAbstract(mexpr), info), (env, bindInfosColl) - | TMDefLet(bind, m) -> + | TMDefLet(bind, m) -> let ((bindR, binfo) as bindInfo), env = OptimizeBinding cenv false env bind (TMDefLet(bindR, m), notlazy { ValInfos=ValInfos [mkValBind bind (mkValInfo binfo bind.Var)] ModuleOrNamespaceInfos = NameMap.empty }), - (env , ([bindInfo]::bindInfosColl)) + (env, ([bindInfo]::bindInfosColl)) - | TMDefDo(e, m) -> + | TMDefDo(e, m) -> let (e, _einfo) = OptimizeExpr cenv env e (TMDefDo(e, m), EmptyModuleInfo), - (env , bindInfosColl) + (env, bindInfosColl) | TMDefs(defs) -> let (defs, info), (env, bindInfosColl) = OptimizeModuleDefs cenv (env, bindInfosColl) defs @@ -3354,7 +3354,7 @@ and OptimizeModuleBinding cenv (env, bindInfosColl) x = match x with | ModuleOrNamespaceBinding.Binding bind -> let ((bindR, binfo) as bindInfo), env = OptimizeBinding cenv true env bind - (ModuleOrNamespaceBinding.Binding bindR, Choice1Of2 (bindR, binfo)), (env, [ bindInfo ] :: bindInfosColl) + (ModuleOrNamespaceBinding.Binding bindR, Choice1Of2 (bindR, binfo)), (env, [ bindInfo ] :: bindInfosColl) | ModuleOrNamespaceBinding.Module(mspec, def) -> let id = mspec.Id let (def, info), (_, bindInfosColl) = OptimizeModuleDef cenv (env, bindInfosColl) def @@ -3368,7 +3368,7 @@ and OptimizeModuleDefs cenv (env, bindInfosColl) defs = (defs, UnionOptimizationInfos minfos), (env, bindInfosColl) and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, mexpr, hasExplicitEntryPoint, isScript, anonRecdTypes)) = - let env, mexprR, minfo = + let env, mexprR, minfo = match mexpr with // FSI: FSI compiles everything as if you're typing incrementally into one module // This means the fragment is not truly a constrained module as later fragments will be typechecked @@ -3377,7 +3377,7 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qn | ModuleOrNamespaceExprWithSig(mty, def, m) when isIncrementalFragment -> let (def, minfo), (env, _bindInfosColl) = OptimizeModuleDef cenv (env, []) def env, ModuleOrNamespaceExprWithSig(mty, def, m), minfo - | _ -> + | _ -> let mexprR, minfo = OptimizeModuleExpr cenv env mexpr let env = BindValsInModuleOrNamespace cenv minfo env let env = { env with localExternalVals=env.localExternalVals.MarkAsCollapsible() } // take the chance to flatten to a dictionary @@ -3452,14 +3452,14 @@ let rec u_ExprInfo st = let rec loop st = let tag = u_byte st match tag with - | 0 -> u_tup2 u_const u_ty st |> (fun (c, ty) -> ConstValue(c, ty)) + | 0 -> u_tup2 u_const u_ty st |> (fun (c, ty) -> ConstValue(c, ty)) | 1 -> UnknownValue - | 2 -> u_tup2 u_vref loop st |> (fun (a, b) -> ValValue (a, b)) - | 3 -> u_array loop st |> (fun a -> TupleValue a) - | 4 -> u_tup2 u_ucref (u_array loop) st |> (fun (a, b) -> UnionCaseValue (a, b)) - | 5 -> u_tup4 u_int u_int u_expr u_ty st |> (fun (b, c, d, e) -> CurriedLambdaValue (newUnique(), b, c, d, e)) - | 6 -> u_tup2 u_int u_expr st |> (fun (a, b) -> ConstExprValue (a, b)) - | 7 -> u_tup2 u_tcref (u_array loop) st |> (fun (a, b) -> RecdValue (a, b)) + | 2 -> u_tup2 u_vref loop st |> (fun (a, b) -> ValValue (a, b)) + | 3 -> u_array loop st |> (fun a -> TupleValue a) + | 4 -> u_tup2 u_ucref (u_array loop) st |> (fun (a, b) -> UnionCaseValue (a, b)) + | 5 -> u_tup4 u_int u_int u_expr u_ty st |> (fun (b, c, d, e) -> CurriedLambdaValue (newUnique(), b, c, d, e)) + | 6 -> u_tup2 u_int u_expr st |> (fun (a, b) -> ConstExprValue (a, b)) + | 7 -> u_tup2 u_tcref (u_array loop) st |> (fun (a, b) -> RecdValue (a, b)) | _ -> failwith "loop" MakeSizedValueInfo (loop st) (* calc size of unpicked ExprValueInfo *) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index ee310acddfb..0f4bf494cae 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -80,7 +80,7 @@ let debug = false // let x, y = [], [] // // BindSubExprOfInput actually produces the binding -// e.g. let v2 = \Gamma ['a, 'b]. ([] : 'a , [] : 'b) +// e.g. let v2 = \Gamma ['a, 'b]. ([] : 'a, [] : 'b) // let (x, y) = p. // When v = x, gtvs = 'a, 'b. We must bind: // x --> \Gamma A. fst (v2[A, ]) @@ -210,7 +210,7 @@ let RefuteDiscrimSet g m path discrims = | 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 @@ -298,7 +298,7 @@ let RefuteDiscrimSet g m path discrims = 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 @@ -435,7 +435,7 @@ let discrimsEq (g: TcGlobals) d1 d2 = | DecisionTreeTest.UnionCase (c1, _), DecisionTreeTest.UnionCase(c2, _) -> g.unionCaseRefEq c1 c2 | DecisionTreeTest.ArrayLength (n1, _), DecisionTreeTest.ArrayLength(n2, _) -> (n1=n2) | DecisionTreeTest.Const c1, DecisionTreeTest.Const c2 -> (c1=c2) - | DecisionTreeTest.IsNull , DecisionTreeTest.IsNull -> true + | DecisionTreeTest.IsNull, DecisionTreeTest.IsNull -> true | DecisionTreeTest.IsInst (srcty1, tgty1), DecisionTreeTest.IsInst (srcty2, tgty2) -> typeEquiv g srcty1 srcty2 && typeEquiv g tgty1 tgty2 | DecisionTreeTest.ActivePatternCase (_, _, vrefOpt1, n1, _), DecisionTreeTest.ActivePatternCase (_, _, vrefOpt2, n2, _) -> match vrefOpt1, vrefOpt2 with @@ -478,7 +478,7 @@ let canCompactConstantClass c = let discrimsHaveSameSimultaneousClass g d1 d2 = match d1, d2 with | DecisionTreeTest.Const _, DecisionTreeTest.Const _ - | DecisionTreeTest.IsNull , DecisionTreeTest.IsNull + | DecisionTreeTest.IsNull, DecisionTreeTest.IsNull | DecisionTreeTest.ArrayLength _, DecisionTreeTest.ArrayLength _ | DecisionTreeTest.UnionCase _, DecisionTreeTest.UnionCase _ -> true diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index a91473b6880..cf4d4e4ad94 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -2055,9 +2055,9 @@ let CheckEntityDefn cenv env (tycon: Entity) = if others |> List.exists (checkForDup EraseAll) then if others |> List.exists (checkForDup EraseNone) then - errorR(Error(FSComp.SR.chkDuplicateProperty(nm, NicePrint.minimalStringOfType cenv.denv ty) , m)) + errorR(Error(FSComp.SR.chkDuplicateProperty(nm, NicePrint.minimalStringOfType cenv.denv ty), m)) else - errorR(Error(FSComp.SR.chkDuplicatePropertyWithSuffix(nm, NicePrint.minimalStringOfType cenv.denv ty) , m)) + errorR(Error(FSComp.SR.chkDuplicatePropertyWithSuffix(nm, NicePrint.minimalStringOfType cenv.denv ty), m)) // Check to see if one is an indexer and one is not if ( (pinfo.HasGetter && @@ -2256,7 +2256,7 @@ and CheckModuleSpec cenv env x = let env = { env with reflect = env.reflect || HasFSharpAttribute cenv.g cenv.g.attrib_ReflectedDefinitionAttribute mspec.Attribs } CheckDefnInModule cenv env rhs -let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, denv , mexpr, extraAttribs, (isLastCompiland: bool*bool), isInternalTestSpanStackReferring) = +let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, denv, mexpr, extraAttribs, (isLastCompiland: bool*bool), isInternalTestSpanStackReferring) = let cenv = { g =g reportErrors=reportErrors diff --git a/src/fsharp/QuotationPickler.fs b/src/fsharp/QuotationPickler.fs index c0e0360f6e8..df718278097 100644 --- a/src/fsharp/QuotationPickler.fs +++ b/src/fsharp/QuotationPickler.fs @@ -114,7 +114,7 @@ type ExprData = let mkVar v = VarExpr v -let mkHole (v, idx) = HoleExpr (v , idx) +let mkHole (v, idx) = HoleExpr (v, idx) let mkApp (a, b) = CombExpr(AppOp, [], [a; b]) diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index bd157c6ecc2..6166906244f 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -300,7 +300,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. else tryDestRefTupleExpr arg)) if verboseCReflect then - dprintfn "vref.DisplayName = %A , after unit adjust, #untupledCurriedArgs = %A, #curriedArgInfos = %d" vref.DisplayName (List.map List.length untupledCurriedArgs) curriedArgInfos.Length + dprintfn "vref.DisplayName = %A, after unit adjust, #untupledCurriedArgs = %A, #curriedArgInfos = %d" vref.DisplayName (List.map List.length untupledCurriedArgs) curriedArgInfos.Length let subCall = if isMember then // This is an application of a member method diff --git a/src/fsharp/SignatureConformance.fs b/src/fsharp/SignatureConformance.fs index b22de20da1b..6ba6dad410c 100644 --- a/src/fsharp/SignatureConformance.fs +++ b/src/fsharp/SignatureConformance.fs @@ -37,8 +37,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = // Used when checking attributes. let sigToImplRemap = let remap = Remap.Empty - let remap = (remapInfo.RepackagedEntities, remap) ||> List.foldBack (fun (implTcref , signTcref) acc -> addTyconRefRemap signTcref implTcref acc) - let remap = (remapInfo.RepackagedVals , remap) ||> List.foldBack (fun (implValRef, signValRef) acc -> addValRemap signValRef.Deref implValRef.Deref acc) + let remap = (remapInfo.RepackagedEntities, remap) ||> List.foldBack (fun (implTcref, signTcref) acc -> addTyconRefRemap signTcref implTcref acc) + let remap = (remapInfo.RepackagedVals, remap) ||> List.foldBack (fun (implValRef, signValRef) acc -> addValRemap signValRef.Deref implValRef.Deref acc) remap // For all attributable elements (types, modules, exceptions, record fields, unions, parameters, generic type parameters) @@ -536,7 +536,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = if typeAEquiv g aenv ty1 ty2 then true else (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) | TNoRepr, TNoRepr -> true #if !NO_EXTENSIONTYPING - | TProvidedTypeExtensionPoint info1 , TProvidedTypeExtensionPoint info2 -> + | TProvidedTypeExtensionPoint info1, TProvidedTypeExtensionPoint info2 -> Tainted.EqTainted info1.ProvidedType.TypeProvider info2.ProvidedType.TypeProvider && ProvidedType.TaintedEquals(info1.ProvidedType, info2.ProvidedType) | TProvidedNamespaceExtensionPoint _, TProvidedNamespaceExtensionPoint _ -> System.Diagnostics.Debug.Assert(false, "unreachable: TProvidedNamespaceExtensionPoint only on namespaces, not types" ) @@ -567,7 +567,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = (if implModType.ModuleOrNamespaceKind <> signModType.ModuleOrNamespaceKind then errorR(Error(FSComp.SR.typrelModuleNamespaceAttributesDifferInSigAndImpl(), m))) - (implModType.TypesByMangledName , signModType.TypesByMangledName) + (implModType.TypesByMangledName, signModType.TypesByMangledName) ||> NameMap.suball2 (fun s _fx -> errorR(RequiredButNotSpecified(denv, implModRef, "type", (fun os -> Printf.bprintf os "%s" s), m)); false) (checkTypeDef aenv) && @@ -659,7 +659,7 @@ let rec CheckNamesOfModuleOrNamespaceContents denv (implModRef: ModuleOrNamespac (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, (if fx.IsModule then "module" else "namespace"), (fun os -> Printf.bprintf os "%s" s), m)); false) (fun x1 (x2: ModuleOrNamespace) -> CheckNamesOfModuleOrNamespace denv (mkLocalModRef x1) x2.ModuleOrNamespaceType) && - (implModType.AllValsAndMembersByLogicalNameUncached , signModType.AllValsAndMembersByLogicalNameUncached) + (implModType.AllValsAndMembersByLogicalNameUncached, signModType.AllValsAndMembersByLogicalNameUncached) ||> NameMap.suball2 (fun _s (fxs: Val list) -> let fx = fxs.Head diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index dbf8371c537..cb5050592d3 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. /// Defines derived expression manipulation and construction functions. module internal FSharp.Compiler.Tastops @@ -57,7 +57,7 @@ type TyparMap<'T> = type TyconRefMap<'T>(imap: StampMap<'T>) = member m.Item with get (v: TyconRef) = imap.[v.Stamp] member m.TryFind (v: TyconRef) = imap.TryFind v.Stamp - member m.ContainsKey (v: TyconRef) = imap.ContainsKey v.Stamp + member m.ContainsKey (v: TyconRef) = imap.ContainsKey v.Stamp member m.Add (v: TyconRef) x = TyconRefMap (imap.Add (v.Stamp, x)) member m.Remove (v: TyconRef) = TyconRefMap (imap.Remove v.Stamp) member m.IsEmpty = imap.IsEmpty @@ -99,9 +99,9 @@ type Remap = removeTraitSolutions: bool } let emptyRemap = - { tpinst = emptyTyparInst + { tpinst = emptyTyparInst tyconRefRemap = emptyTyconRefRemap - valRemap = ValMap.Empty + valRemap = ValMap.Empty removeTraitSolutions = false } type Remap with @@ -119,14 +119,14 @@ let isRemapEmpty remap = remap.tyconRefRemap.IsEmpty && remap.valRemap.IsEmpty -let rec instTyparRef tpinst ty tp = +let rec instTyparRef tpinst ty tp = match tpinst with | [] -> ty | (tp', ty'):: t -> if typarEq tp tp' then ty' else instTyparRef t ty tp -let instMeasureTyparRef tpinst unt (tp: Typar) = +let instMeasureTyparRef tpinst unt (tp: Typar) = match tp.Kind with | TyparKind.Measure -> let rec loop tpinst = @@ -142,9 +142,9 @@ let instMeasureTyparRef tpinst unt (tp: Typar) = loop tpinst | _ -> failwith "instMeasureTyparRef: kind=Type" -let remapTyconRef (tcmap: TyconRefMap<_>) tcref = +let remapTyconRef (tcmap: TyconRefMap<_>) tcref = match tcmap.TryFind tcref with - | Some tcref -> tcref + | Some tcref -> tcref | None -> tcref let remapUnionCaseRef tcmap (UCRef(tcref, nm)) = UCRef(remapTyconRef tcmap tcref, nm) @@ -163,10 +163,10 @@ let generalizeTypars tps = List.map generalizeTypar tps let rec remapTypeAux (tyenv: Remap) (ty: TType) = let ty = stripTyparEqns ty match ty with - | TType_var tp as ty -> instTyparRef tyenv.tpinst ty tp + | TType_var tp as ty -> instTyparRef tyenv.tpinst ty tp | TType_app (tcref, tinst) as ty -> match tyenv.tyconRefRemap.TryFind tcref with - | Some tcref' -> TType_app (tcref', remapTypesAux tyenv tinst) + | Some tcref' -> TType_app (tcref', remapTypesAux tyenv tinst) | None -> match tinst with | [] -> ty // optimization to avoid re-allocation of TType_app node in the common case @@ -178,22 +178,22 @@ let rec remapTypeAux (tyenv: Remap) (ty: TType) = | TType_ucase (UCRef(tcref, n), tinst) -> match tyenv.tyconRefRemap.TryFind tcref with - | Some tcref' -> TType_ucase (UCRef(tcref', n), remapTypesAux tyenv tinst) + | Some tcref' -> TType_ucase (UCRef(tcref', n), remapTypesAux tyenv tinst) | None -> TType_ucase (UCRef(tcref, n), remapTypesAux tyenv tinst) - | TType_anon (anonInfo, l) as ty -> + | TType_anon (anonInfo, l) as ty -> let tupInfo' = remapTupInfoAux tyenv anonInfo.TupInfo let l' = remapTypesAux tyenv l if anonInfo.TupInfo === tupInfo' && l === l' then ty else TType_anon (AnonRecdTypeInfo.Create(anonInfo.Assembly, tupInfo', anonInfo.SortedIds), l') - | TType_tuple (tupInfo, l) as ty -> + | TType_tuple (tupInfo, l) as ty -> let tupInfo' = remapTupInfoAux tyenv tupInfo let l' = remapTypesAux tyenv l if tupInfo === tupInfo' && l === l' then ty else TType_tuple (tupInfo', l') - | TType_fun (d, r) as ty -> + | TType_fun (d, r) as ty -> let d' = remapTypeAux tyenv d let r' = remapTypeAux tyenv r if d === d' && r === r' then ty else @@ -212,7 +212,7 @@ and remapMeasureAux tyenv unt = | Measure.One -> unt | Measure.Con tcref -> match tyenv.tyconRefRemap.TryFind tcref with - | Some tcref -> Measure.Con tcref + | Some tcref -> Measure.Con tcref | None -> unt | Measure.Prod(u1, u2) -> Measure.Prod(remapMeasureAux tyenv u1, remapMeasureAux tyenv u2) | Measure.RationalPower(u, q) -> Measure.RationalPower(remapMeasureAux tyenv u, q) @@ -247,8 +247,8 @@ and remapTyparConstraintsAux tyenv cs = | TyparConstraint.IsDelegate(uty1, uty2, m) -> Some(TyparConstraint.IsDelegate(remapTypeAux tyenv uty1, remapTypeAux tyenv uty2, m)) | TyparConstraint.SimpleChoice(tys, m) -> Some(TyparConstraint.SimpleChoice(remapTypesAux tyenv tys, m)) - | TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _ + | TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _ | TyparConstraint.IsUnmanaged _ | TyparConstraint.IsNonNullableStruct _ @@ -300,7 +300,7 @@ and copyAndRemapAndBindTyparsFull remapAttrib tyenv tps = let tps' = copyTypars tps let tyenv = { tyenv with tpinst = bindTypars tps (generalizeTypars tps') tyenv.tpinst } (tps, tps') ||> List.iter2 (fun tporig tp -> - tp.SetConstraints (remapTyparConstraintsAux tyenv tporig.Constraints) + tp.SetConstraints (remapTyparConstraintsAux tyenv tporig.Constraints) tp.SetAttribs (tporig.Attribs |> remapAttrib)) tps', tyenv @@ -327,10 +327,10 @@ and remapNonLocalValRef tyenv (nlvref: NonLocalValOrMemberRef) = let vlink' = remapValLinkage tyenv vlink if eref === eref' && vlink === vlink' then nlvref else { EnclosingEntity = eref' - ItemKey = vlink' } + ItemKey = vlink' } and remapValRef tmenv (vref: ValRef) = - match tmenv.valRemap.TryFind vref.Deref with + match tmenv.valRemap.TryFind vref.Deref with | None -> if vref.IsLocalRef then vref else let nlvref = vref.nlr @@ -375,14 +375,14 @@ let remapSlotSig remapAttrib tyenv (TSlotSig(nm, ty, ctps, methTypars, paraml, r let mkInstRemap tpinst = { tyconRefRemap = emptyTyconRefRemap - tpinst = tpinst - valRemap = ValMap.Empty + tpinst = tpinst + valRemap = ValMap.Empty removeTraitSolutions = false } // entry points for "typar -> TType" instantiation -let instType tpinst x = if isNil tpinst then x else remapTypeAux (mkInstRemap tpinst) x -let instTypes tpinst x = if isNil tpinst then x else remapTypesAux (mkInstRemap tpinst) x -let instTrait tpinst x = if isNil tpinst then x else remapTraitAux (mkInstRemap tpinst) x +let instType tpinst x = if isNil tpinst then x else remapTypeAux (mkInstRemap tpinst) x +let instTypes tpinst x = if isNil tpinst then x else remapTypesAux (mkInstRemap tpinst) x +let instTrait tpinst x = if isNil tpinst then x else remapTraitAux (mkInstRemap tpinst) x let instTyparConstraints tpinst x = if isNil tpinst then x else remapTyparConstraintsAux (mkInstRemap tpinst) x let instSlotSig tpinst ss = remapSlotSig (fun _ -> []) (mkInstRemap tpinst) ss let copySlotSig ss = remapSlotSig (fun _ -> []) Remap.Empty ss @@ -414,7 +414,7 @@ let reduceTyconRefAbbrevMeasureable (tcref: TyconRef) = let rec stripUnitEqnsFromMeasureAux canShortcut unt = match stripUnitEqnsAux canShortcut unt with - | Measure.Con tcref when tcref.IsTypeAbbrev -> + | Measure.Con tcref when tcref.IsTypeAbbrev -> stripUnitEqnsFromMeasureAux canShortcut (reduceTyconRefAbbrevMeasureable tcref) | m -> m @@ -599,7 +599,7 @@ let mkByref2Ty (g: TcGlobals) ty1 ty2 = TType_app (g.byref2_tcr, [ty1; ty2]) let mkVoidPtrTy (g: TcGlobals) = - assert g.voidptr_tcr.CanDeref // check we are using sufficient FSharp.Core , caller should check this + assert g.voidptr_tcr.CanDeref // check we are using sufficient FSharp.Core, caller should check this TType_app (g.voidptr_tcr, []) let mkByrefTyWithInference (g: TcGlobals) ty1 ty2 = @@ -641,7 +641,7 @@ let isCompiledTupleTyconRef g tcref = tyconRefEq g g.struct_tuple8_tcr tcref let mkCompiledTupleTyconRef (g: TcGlobals) isStruct n = - if n = 1 then (if isStruct then g.struct_tuple1_tcr else g.ref_tuple1_tcr) + if n = 1 then (if isStruct then g.struct_tuple1_tcr else g.ref_tuple1_tcr) elif n = 2 then (if isStruct then g.struct_tuple2_tcr else g.ref_tuple2_tcr) elif n = 3 then (if isStruct then g.struct_tuple3_tcr else g.ref_tuple3_tcr) elif n = 4 then (if isStruct then g.struct_tuple4_tcr else g.ref_tuple4_tcr) @@ -725,8 +725,8 @@ let rec stripTyEqnsA g canShortcut ty = // // Add the equation byref<'T> = byref<'T, ByRefKinds.InOut> for when using sufficient FSharp.Core // See RFC FS-1053.md - if tyconRefEq g tcref g.byref_tcr && g.byref2_tcr.CanDeref && g.byrefkind_InOut_tcr.CanDeref then - mkByref2Ty g tinst.[0] (TType_app(g.byrefkind_InOut_tcr, [])) + if tyconRefEq g tcref g.byref_tcr && g.byref2_tcr.CanDeref && g.byrefkind_InOut_tcr.CanDeref then + mkByref2Ty g tinst.[0] (TType_app(g.byrefkind_InOut_tcr, [])) // Add the equation double<1> = double for units of measure. elif tycon.IsMeasureableReprTycon && List.forall (isDimensionless g) tinst then @@ -753,7 +753,7 @@ let rec stripTyEqnsAndErase eraseFuncAndTuple (g: TcGlobals) ty = match ty with | TType_app (tcref, args) -> let tycon = tcref.Deref - if tycon.IsErased then + if tycon.IsErased then stripTyEqnsAndErase eraseFuncAndTuple g (reduceTyconMeasureableOrProvided g tycon args) elif tyconRefEq g tcref g.nativeptr_tcr && eraseFuncAndTuple then stripTyEqnsAndErase eraseFuncAndTuple g g.nativeint_ty @@ -781,59 +781,59 @@ let rec stripExnEqns (eref: TyconRef) = | _ -> exnc let primDestForallTy g ty = ty |> stripTyEqns g |> (function TType_forall (tyvs, tau) -> (tyvs, tau) | _ -> failwith "primDestForallTy: not a forall type") -let destFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv, tau) -> (tyv, tau) | _ -> failwith "destFunTy: not a function type") -let destAnyTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) -> tupInfo, l | _ -> failwith "destAnyTupleTy: not a tuple type") -let destRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) when not (evalTupInfoIsStruct tupInfo) -> l | _ -> failwith "destRefTupleTy: not a reference tuple type") -let destStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) when evalTupInfoIsStruct tupInfo -> l | _ -> failwith "destStructTupleTy: not a struct tuple type") -let destTyparTy g ty = ty |> stripTyEqns g |> (function TType_var v -> v | _ -> failwith "destTyparTy: not a typar type") -let destAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var v -> v | TType_measure unt -> destUnitParMeasure g unt | _ -> failwith "destAnyParTy: not a typar or unpar type") -let destMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure m -> m | _ -> failwith "destMeasureTy: not a unit-of-measure type") -let isFunTy g ty = ty |> stripTyEqns g |> (function TType_fun _ -> true | _ -> false) -let isForallTy g ty = ty |> stripTyEqns g |> (function TType_forall _ -> true | _ -> false) -let isAnyTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple _ -> true | _ -> false) -let isRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, _) -> not (evalTupInfoIsStruct tupInfo) | _ -> false) -let isStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, _) -> evalTupInfoIsStruct tupInfo | _ -> false) -let isAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon _ -> true | _ -> false) -let isStructAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon (anonInfo, _) -> evalAnonInfoIsStruct anonInfo | _ -> false) -let isUnionTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsUnionTycon | _ -> false) -let isReprHiddenTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsHiddenReprTycon | _ -> false) +let destFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv, tau) -> (tyv, tau) | _ -> failwith "destFunTy: not a function type") +let destAnyTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) -> tupInfo, l | _ -> failwith "destAnyTupleTy: not a tuple type") +let destRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) when not (evalTupInfoIsStruct tupInfo) -> l | _ -> failwith "destRefTupleTy: not a reference tuple type") +let destStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) when evalTupInfoIsStruct tupInfo -> l | _ -> failwith "destStructTupleTy: not a struct tuple type") +let destTyparTy g ty = ty |> stripTyEqns g |> (function TType_var v -> v | _ -> failwith "destTyparTy: not a typar type") +let destAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var v -> v | TType_measure unt -> destUnitParMeasure g unt | _ -> failwith "destAnyParTy: not a typar or unpar type") +let destMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure m -> m | _ -> failwith "destMeasureTy: not a unit-of-measure type") +let isFunTy g ty = ty |> stripTyEqns g |> (function TType_fun _ -> true | _ -> false) +let isForallTy g ty = ty |> stripTyEqns g |> (function TType_forall _ -> true | _ -> false) +let isAnyTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple _ -> true | _ -> false) +let isRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, _) -> not (evalTupInfoIsStruct tupInfo) | _ -> false) +let isStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, _) -> evalTupInfoIsStruct tupInfo | _ -> false) +let isAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon _ -> true | _ -> false) +let isStructAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon (anonInfo, _) -> evalAnonInfoIsStruct anonInfo | _ -> false) +let isUnionTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsUnionTycon | _ -> false) +let isReprHiddenTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsHiddenReprTycon | _ -> false) let isFSharpObjModelTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsFSharpObjectModelTycon | _ -> false) -let isRecdTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsRecordTycon | _ -> false) -let isFSharpStructOrEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsFSharpStructOrEnumTycon | _ -> false) -let isFSharpEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsFSharpEnumTycon | _ -> false) -let isTyparTy g ty = ty |> stripTyEqns g |> (function TType_var _ -> true | _ -> false) -let isAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var _ -> true | TType_measure unt -> isUnitParMeasure g unt | _ -> false) -let isMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure _ -> true | _ -> false) +let isRecdTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsRecordTycon | _ -> false) +let isFSharpStructOrEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsFSharpStructOrEnumTycon | _ -> false) +let isFSharpEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsFSharpEnumTycon | _ -> false) +let isTyparTy g ty = ty |> stripTyEqns g |> (function TType_var _ -> true | _ -> false) +let isAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var _ -> true | TType_measure unt -> isUnitParMeasure g unt | _ -> false) +let isMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure _ -> true | _ -> false) let isProvenUnionCaseTy ty = match ty with TType_ucase _ -> true | _ -> false let mkAppTy tcref tyargs = TType_app(tcref, tyargs) let mkProvenUnionCaseTy ucref tyargs = TType_ucase(ucref, tyargs) -let isAppTy g ty = ty |> stripTyEqns g |> (function TType_app _ -> true | _ -> false) +let isAppTy g ty = ty |> stripTyEqns g |> (function TType_app _ -> true | _ -> false) let tryAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, tinst) -> ValueSome (tcref, tinst) | _ -> ValueNone) let destAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, tinst) -> tcref, tinst | _ -> failwith "destAppTy") -let tcrefOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref | _ -> failwith "tcrefOfAppTy") -let argsOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(_, tinst) -> tinst | _ -> []) +let tcrefOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref | _ -> failwith "tcrefOfAppTy") +let argsOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(_, tinst) -> tinst | _ -> []) let tryDestTyparTy g ty = ty |> stripTyEqns g |> (function TType_var v -> ValueSome v | _ -> ValueNone) -let tryDestFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv, tau) -> ValueSome(tyv, tau) | _ -> ValueNone) -let tryDestAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> ValueSome tcref | _ -> ValueNone) +let tryDestFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv, tau) -> ValueSome(tyv, tau) | _ -> ValueNone) +let tryDestAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> ValueSome tcref | _ -> ValueNone) let tryDestAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon (anonInfo, tys) -> ValueSome (anonInfo, tys) | _ -> ValueNone) -let tryAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var v -> ValueSome v | TType_measure unt when isUnitParMeasure g unt -> ValueSome(destUnitParMeasure g unt) | _ -> ValueNone) -let tryAnyParTyOption g ty = ty |> stripTyEqns g |> (function TType_var v -> Some v | TType_measure unt when isUnitParMeasure g unt -> Some(destUnitParMeasure g unt) | _ -> None) +let tryAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var v -> ValueSome v | TType_measure unt when isUnitParMeasure g unt -> ValueSome(destUnitParMeasure g unt) | _ -> ValueNone) +let tryAnyParTyOption g ty = ty |> stripTyEqns g |> (function TType_var v -> Some v | TType_measure unt when isUnitParMeasure g unt -> Some(destUnitParMeasure g unt) | _ -> None) let (|AppTy|_|) g ty = ty |> stripTyEqns g |> (function TType_app(tcref, tinst) -> Some (tcref, tinst) | _ -> None) let (|RefTupleTy|_|) g ty = ty |> stripTyEqns g |> (function TType_tuple(tupInfo, tys) when not (evalTupInfoIsStruct tupInfo) -> Some tys | _ -> None) let (|FunTy|_|) g ty = ty |> stripTyEqns g |> (function TType_fun(dty, rty) -> Some (dty, rty) | _ -> None) -let tryNiceEntityRefOfTy ty = +let tryNiceEntityRefOfTy ty = let ty = stripTyparEqnsAux false ty match ty with | TType_app (tcref, _) -> ValueSome tcref | TType_measure (Measure.Con tcref) -> ValueSome tcref | _ -> ValueNone -let tryNiceEntityRefOfTyOption ty = +let tryNiceEntityRefOfTyOption ty = let ty = stripTyparEqnsAux false ty match ty with | TType_app (tcref, _) -> Some tcref @@ -856,7 +856,7 @@ let mkInstForAppTy g ty = | _ -> [] let domainOfFunTy g ty = fst (destFunTy g ty) -let rangeOfFunTy g ty = snd (destFunTy g ty) +let rangeOfFunTy g ty = snd (destFunTy g ty) let convertToTypeWithMetadataIfPossible g ty = if isAnyTupleTy g ty then @@ -936,12 +936,12 @@ and typarConstraintsAEquivAux erasureFlag g aenv tpc1 tpc2 = | TyparConstraint.SimpleChoice (tys1, _), TyparConstraint.SimpleChoice(tys2, _) -> ListSet.equals (typeAEquivAux erasureFlag g aenv) tys1 tys2 - | TyparConstraint.SupportsComparison _ , TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _ , TyparConstraint.SupportsEquality _ - | TyparConstraint.SupportsNull _ , TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _ , TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsReferenceType _ , TyparConstraint.IsReferenceType _ - | TyparConstraint.IsUnmanaged _ , TyparConstraint.IsUnmanaged _ + | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ + | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ + | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ -> true | _ -> false @@ -970,10 +970,10 @@ and typeAEquivAux erasureFlag g aenv ty1 ty2 = match aenv.EquivTypars.TryFind tp1 with | Some v -> typeEquivAux erasureFlag g v ty2 | None -> false - | TType_app (tc1, b1) , TType_app (tc2, b2) -> + | TType_app (tc1, b1), TType_app (tc2, b2) -> tcrefAEquiv g aenv tc1 tc2 && typesAEquivAux erasureFlag g aenv b1 b2 - | TType_ucase (UCRef(tc1, n1), b1) , TType_ucase (UCRef(tc2, n2), b2) -> + | TType_ucase (UCRef(tc1, n1), b1), TType_ucase (UCRef(tc2, n2), b2) -> n1=n2 && tcrefAEquiv g aenv tc1 tc2 && typesAEquivAux erasureFlag g aenv b1 b2 @@ -1056,7 +1056,7 @@ let rec getErasedTypes g ty = let valOrder = { new IComparer with member __.Compare(v1, v2) = compare v1.Stamp v2.Stamp } let tyconOrder = { new IComparer with member __.Compare(tc1, tc2) = compare tc1.Stamp tc2.Stamp } -let recdFieldRefOrder = +let recdFieldRefOrder = { new IComparer with member __.Compare(RFRef(tcref1, nm1), RFRef(tcref2, nm2)) = let c = tyconOrder.Compare (tcref1.Deref, tcref2.Deref) @@ -1105,7 +1105,7 @@ let ensureCcuHasModuleOrNamespaceAtPath (ccu: CcuThunk) path (CompPath(_, cpath) let rec loop prior_cpath (path: Ident list) cpath (modul: ModuleOrNamespace) = let mtype = modul.ModuleOrNamespaceType match path, cpath with - | (hpath:: tpath), ((_, mkind):: tcpath) -> + | (hpath:: tpath), ((_, mkind):: tcpath) -> 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)) @@ -1139,7 +1139,7 @@ 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.Val (_, _, m) | Expr.Op (_, _, _, m) | Expr.Const (_, m, _) | Expr.Quote (_, _, _, 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 @@ -1167,7 +1167,7 @@ type MatchBuilder(spBind, inpRange: Range.range) = member x.CloseTargets() = targets |> ResizeArray.toList - member x.Close(dtree, m, ty) = primMkMatch (spBind, inpRange, dtree, targets.ToArray(), m, ty) + 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) @@ -1176,25 +1176,25 @@ let primMkCond spBind spTarget1 spTarget2 m ty e1 e2 e3 = let dtree = mkBoolSwitch m e1 (mbuilder.AddResultTarget(e2, spTarget1)) (mbuilder.AddResultTarget(e3, spTarget2)) mbuilder.Close(dtree, m, ty) -let mkCond spBind spTarget m ty e1 e2 e3 = primMkCond spBind spTarget spTarget m ty e1 e2 e3 +let mkCond spBind spTarget m ty e1 e2 e3 = primMkCond spBind spTarget spTarget m ty e1 e2 e3 //--------------------------------------------------------------------------- // Primitive constructors //--------------------------------------------------------------------------- -let exprForValRef m vref = Expr.Val(vref, NormalValUse, m) -let exprForVal m v = exprForValRef m (mkLocalValRef v) +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) thisv, exprForVal m thisv -let mkLocal m s ty = mkLocalAux m s ty Immutable false +let mkLocal m s ty = mkLocalAux m s ty Immutable false let mkCompGenLocal m s ty = mkLocalAux m s ty Immutable true let mkMutableCompGenLocal m s ty = mkLocalAux m s ty Mutable true -// Type gives return type. For type-lambdas this is the formal return type. +// Type gives return type. For type-lambdas this is the formal return type. let mkMultiLambda m vs (b, rty) = Expr.Lambda (newUnique(), None, None, vs, b, m, rty) let rebuildLambda m ctorThisValOpt baseValOpt vs (b, rty) = Expr.Lambda (newUnique(), ctorThisValOpt, baseValOpt, vs, b, m, rty) let mkLambda m v (b, rty) = mkMultiLambda m [v] (b, rty) @@ -1225,7 +1225,7 @@ let mkMemberLambdas m tps ctorThisValOpt baseValOpt vsl (b, rty) = (rebuildLambda m ctorThisValOpt baseValOpt h (b, rty), (typeOfLambdaArg m h --> rty)) mkTypeLambda m tps expr -let mkMultiLambdaBind v letSeqPtOpt m tps vsl (b, rty) = +let mkMultiLambdaBind v letSeqPtOpt m tps vsl (b, rty) = TBind(v, mkMultiLambdas m tps vsl (b, rty), letSeqPtOpt) let mkBind seqPtOpt v e = TBind(v, e, seqPtOpt) @@ -1300,65 +1300,65 @@ let isBeingGeneralized tp typeScheme = 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 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 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 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 mkRecdFieldGetViaExprAddr(e, fref, tinst, m) = Expr.Op (TOp.ValFieldGet(fref), 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 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 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 mkLambda m (fst (mkCompGenLocal m "unitVar" g.unit_ty)) (e, ety) -let mkWhile (g: TcGlobals) (spWhile, marker, e1, e2, m) = - Expr.Op (TOp.While (spWhile, marker), [] , [mkDummyLambda g (e1, g.bool_ty);mkDummyLambda g (e2, g.unit_ty)], m) +let mkWhile (g: TcGlobals) (spWhile, marker, e1, e2, m) = + Expr.Op (TOp.While (spWhile, marker), [], [mkDummyLambda g (e1, g.bool_ty);mkDummyLambda g (e2, g.unit_ty)], m) -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 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) -let mkTryFinally (g: TcGlobals) (e1, e2, m, ty, spTry, spFinally) = +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) let mkDefault (m, ty) = Expr.Const(Const.Zero, m, ty) @@ -1456,11 +1456,11 @@ let tryRescopeVal viewedCcu (entityRemap: Remap) (vspec: Val) : ValueOption actualTysOfRecdFields inst +let actualTysOfInstanceRecdFields inst (tcref: TyconRef) = tcref.AllInstanceFieldsAsList |> actualTysOfRecdFields inst let actualTysOfUnionCaseFields inst (x: UnionCaseRef) = actualTysOfRecdFields inst x.AllFieldsAsList @@ -1616,17 +1616,17 @@ let tyconRefEqOpt g tcOpt tc = | None -> false | Some tc2 -> tyconRefEq g tc2 tc -let isStringTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.system_String_tcref | _ -> false) -let isListTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.list_tcr_canon | _ -> false) -let isArrayTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isArrayTyconRef g tcref | _ -> false) -let isArray1DTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.il_arr_tcr_map.[0] | _ -> false) -let isUnitTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.unit_tcr_canon tcref | _ -> false) -let isObjTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) -let isVoidTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.system_Void_tcref tcref | _ -> false) -let isILAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsILTycon | _ -> false) -let isNativePtrTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.nativeptr_tcr tcref | _ -> false) - -let isByrefTy g ty = +let isStringTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.system_String_tcref | _ -> false) +let isListTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.list_tcr_canon | _ -> false) +let isArrayTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isArrayTyconRef g tcref | _ -> false) +let isArray1DTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.il_arr_tcr_map.[0] | _ -> false) +let isUnitTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.unit_tcr_canon tcref | _ -> false) +let isObjTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) +let isVoidTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.system_Void_tcref tcref | _ -> false) +let isILAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsILTycon | _ -> false) +let isNativePtrTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.nativeptr_tcr tcref | _ -> false) + +let isByrefTy g ty = ty |> stripTyEqns g |> (function | TType_app(tcref, _) when g.byref2_tcr.CanDeref -> tyconRefEq g g.byref2_tcr tcref | TType_app(tcref, _) -> tyconRefEq g g.byref_tcr tcref @@ -1635,24 +1635,24 @@ let isByrefTy g ty = let isInByrefTag g ty = ty |> stripTyEqns g |> (function TType_app(tcref, []) -> tyconRefEq g g.byrefkind_In_tcr tcref | _ -> false) let isInByrefTy g ty = ty |> stripTyEqns g |> (function - | TType_app(tcref, [_; tag]) when g.byref2_tcr.CanDeref -> tyconRefEq g g.byref2_tcr tcref && isInByrefTag g tag + | TType_app(tcref, [_; tag]) when g.byref2_tcr.CanDeref -> tyconRefEq g g.byref2_tcr tcref && isInByrefTag g tag | _ -> false) let isOutByrefTag g ty = ty |> stripTyEqns g |> (function TType_app(tcref, []) -> tyconRefEq g g.byrefkind_Out_tcr tcref | _ -> false) let isOutByrefTy g ty = ty |> stripTyEqns g |> (function - | TType_app(tcref, [_; tag]) when g.byref2_tcr.CanDeref -> tyconRefEq g g.byref2_tcr tcref && isOutByrefTag g tag + | TType_app(tcref, [_; tag]) when g.byref2_tcr.CanDeref -> tyconRefEq g g.byref2_tcr tcref && isOutByrefTag g tag | _ -> false) #if !NO_EXTENSIONTYPING -let extensionInfoOfTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.TypeReprInfo | _ -> TNoRepr) +let extensionInfoOfTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.TypeReprInfo | _ -> TNoRepr) #endif type TypeDefMetadata = | ILTypeMetadata of TILObjectReprData | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata #if !NO_EXTENSIONTYPING - | ProvidedTypeMetadata of TProvidedTypeInfo + | ProvidedTypeMetadata of TProvidedTypeInfo #endif let metadataOfTycon (tycon: Tycon) = @@ -1702,7 +1702,7 @@ let isFSharpObjModelRefTy g ty = isFSharpObjModelTy g ty && let tcref = tcrefOfAppTy g ty match tcref.FSharpObjectModelTypeInfo.fsobjmodel_kind with - | TTyconClass | TTyconInterface | TTyconDelegate _ -> true + | TTyconClass | TTyconInterface | TTyconDelegate _ -> true | TTyconStruct | TTyconEnum -> false let isFSharpClassTy g ty = @@ -1791,8 +1791,8 @@ let rec isUnmanagedTy g ty = let ty = stripTyEqnsAndMeasureEqns g ty match tryDestAppTy g ty with | ValueSome tcref -> - let isEq tcref2 = tyconRefEq g tcref tcref2 - if isEq g.nativeptr_tcr || isEq g.nativeint_tcr || + let isEq tcref2 = tyconRefEq g tcref tcref2 + if isEq g.nativeptr_tcr || isEq g.nativeint_tcr || isEq g.sbyte_tcr || isEq g.byte_tcr || isEq g.int16_tcr || isEq g.uint16_tcr || isEq g.int32_tcr || isEq g.uint32_tcr || @@ -1915,9 +1915,9 @@ let isEmptyFreeTyvars ftyvs = let unionFreeTyvars fvs1 fvs2 = if fvs1 === emptyFreeTyvars then fvs2 else if fvs2 === emptyFreeTyvars then fvs1 else - { FreeTycons = unionFreeTycons fvs1.FreeTycons fvs2.FreeTycons - FreeTraitSolutions = unionFreeLocals fvs1.FreeTraitSolutions fvs2.FreeTraitSolutions - FreeTypars = unionFreeTypars fvs1.FreeTypars fvs2.FreeTypars } + { FreeTycons = unionFreeTycons fvs1.FreeTycons fvs2.FreeTycons + FreeTraitSolutions = unionFreeLocals fvs1.FreeTraitSolutions fvs2.FreeTraitSolutions + FreeTypars = unionFreeTypars fvs1.FreeTypars fvs2.FreeTypars } type FreeVarOptions = { canCache: bool @@ -2006,7 +2006,7 @@ let accFreeTycon opts (tcref: TyconRef) acc = else acc let rec boundTypars opts tps acc = - // Bound type vars form a recursively-referential set due to constraints, e.g. A: I, B: I + // Bound type vars form a recursively-referential set due to constraints, e.g. A: I, B: I // So collect up free vars in all constraints first, then bind all variables let acc = List.foldBack (fun (tp: Typar) acc -> accFreeInTyparConstraints opts tp.Constraints acc) tps acc List.foldBack (fun tp acc -> { acc with FreeTypars = Zset.remove tp acc.FreeTypars}) tps acc @@ -2070,7 +2070,7 @@ and accFreeTyparRef opts (tp: Typar) acc = accFreeInTyparConstraints opts tp.Constraints { acc with FreeTypars = Zset.add tp acc.FreeTypars} -and accFreeInType opts ty acc = +and accFreeInType opts ty acc = match stripTyparEqns ty with | TType_tuple (tupInfo, l) -> accFreeInTypes opts l (accFreeInTupInfo opts tupInfo acc) | TType_anon (anonInfo, l) -> accFreeInTypes opts l (accFreeInTupInfo opts anonInfo.TupInfo acc) @@ -2080,7 +2080,7 @@ and accFreeInType opts ty acc = | [] -> acc // optimization to avoid unneeded call | [h] -> accFreeInType opts h acc // optimization to avoid unneeded call | _ -> accFreeInTypes opts tinst acc - | TType_ucase (UCRef(tc, _), tinst) -> accFreeInTypes opts tinst (accFreeTycon opts tc acc) + | TType_ucase (UCRef(tc, _), tinst) -> accFreeInTypes opts tinst (accFreeTycon opts tc acc) | TType_fun (d, r) -> accFreeInType opts d (accFreeInType opts r acc) | TType_var r -> accFreeTyparRef opts r acc | TType_forall (tps, r) -> unionFreeTyvars (boundTypars opts tps (freeInType opts r)) acc @@ -2113,15 +2113,15 @@ let freeInModuleTy mtyp = addFreeInModuleTy mtyp emptyFreeTyvars //-------------------------------------------------------------------------- // Free in type, left-to-right order preserved. This is used to determine the // order of type variables for top-level definitions based on their signature, -// so be careful not to change the order. We accumulate in reverse +// so be careful not to change the order. We accumulate in reverse // order. //-------------------------------------------------------------------------- let emptyFreeTyparsLeftToRight = [] let unionFreeTyparsLeftToRight fvs1 fvs2 = ListSet.unionFavourRight typarEq fvs1 fvs2 -let rec boundTyparsLeftToRight g cxFlag thruFlag acc tps = - // Bound type vars form a recursively-referential set due to constraints, e.g. A: I, B: I +let rec boundTyparsLeftToRight g cxFlag thruFlag acc tps = + // Bound type vars form a recursively-referential set due to constraints, e.g. A: I, B: I // So collect up free vars in all constraints first, then bind all variables List.fold (fun acc (tp: Typar) -> accFreeInTyparConstraintsLeftToRight g cxFlag thruFlag acc tp.Constraints) tps acc @@ -2150,7 +2150,7 @@ and accFreeInTyparConstraintLeftToRight g cxFlag thruFlag acc tpc = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> acc -and accFreeInTraitLeftToRight g cxFlag thruFlag acc (TTrait(tys, _, _, argtys, rty, _)) = +and accFreeInTraitLeftToRight g cxFlag thruFlag acc (TTrait(tys, _, _, argtys, rty, _)) = let acc = accFreeInTypesLeftToRight g cxFlag thruFlag acc tys let acc = accFreeInTypesLeftToRight g cxFlag thruFlag acc argtys let acc = Option.fold (accFreeInTypeLeftToRight g cxFlag thruFlag) acc rty @@ -2166,9 +2166,9 @@ and accFreeTyparRefLeftToRight g cxFlag thruFlag acc (tp: Typar) = else acc -and accFreeInTypeLeftToRight g cxFlag thruFlag acc ty = +and accFreeInTypeLeftToRight g cxFlag thruFlag acc ty = match (if thruFlag then stripTyEqns g ty else stripTyparEqns ty) with - | TType_anon (anonInfo, anonTys) -> + | TType_anon (anonInfo, anonTys) -> let acc = accFreeInTupInfoLeftToRight g cxFlag thruFlag acc anonInfo.TupInfo accFreeInTypesLeftToRight g cxFlag thruFlag acc anonTys | TType_tuple (tupInfo, tupTys) -> @@ -2235,7 +2235,7 @@ let GetMemberTypeInFSharpForm g memberFlags arities ty m = // It will also always have an arity (inferred from syntax). let checkMemberVal membInfo arity m = match membInfo, arity with - | None, _ -> error(InternalError("checkMemberVal - no membInfo" , m)) + | None, _ -> error(InternalError("checkMemberVal - no membInfo", m)) | _, None -> error(InternalError("checkMemberVal - no arity", m)) | Some membInfo, Some arity -> (membInfo, arity) @@ -2248,11 +2248,11 @@ let GetTopValTypeInCompiledForm g topValInfo ty m = let paramArgInfos = match paramArgInfos, topValInfo.ArgInfos with // static member and module value unit argument elimination - | [[(_argType, _)]] , [[]] -> + | [[(_argType, _)]], [[]] -> //assert isUnitTy g argType [[]] // instance member unit argument elimination - | [objInfo;[(_argType, _)]] , [[_objArg];[]] -> + | [objInfo;[(_argType, _)]], [[_objArg];[]] -> //assert isUnitTy g argType [objInfo; []] | _ -> @@ -2274,11 +2274,11 @@ let GetMemberTypeInMemberForm g memberFlags topValInfo ty m = let paramArgInfos = match paramArgInfos, topValInfo.ArgInfos with // static member and module value unit argument elimination - | [[(argType, _)]] , [[]] -> + | [[(argType, _)]], [[]] -> assert isUnitTy g argType [[]] // instance member unit argument elimination - | [[(argType, _)]] , [[_objArg];[]] -> + | [[(argType, _)]], [[_objArg];[]] -> assert isUnitTy g argType [[]] | _ -> @@ -2295,7 +2295,7 @@ let GetTypeOfMemberInFSharpForm g (vref: ValRef) = let membInfo, topValInfo = checkMemberValRef vref GetMemberTypeInFSharpForm g membInfo.MemberFlags topValInfo vref.Type vref.Range -let PartitionValTyparsForApparentEnclosingType g (v: Val) = +let PartitionValTyparsForApparentEnclosingType g (v: Val) = match v.ValReprInfo with | None -> error(InternalError("PartitionValTypars: not a top value", v.Range)) | Some arities -> @@ -2311,7 +2311,7 @@ let PartitionValTyparsForApparentEnclosingType g (v: Val) = /// Match up the type variables on an member value with the type /// variables on the apparent enclosing type -let PartitionValTypars g (v: Val) = +let PartitionValTypars g (v: Val) = match v.ValReprInfo with | None -> error(InternalError("PartitionValTypars: not a top value", v.Range)) | Some arities -> @@ -2335,7 +2335,7 @@ let ArgInfosOfMember g (vref: ValRef) = let GetFSharpViewOfReturnType (g: TcGlobals) retTy = match retTy with | None -> g.unit_ty - | Some retTy -> retTy + | Some retTy -> retTy /// Get the property "type" (getter return type) for an F# value that represents a getter or setter @@ -2375,7 +2375,7 @@ let ArgInfosOfPropertyVal g (v: Val) = // Generalize type constructors to types //--------------------------------------------------------------------------- -let generalTyconRefInst (tc: TyconRef) = generalizeTypars tc.TyparsNoRange +let generalTyconRefInst (tc: TyconRef) = generalizeTypars tc.TyparsNoRange let generalizeTyconRef tc = let tinst = generalTyconRefInst tc @@ -2454,7 +2454,7 @@ module PrettyTypes = let nm = if i < letters then String.make 1 (char(int baseName + i)) else String.make 1 baseName + string (i-letters+1) - tryName (nm, typeIndex, measureIndex) (fun () -> + tryName (nm, typeIndex, measureIndex) (fun () -> tryAgain (typeIndex, measureIndex)) else @@ -2591,7 +2591,7 @@ module SimplifyTypes = let accTyparCounts z ty = // Walk type to determine typars and their counts (for pprinting decisions) - foldTypeButNotConstraints (fun z ty -> match ty with | TType_var tp when tp.Rigidity = TyparRigidity.Rigid -> incM tp z | _ -> z) z ty + foldTypeButNotConstraints (fun z ty -> match ty with | TType_var tp when tp.Rigidity = TyparRigidity.Rigid -> incM tp z | _ -> z) z ty let emptyTyparCounts = Zmap.empty typarOrder @@ -2897,7 +2897,7 @@ let TryFindFSharpAttribute g tref attrs = List.tryFind (IsMatchingFSharpAttribut let TryFindFSharpAttributeOpt g tref attrs = match tref with None -> None | Some tref -> List.tryFind (IsMatchingFSharpAttribute g tref) attrs let HasFSharpAttributeOpt g trefOpt attrs = match trefOpt with Some tref -> List.exists (IsMatchingFSharpAttribute g tref) attrs | _ -> false -let IsMatchingFSharpAttributeOpt g attrOpt (Attrib(tcref2, _, _, _, _, _, _)) = match attrOpt with Some ((AttribInfo(_, tcref))) -> tyconRefEq g tcref tcref2 | _ -> false +let IsMatchingFSharpAttributeOpt g attrOpt (Attrib(tcref2, _, _, _, _, _, _)) = match attrOpt with Some ((AttribInfo(_, tcref))) -> tyconRefEq g tcref tcref2 | _ -> false let (|ExtractAttribNamedArg|_|) nm args = args |> List.tryPick (function (AttribNamedArg(nm2, _, _, v)) when nm = nm2 -> Some v | _ -> None) @@ -3200,9 +3200,9 @@ module DebugPrint = let angleL x = sepL Literals.leftAngle ^^ x ^^ rightL Literals.rightAngle - let braceL x = leftL Literals.leftBrace ^^ x ^^ rightL Literals.rightBrace + let braceL x = leftL Literals.leftBrace ^^ x ^^ rightL Literals.rightBrace - let braceBarL x = leftL Literals.leftBraceBar ^^ x ^^ rightL Literals.rightBraceBar + let braceBarL x = leftL Literals.leftBraceBar ^^ x ^^ rightL Literals.rightBraceBar let boolL = function true -> WordL.keywordTrue | false -> WordL.keywordFalse @@ -3308,9 +3308,9 @@ module DebugPrint = let wrap x = bracketIfL isAtomic x in // wrap iff require atomic expr // There are several cases for pprinting of typar. // - // 'a - is multiple occurrence. - // #Type - inplace coercion constraint and singleton - // ('a :> Type) - inplace coercion constraint not singleton + // 'a - is multiple occurrence. + // #Type - inplace coercion constraint and singleton + // ('a :> Type) - inplace coercion constraint not singleton // ('a.opM: S->T) - inplace operator constraint let tpL = wordL (tagText (prefixOfStaticReq typar.StaticReq @@ -3744,9 +3744,9 @@ module DebugPrint = wordL(tagText "try") ^^ exprL x1 ^^ wordL(tagText "with") ^^ exprL x2 ^^ rightL(tagText "}") | Expr.Op (TOp.TryFinally _, [_], [x1;x2], _) -> wordL(tagText "try") ^^ exprL x1 ^^ wordL(tagText "finally") ^^ exprL x2 ^^ rightL(tagText "}") - | Expr.Op (TOp.Bytes _, _ , _ , _) -> + | Expr.Op (TOp.Bytes _, _, _, _) -> wordL(tagText "bytes++") - | Expr.Op (TOp.UInt16s _, _ , _ , _) -> wordL(tagText "uint16++") + | Expr.Op (TOp.UInt16s _, _, _, _) -> wordL(tagText "uint16++") | Expr.Op (TOp.RefAddrGet _, _tyargs, _args, _) -> wordL(tagText "GetRefLVal...") | Expr.Op (TOp.TraitCall _, _tyargs, _args, _) -> wordL(tagText "traitcall...") | Expr.Op (TOp.ExnFieldGet _, _tyargs, _args, _) -> wordL(tagText "TOp.ExnFieldGet...") @@ -3792,7 +3792,7 @@ module DebugPrint = and mdefL x = match x with - | TMDefRec(_, tycons , mbinds, _) -> aboveListL ((tycons |> List.map tyconL) @ List.map mbindL mbinds) + | TMDefRec(_, tycons, mbinds, _) -> aboveListL ((tycons |> List.map tyconL) @ List.map mbindL mbinds) | TMDefLet(bind, _) -> letL bind emptyL | TMDefDo(e, _) -> exprL e | TMDefs defs -> mdefsL defs @@ -3868,7 +3868,7 @@ module DebugPrint = //-------------------------------------------------------------------------- let wrapModuleOrNamespaceType id cpath mtyp = - NewModuleOrNamespace (Some cpath) taccessPublic id XmlDoc.Empty [] (MaybeLazy.Strict mtyp) + NewModuleOrNamespace (Some cpath) taccessPublic id XmlDoc.Empty [] (MaybeLazy.Strict mtyp) let wrapModuleOrNamespaceTypeInNamespace id cpath mtyp = let mspec = wrapModuleOrNamespaceType id cpath mtyp @@ -3888,7 +3888,7 @@ let SigTypeOfImplFile (TImplFile(_, _, mexpr, _, _, _)) = mexpr.Type type SignatureRepackageInfo = { RepackagedVals: (ValRef * ValRef) list - RepackagedEntities: (TyconRef * TyconRef) list } + RepackagedEntities: (TyconRef * TyconRef) list } member remapInfo.ImplToSigMapping = { TypeEquivEnv.Empty with EquivTycons = TyconRefMap.OfList remapInfo.RepackagedEntities } static member Empty = { RepackagedVals = []; RepackagedEntities= [] } @@ -3901,14 +3901,14 @@ type SignatureHidingInfo = HiddenUnionCases: Zset } static member Empty = - { HiddenTycons = Zset.empty tyconOrder - HiddenTyconReprs = Zset.empty tyconOrder - HiddenVals = Zset.empty valOrder - HiddenRecdFields = Zset.empty recdFieldRefOrder - HiddenUnionCases = Zset.empty unionCaseRefOrder } + { HiddenTycons = Zset.empty tyconOrder + HiddenTyconReprs = Zset.empty tyconOrder + HiddenVals = Zset.empty valOrder + HiddenRecdFields = Zset.empty recdFieldRefOrder + HiddenUnionCases = Zset.empty unionCaseRefOrder } let addValRemap v vNew tmenv = - { tmenv with valRemap= tmenv.valRemap.Add v (mkLocalValRef vNew) } + { tmenv with valRemap= tmenv.valRemap.Add v (mkLocalValRef vNew) } let mkRepackageRemapping mrpi = { valRemap = ValMap.OfList (mrpi.RepackagedVals |> List.map (fun (vref, x) -> vref.Deref, x)) @@ -3927,7 +3927,7 @@ let accEntityRemap (msigty: ModuleOrNamespaceType) (entity: Entity) (mrpi, mhi) // The type constructor is not present in the signature. Hence it is hidden. let mhi = { mhi with HiddenTycons = Zset.add entity mhi.HiddenTycons } (mrpi, mhi) - | Some sigtycon -> + | Some sigtycon -> // The type constructor is in the signature. Hence record the repackage entry let sigtcref = mkLocalTyconRef sigtycon let tcref = mkLocalTyconRef entity @@ -3943,24 +3943,24 @@ let accEntityRemap (msigty: ModuleOrNamespaceType) (entity: Entity) (mrpi, mhi) let mhi = (entity.AllFieldsArray, mhi) ||> Array.foldBack (fun rfield mhi -> match sigtycon.GetFieldByName(rfield.Name) with - | Some _ -> + | Some _ -> // The field is in the signature. Hence it is not hidden. mhi | _ -> // The field is not in the signature. Hence it is regarded as hidden. let rfref = tcref.MakeNestedRecdFieldRef rfield - { mhi with HiddenRecdFields = Zset.add rfref mhi.HiddenRecdFields }) + { mhi with HiddenRecdFields = Zset.add rfref mhi.HiddenRecdFields }) let mhi = (entity.UnionCasesAsList, mhi) ||> List.foldBack (fun ucase mhi -> match sigtycon.GetUnionCaseByName ucase.DisplayName with - | Some _ -> + | Some _ -> // The constructor is in the signature. Hence it is not hidden. mhi | _ -> // The constructor is not in the signature. Hence it is regarded as hidden. let ucref = tcref.MakeNestedUnionCaseRef ucase - { mhi with HiddenUnionCases = Zset.add ucref mhi.HiddenUnionCases }) + { mhi with HiddenUnionCases = Zset.add ucref mhi.HiddenUnionCases }) mhi (mrpi, mhi) @@ -3971,7 +3971,7 @@ let accSubEntityRemap (msigty: ModuleOrNamespaceType) (entity: Entity) (mrpi, mh // The type constructor is not present in the signature. Hence it is hidden. let mhi = { mhi with HiddenTycons = Zset.add entity mhi.HiddenTycons } (mrpi, mhi) - | Some sigtycon -> + | Some sigtycon -> // The type constructor is in the signature. Hence record the repackage entry let sigtcref = mkLocalTyconRef sigtycon let tcref = mkLocalTyconRef entity @@ -3995,7 +3995,7 @@ let accValRemap g aenv (msigty: ModuleOrNamespaceType) (implVal: Val) (mrpi, mhi if verbose then dprintf "accValRemap, hide = %s#%d\n" implVal.LogicalName implVal.Stamp let mhi = { mhi with HiddenVals = Zset.add implVal mhi.HiddenVals } (mrpi, mhi) - | Some (sigVal: Val) -> + | Some (sigVal: Val) -> // The value is in the signature. Add the repackage entry. let mrpi = { mrpi with RepackagedVals = (vref, mkLocalValRef sigVal) :: mrpi.RepackagedVals } (mrpi, mhi) @@ -4041,8 +4041,8 @@ let rec accEntityRemapFromModuleOrNamespace msigty x acc = let acc = (tycons, acc) ||> List.foldBack (accEntityRemap msigty) let acc = (tycons, acc) ||> List.foldBack (fun e acc -> accEntityRemapFromModuleOrNamespaceType e.ModuleOrNamespaceType (getCorrespondingSigTy e.LogicalName msigty) acc) acc - | TMDefLet _ -> acc - | TMDefDo _ -> acc + | TMDefLet _ -> acc + | TMDefDo _ -> acc | TMDefs defs -> accEntityRemapFromModuleOrNamespaceDefs msigty defs acc | TMAbstract mexpr -> accEntityRemapFromModuleOrNamespaceType mexpr.Type msigty acc @@ -4063,8 +4063,8 @@ let rec accValRemapFromModuleOrNamespace g aenv msigty x acc = let vslotvs = abstractSlotValsOfTycons tycons let acc = (vslotvs, acc) ||> List.foldBack (accValRemap g aenv msigty) acc - | TMDefLet(bind, _) -> accValRemap g aenv msigty bind.Var acc - | TMDefDo _ -> acc + | TMDefLet(bind, _) -> accValRemap g aenv msigty bind.Var acc + | TMDefDo _ -> acc | TMDefs defs -> accValRemapFromModuleOrNamespaceDefs g aenv msigty defs acc | TMAbstract mexpr -> accValRemapFromModuleOrNamespaceType g aenv mexpr.Type msigty acc @@ -4157,10 +4157,10 @@ let IsHidden setF accessF remapF debugF = if verbose then dprintf "IsHidden, #mrmi = %d, %s = %b\n" mrmi.Length (showL (debugF x)) res res -let IsHiddenTycon mrmi x = IsHidden (fun mhi -> mhi.HiddenTycons) (fun tc -> tc.Accessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x -let IsHiddenTyconRepr mrmi x = IsHidden (fun mhi -> mhi.HiddenTyconReprs) (fun v -> v.TypeReprAccessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x -let IsHiddenVal mrmi x = IsHidden (fun mhi -> mhi.HiddenVals) (fun v -> v.Accessibility) (fun rpi x -> (remapValRef rpi (mkLocalValRef x)).Deref) DebugPrint.valL mrmi x -let IsHiddenRecdField mrmi x = IsHidden (fun mhi -> mhi.HiddenRecdFields) (fun rfref -> rfref.RecdField.Accessibility) (fun rpi x -> remapRecdFieldRef rpi.tyconRefRemap x) DebugPrint.recdFieldRefL mrmi x +let IsHiddenTycon mrmi x = IsHidden (fun mhi -> mhi.HiddenTycons) (fun tc -> tc.Accessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x +let IsHiddenTyconRepr mrmi x = IsHidden (fun mhi -> mhi.HiddenTyconReprs) (fun v -> v.TypeReprAccessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x +let IsHiddenVal mrmi x = IsHidden (fun mhi -> mhi.HiddenVals) (fun v -> v.Accessibility) (fun rpi x -> (remapValRef rpi (mkLocalValRef x)).Deref) DebugPrint.valL mrmi x +let IsHiddenRecdField mrmi x = IsHidden (fun mhi -> mhi.HiddenRecdFields) (fun rfref -> rfref.RecdField.Accessibility) (fun rpi x -> remapRecdFieldRef rpi.tyconRefRemap x) DebugPrint.recdFieldRefL mrmi x //-------------------------------------------------------------------------- // Generic operations on module types @@ -4178,7 +4178,7 @@ let allValsOfModuleOrNamespaceTy m = foldModuleOrNamespaceTy (fun _ acc -> acc) let allEntitiesOfModuleOrNamespaceTy m = foldModuleOrNamespaceTy (fun ft acc -> ft :: acc) (fun _ acc -> acc) m [] //--------------------------------------------------------------------------- -// Free variables in terms. Are all constructs public accessible? +// Free variables in terms. Are all constructs public accessible? //--------------------------------------------------------------------------- let isPublicVal (lv: Val) = (lv.Accessibility = taccessPublic) @@ -4189,18 +4189,18 @@ let isPublicTycon (tcref: Tycon) = (tcref.Accessibility = taccessPublic) let freeVarsAllPublic fvs = // Are any non-public items used in the expr (which corresponded to the fvs)? // Recall, taccess occurs in: - // EntityData has ReprAccessibility and Accessiblity - // UnionCase has Accessibility - // RecdField has Accessibility - // ValData has Accessibility + // EntityData has ReprAccessibility and Accessiblity + // UnionCase has Accessibility + // RecdField has Accessibility + // ValData has Accessibility // The freevars and FreeTyvars collect local constructs. // Here, we test that all those constructs are public. // // CODEREVIEW: // What about non-local vals. This fix assumes non-local vals must be public. OK? - Zset.forall isPublicVal fvs.FreeLocals && + Zset.forall isPublicVal fvs.FreeLocals && Zset.forall isPublicUnionCase fvs.FreeUnionCases && - Zset.forall isPublicRecdField fvs.FreeRecdFields && + Zset.forall isPublicRecdField fvs.FreeRecdFields && Zset.forall isPublicTycon fvs.FreeTyvars.FreeTycons let freeTyvarsAllPublic tyvars = @@ -4220,7 +4220,7 @@ let rebuildLinearMatchExpr (sp, m, dtree, tg1, e2, sp2, m2, ty) = primMkMatch (sp, m, dtree, [|tg1;(TTarget([], e2, sp2))|], m2, ty) /// Detect a subset of 'Expr.Op' expressions we process in a linear way (i.e. using tailcalls, rather than -/// unbounded stack). Only covers Cons(args,Cons(args,Cons(args,Cons(args,...._)))). +/// unbounded stack). Only covers Cons(args,Cons(args,Cons(args,Cons(args,...._)))). let (|LinearOpExpr|_|) expr = match expr with | Expr.Op ((TOp.UnionCase _ as op), tinst, args, m) when not args.IsEmpty -> @@ -4232,7 +4232,7 @@ let rebuildLinearOpExpr (op, tinst, argsFront, argLast, m) = Expr.Op (op, tinst, argsFront@[argLast], m) //--------------------------------------------------------------------------- -// Free variables in terms. All binders are distinct. +// Free variables in terms. All binders are distinct. //--------------------------------------------------------------------------- let emptyFreeVars = @@ -4247,13 +4247,13 @@ let emptyFreeVars = let unionFreeVars fvs1 fvs2 = if fvs1 === emptyFreeVars then fvs2 else if fvs2 === emptyFreeVars then fvs1 else - { FreeLocals = unionFreeLocals fvs1.FreeLocals fvs2.FreeLocals - FreeTyvars = unionFreeTyvars fvs1.FreeTyvars fvs2.FreeTyvars - UsesMethodLocalConstructs = fvs1.UsesMethodLocalConstructs || fvs2.UsesMethodLocalConstructs - UsesUnboundRethrow = fvs1.UsesUnboundRethrow || fvs2.UsesUnboundRethrow - FreeLocalTyconReprs = unionFreeTycons fvs1.FreeLocalTyconReprs fvs2.FreeLocalTyconReprs - FreeRecdFields = unionFreeRecdFields fvs1.FreeRecdFields fvs2.FreeRecdFields - FreeUnionCases = unionFreeUnionCases fvs1.FreeUnionCases fvs2.FreeUnionCases } + { FreeLocals = unionFreeLocals fvs1.FreeLocals fvs2.FreeLocals + FreeTyvars = unionFreeTyvars fvs1.FreeTyvars fvs2.FreeTyvars + UsesMethodLocalConstructs = fvs1.UsesMethodLocalConstructs || fvs2.UsesMethodLocalConstructs + UsesUnboundRethrow = fvs1.UsesUnboundRethrow || fvs2.UsesUnboundRethrow + FreeLocalTyconReprs = unionFreeTycons fvs1.FreeLocalTyconReprs fvs2.FreeLocalTyconReprs + FreeRecdFields = unionFreeRecdFields fvs1.FreeRecdFields fvs2.FreeRecdFields + FreeUnionCases = unionFreeUnionCases fvs1.FreeUnionCases fvs2.FreeUnionCases } let inline accFreeTyvars (opts: FreeVarOptions) f v acc = if not opts.collectInTypes then acc else @@ -4262,10 +4262,10 @@ let inline accFreeTyvars (opts: FreeVarOptions) f v acc = if ftyvs === ftyvs' then acc else { acc with FreeTyvars = ftyvs' } -let accFreeVarsInTy opts ty acc = accFreeTyvars opts accFreeInType ty acc -let accFreeVarsInTys opts tys acc = if isNil tys then acc else accFreeTyvars opts accFreeInTypes tys acc +let accFreeVarsInTy opts ty acc = accFreeTyvars opts accFreeInType ty acc +let accFreeVarsInTys opts tys acc = if isNil tys then acc else accFreeTyvars opts accFreeInTypes tys acc let accFreevarsInTycon opts tcref acc = accFreeTyvars opts accFreeTycon tcref acc -let accFreevarsInVal opts v acc = accFreeTyvars opts accFreeInVal v acc +let accFreevarsInVal opts v acc = accFreeTyvars opts accFreeInVal v acc let accFreeVarsInTraitSln opts tys acc = accFreeTyvars opts accFreeInTraitSln tys acc @@ -4327,7 +4327,7 @@ and accFreeInValFlags opts flag acc = | VSlotDirectCall | CtorValUsedAsSelfInit | CtorValUsedAsSuperInit -> true - | PossibleConstrainedCall _ + | PossibleConstrainedCall _ | NormalValUse -> false let acc = accUsesFunctionLocalConstructs isMethLocal acc match flag with @@ -4343,11 +4343,11 @@ and accFreeLocalVal opts v fvs = and accLocalTyconRepr opts b fvs = if not opts.includeLocalTyconReprs then fvs else - if Zset.contains b fvs.FreeLocalTyconReprs then fvs + if Zset.contains b fvs.FreeLocalTyconReprs then fvs else { fvs with FreeLocalTyconReprs = Zset.add b fvs.FreeLocalTyconReprs } and accUsedRecdOrUnionTyconRepr opts (tc: Tycon) fvs = - if match tc.TypeReprInfo with TFSharpObjectRepr _ | TRecdRepr _ | TUnionRepr _ -> true | _ -> false + if match tc.TypeReprInfo with TFSharpObjectRepr _ | TRecdRepr _ | TUnionRepr _ -> true | _ -> false then accLocalTyconRepr opts tc fvs else fvs @@ -4376,7 +4376,7 @@ and accFreeValRef opts (vref: ValRef) fvs = and accFreeInMethod opts (TObjExprMethod(slotsig, _attribs, tps, tmvs, e, _)) acc = accFreeInSlotSig opts slotsig - (unionFreeVars (accFreeTyvars opts boundTypars tps (List.foldBack (boundLocalVals opts) tmvs (freeInExpr opts e))) acc) + (unionFreeVars (accFreeTyvars opts boundTypars tps (List.foldBack (boundLocalVals opts) tmvs (freeInExpr opts e))) acc) and accFreeInMethods opts methods acc = List.foldBack (accFreeInMethod opts) methods acc @@ -4404,7 +4404,7 @@ and accFreeInExprNonLinear opts x acc = match x with // BINDING CONSTRUCTS - | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, bodyExpr, _, rty) -> + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, bodyExpr, _, rty) -> unionFreeVars (Option.foldBack (boundLocalVal opts) ctorThisValOpt (Option.foldBack (boundLocalVal opts) baseValOpt @@ -4425,7 +4425,7 @@ and accFreeInExprNonLinear opts x acc = | Expr.Let _ -> failwith "unreachable - linear expr" - | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, _) -> + | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, _) -> unionFreeVars (boundProtect (Option.foldBack (boundLocalVal opts) basev @@ -4505,7 +4505,7 @@ and accFreeInOp opts op acc = | TOp.Goto _ | TOp.Label _ | TOp.Return | TOp.TupleFieldGet _ -> acc - | TOp.Tuple tupInfo -> + | TOp.Tuple tupInfo -> accFreeTyvars opts accFreeInTupInfo tupInfo acc | TOp.AnonRecd anonInfo @@ -4526,7 +4526,7 @@ and accFreeInOp opts op acc = // Things containing just an exception reference | TOp.ExnConstr ecref | TOp.ExnFieldGet (ecref, _) - | TOp.ExnFieldSet (ecref, _) -> + | TOp.ExnFieldSet (ecref, _) -> accFreeExnRef ecref acc | TOp.ValFieldGet fref @@ -4591,14 +4591,14 @@ and freeInExpr opts expr = let rec accFreeInModuleOrNamespace opts mexpr acc = match mexpr with | TMDefRec(_, _, mbinds, _) -> List.foldBack (accFreeInModuleOrNamespaceBind opts) mbinds acc - | TMDefLet(bind, _) -> accBindRhs opts bind acc - | TMDefDo(e, _) -> accFreeInExpr opts e acc + | TMDefLet(bind, _) -> accBindRhs opts bind acc + | TMDefDo(e, _) -> accFreeInExpr opts e acc | TMDefs defs -> accFreeInModuleOrNamespaces opts defs acc | TMAbstract(ModuleOrNamespaceExprWithSig(_, mdef, _)) -> accFreeInModuleOrNamespace opts mdef acc // not really right, but sufficient for how this is used in optimization and accFreeInModuleOrNamespaceBind opts mbind acc = match mbind with - | ModuleOrNamespaceBinding.Binding bind -> accBindRhs opts bind acc + | ModuleOrNamespaceBinding.Binding bind -> accBindRhs opts bind acc | ModuleOrNamespaceBinding.Module (_, def) -> accFreeInModuleOrNamespace opts def acc and accFreeInModuleOrNamespaces opts mexprs acc = @@ -4667,7 +4667,7 @@ let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttri let tps, vsl, _ = stripTopLambdaNoTypes expr let fun_arity = vsl.Length - let dtys, _ = stripFunTyN g fun_arity (snd (tryDestForallTy g ty)) + let dtys, _ = stripFunTyN g fun_arity (snd (tryDestForallTy g ty)) let partialArgAttribsL = Array.ofList partialArgAttribsL assert (List.length vsl = List.length dtys) @@ -4681,10 +4681,10 @@ let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttri if (i = 0 && isUnitTy g ty) then [] else tryDestRefTupleTy g ty let ids = - if vs.Length = tys.Length then vs |> List.map (fun v -> Some v.Id) + if vs.Length = tys.Length then vs |> List.map (fun v -> Some v.Id) else tys |> List.map (fun _ -> None) let attribs = - if partialAttribs.Length = tys.Length then partialAttribs + if partialAttribs.Length = tys.Length then partialAttribs else tys |> List.map (fun _ -> []) (ids, attribs) ||> List.map2 (fun id attribs -> { Name = id; Attribs = attribs }: ArgReprInfo )) let retInfo: ArgReprInfo = { Attribs = retAttribs; Name = None } @@ -4728,7 +4728,7 @@ let underlyingTypeOfEnumTy (g: TcGlobals) ty = let tycon = (tcrefOfAppTy g ty).Deref match tycon.GetFieldByName "value__" with | Some rf -> rf.FormalType - | None -> error(InternalError("no 'value__' field found for enumeration type " + tycon.LogicalName, tycon.Range)) + | None -> error(InternalError("no 'value__' field found for enumeration type " + tycon.LogicalName, tycon.Range)) // CLEANUP NOTE: Get rid of this mutation. let setValHasNoArity (f: Val) = @@ -4757,13 +4757,13 @@ let decideStaticOptimizationConstraint g c = match b with | AppTy g (tcref2, _) -> if tyconRefEq g tcref1 tcref2 then StaticOptimizationAnswer.Yes else StaticOptimizationAnswer.No - | RefTupleTy g _ | FunTy g _ -> StaticOptimizationAnswer.No + | RefTupleTy g _ | FunTy g _ -> StaticOptimizationAnswer.No | _ -> StaticOptimizationAnswer.Unknown | FunTy g _ -> let b = normalizeEnumTy g (stripTyEqnsAndMeasureEqns g b) match b with - | FunTy g _ -> StaticOptimizationAnswer.Yes + | FunTy g _ -> StaticOptimizationAnswer.Yes | AppTy g _ | RefTupleTy g _ -> StaticOptimizationAnswer.No | _ -> StaticOptimizationAnswer.Unknown | RefTupleTy g ts1 -> @@ -4824,12 +4824,12 @@ let bindLocalVals vs vs' tmenv = { tmenv with valRemap= (vs, vs', tmenv.valRemap) |||> List.foldBack2 (fun v v' acc -> acc.Add v (mkLocalValRef v') ) } let bindTycon (tc: Tycon) (tc': Tycon) tyenv = - { tyenv with tyconRefRemap=tyenv.tyconRefRemap.Add (mkLocalTyconRef tc) (mkLocalTyconRef tc') } + { tyenv with tyconRefRemap=tyenv.tyconRefRemap.Add (mkLocalTyconRef tc) (mkLocalTyconRef tc') } let bindTycons tcs tcs' tyenv = { tyenv with tyconRefRemap= (tcs, tcs', tyenv.tyconRefRemap) |||> List.foldBack2 (fun tc tc' acc -> acc.Add (mkLocalTyconRef tc) (mkLocalTyconRef tc')) } -let remapAttribKind tmenv k = +let remapAttribKind tmenv k = match k with | ILAttrib _ as x -> x | FSAttrib vref -> FSAttrib(remapValRef tmenv vref) @@ -4851,7 +4851,7 @@ let rec remapAttrib g tmenv (Attrib (tcref, kind, args, props, isGetOrSetAttr, t and remapAttribExpr g tmenv (AttribExpr(e1, e2)) = AttribExpr(remapExpr g CloneAll tmenv e1, remapExpr g CloneAll tmenv e2) -and remapAttribs g tmenv xs = List.map (remapAttrib g tmenv) xs +and remapAttribs g tmenv xs = List.map (remapAttrib g tmenv) xs and remapPossibleForallTy g tmenv ty = remapTypeFull (remapAttribs g tmenv) tmenv ty @@ -4870,15 +4870,15 @@ and remapValData g tmenv (d: ValData) = let memberInfoR = d.MemberInfo |> Option.map (remapMemberInfo g d.val_range topValInfo ty tyR tmenv) let attribsR = d.Attribs |> remapAttribs g tmenv { d with - val_type = tyR + val_type = tyR val_opt_data = match d.val_opt_data with | Some dd -> Some { dd with val_declaring_entity = declaringEntityR - val_repr_info = reprInfoR - val_member_info = memberInfoR - val_attribs = attribsR } + val_repr_info = reprInfoR + val_member_info = memberInfoR + val_attribs = attribsR } | None -> None } and remapParentRef tyenv p = @@ -4894,7 +4894,7 @@ and mapImmediateValsAndTycons ft fv (x: ModuleOrNamespaceType) = and copyVal compgen (v: Val) = match compgen with | OnlyCloneExprVals when v.IsMemberOrModuleBinding -> v - | _ -> v |> NewModifiedVal id + | _ -> v |> NewModifiedVal id and fixupValData g compgen tmenv (v2: Val) = // only fixup if we copy the value @@ -4928,9 +4928,9 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = remapLinearExpr g compgen tmenv expr (fun x -> x) // Binding constructs - see also dtrees below - | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, b, m, rty) -> - let ctorThisValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv ctorThisValOpt - let baseValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv baseValOpt + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, b, m, rty) -> + let ctorThisValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv ctorThisValOpt + let baseValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv baseValOpt let vs, tmenv = copyAndRemapAndBindVals g compgen tmenv vs let b = remapExpr g compgen tmenv b let rty = remapType tmenv rty @@ -4962,7 +4962,7 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = | Expr.Quote (a, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> // fix value of compgen for both original expression and pickled AST let compgen = fixValCopyFlagForQuotations compgen - Expr.Quote (remapExpr g compgen tmenv a, {contents=Some(typeDefs, remapTypesAux tmenv argTypes, remapExprs g compgen tmenv argExprs, data)}, isFromQueryExpression, m, remapType tmenv ty) + Expr.Quote (remapExpr g compgen tmenv a, {contents=Some(typeDefs, remapTypesAux tmenv argTypes, remapExprs g compgen tmenv argExprs, data)}, isFromQueryExpression, m, remapType tmenv ty) | Expr.Quote (a, {contents=None}, isFromQueryExpression, m, ty) -> Expr.Quote (remapExpr g (fixValCopyFlagForQuotations compgen) tmenv a, {contents=None}, isFromQueryExpression, m, remapType tmenv ty) @@ -5036,7 +5036,7 @@ and remapLinearExpr g compgen tmenv expr contf = // tailcall for the linear position remapLinearExpr g compgen tmenvinner bodyExpr (contf << mkLetBind m bind') - | Expr.Sequential (expr1, expr2, dir, spSeq, m) -> + | Expr.Sequential (expr1, expr2, dir, spSeq, m) -> let expr1' = remapExpr g compgen tmenv expr1 // tailcall for the linear position remapLinearExpr g compgen tmenv expr2 (contf << (fun expr2' -> @@ -5093,7 +5093,7 @@ and remapOp tmenv op = TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, remapValFlags tmenv valUseFlags, isProperty, noTailCall, ilMethRef, remapTypes tmenv enclTypeArgs, remapTypes tmenv methTypeArgs, remapTypes tmenv tys) - | _ -> op + | _ -> op and remapValFlags tmenv x = match x with @@ -5111,7 +5111,7 @@ and remapDecisionTree g compgen tmenv x = List.map (fun (TCase(test, y)) -> let test' = match test with - | DecisionTreeTest.UnionCase (uc, tinst) -> DecisionTreeTest.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap uc, remapTypes tmenv tinst) + | DecisionTreeTest.UnionCase (uc, tinst) -> DecisionTreeTest.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap uc, remapTypes tmenv tinst) | DecisionTreeTest.ArrayLength (n, ty) -> DecisionTreeTest.ArrayLength(n, remapType tmenv ty) | DecisionTreeTest.Const _ -> test | DecisionTreeTest.IsInst (srcty, tgty) -> DecisionTreeTest.IsInst (remapType tmenv srcty, remapType tmenv tgty) @@ -5129,7 +5129,7 @@ and remapDecisionTree g compgen tmenv x = and copyAndRemapAndBindBinding g compgen tmenv (bind: Binding) = let v = bind.Var let v', tmenv = copyAndRemapAndBindVal g compgen tmenv v - remapAndRenameBind g compgen tmenv bind v' , tmenv + remapAndRenameBind g compgen tmenv bind v', tmenv and copyAndRemapAndBindBindings g compgen tmenv binds = let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv (valsOfBinds binds) @@ -5138,7 +5138,7 @@ and copyAndRemapAndBindBindings g compgen tmenv binds = and remapAndRenameBinds g compgen tmenvinner binds vs' = List.map2 (remapAndRenameBind g compgen tmenvinner) binds vs' and remapAndRenameBind g compgen tmenvinner (TBind(_, repr, letSeqPtOpt)) v' = TBind(v', remapExpr g compgen tmenvinner repr, letSeqPtOpt) -and remapMethod g compgen tmenv (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = +and remapMethod g compgen tmenv (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = let attribs2 = attribs |> remapAttribs g tmenv let slotsig2 = remapSlotSig (remapAttribs g tmenv) tmenv slotsig let tps2, tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps @@ -5146,12 +5146,12 @@ and remapMethod g compgen tmenv (TObjExprMethod(slotsig, attribs, tps, vs, e, m) let e2 = remapExpr g compgen tmenvinner2 e TObjExprMethod(slotsig2, attribs2, tps2, vs2, e2, m) -and remapInterfaceImpl g compgen tmenv (ty, overrides) = +and remapInterfaceImpl g compgen tmenv (ty, overrides) = (remapType tmenv ty, List.map (remapMethod g compgen tmenv) overrides) and remapRecdField g tmenv x = { x with - rfield_type = x.rfield_type |> remapPossibleForallTy g tmenv + rfield_type = x.rfield_type |> remapPossibleForallTy g tmenv rfield_pattribs = x.rfield_pattribs |> remapAttribs g tmenv rfield_fattribs = x.rfield_fattribs |> remapAttribs g tmenv } @@ -5161,7 +5161,7 @@ and remapRecdFields g tmenv (x: TyconRecdFields) = and remapUnionCase g tmenv (x: UnionCase) = { x with FieldTable = x.FieldTable |> remapRecdFields g tmenv - ReturnType = x.ReturnType |> remapType tmenv + ReturnType = x.ReturnType |> remapType tmenv Attribs = x.Attribs |> remapAttribs g tmenv } and remapUnionCases g tmenv (x: TyconUnionData) = @@ -5173,7 +5173,7 @@ and remapFsObjData g tmenv x = (match x.fsobjmodel_kind with | TTyconDelegate slotsig -> TTyconDelegate (remapSlotSig (remapAttribs g tmenv) tmenv slotsig) | TTyconClass | TTyconInterface | TTyconStruct | TTyconEnum -> x.fsobjmodel_kind) - fsobjmodel_vslots = x.fsobjmodel_vslots |> List.map (remapValRef tmenv) + fsobjmodel_vslots = x.fsobjmodel_vslots |> List.map (remapValRef tmenv) fsobjmodel_rfields = x.fsobjmodel_rfields |> remapRecdFields g tmenv } @@ -5188,7 +5188,7 @@ and remapTyconRepr g tmenv repr = | TProvidedTypeExtensionPoint info -> TProvidedTypeExtensionPoint { info with - LazyBaseType = info.LazyBaseType.Force (range0, g.obj_ty) |> remapType tmenv |> LazyWithContext.NotLazy + LazyBaseType = info.LazyBaseType.Force (range0, g.obj_ty) |> remapType tmenv |> LazyWithContext.NotLazy // The load context for the provided type contains TyconRef objects. We must remap these. // This is actually done on-demand (see the implementation of ProvidedTypeContext) ProvidedType = @@ -5202,20 +5202,20 @@ and remapTyconRepr g tmenv repr = and remapTyconAug tmenv (x: TyconAugmentation) = { x with - tcaug_equals = x.tcaug_equals |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) - tcaug_compare = x.tcaug_compare |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) - tcaug_compare_withc = x.tcaug_compare_withc |> Option.map(remapValRef tmenv) - tcaug_hash_and_equals_withc = x.tcaug_hash_and_equals_withc |> Option.map (mapTriple (remapValRef tmenv, remapValRef tmenv, remapValRef tmenv)) - tcaug_adhoc = x.tcaug_adhoc |> NameMap.map (List.map (remapValRef tmenv)) - tcaug_adhoc_list = x.tcaug_adhoc_list |> ResizeArray.map (fun (flag, vref) -> (flag, remapValRef tmenv vref)) - tcaug_super = x.tcaug_super |> Option.map (remapType tmenv) - tcaug_interfaces = x.tcaug_interfaces |> List.map (map1Of3 (remapType tmenv)) } + tcaug_equals = x.tcaug_equals |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) + tcaug_compare = x.tcaug_compare |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) + tcaug_compare_withc = x.tcaug_compare_withc |> Option.map(remapValRef tmenv) + tcaug_hash_and_equals_withc = x.tcaug_hash_and_equals_withc |> Option.map (mapTriple (remapValRef tmenv, remapValRef tmenv, remapValRef tmenv)) + tcaug_adhoc = x.tcaug_adhoc |> NameMap.map (List.map (remapValRef tmenv)) + tcaug_adhoc_list = x.tcaug_adhoc_list |> ResizeArray.map (fun (flag, vref) -> (flag, remapValRef tmenv vref)) + tcaug_super = x.tcaug_super |> Option.map (remapType tmenv) + tcaug_interfaces = x.tcaug_interfaces |> List.map (map1Of3 (remapType tmenv)) } and remapTyconExnInfo g tmenv inp = match inp with | TExnAbbrevRepr x -> TExnAbbrevRepr (remapTyconRef tmenv.tyconRefRemap x) - | TExnFresh x -> TExnFresh (remapRecdFields g tmenv x) - | TExnAsmRepr _ | TExnNone -> inp + | TExnFresh x -> TExnFresh (remapRecdFields g tmenv x) + | TExnAsmRepr _ | TExnNone -> inp and remapMemberInfo g m topValInfo ty ty' tmenv x = // The slotsig in the ImplementedSlotSigs is w.r.t. the type variables in the value's type. @@ -5226,7 +5226,7 @@ and remapMemberInfo g m topValInfo ty ty' tmenv x = let renaming, _ = mkTyparToTyparRenaming tpsOrig tps let tmenv = { tmenv with tpinst = tmenv.tpinst @ renaming } { x with - ApparentEnclosingEntity = x.ApparentEnclosingEntity |> remapTyconRef tmenv.tyconRefRemap + ApparentEnclosingEntity = x.ApparentEnclosingEntity |> remapTyconRef tmenv.tyconRefRemap ImplementedSlotSigs = x.ImplementedSlotSigs |> List.map (remapSlotSig (remapAttribs g tmenv) tmenv) } @@ -5257,7 +5257,7 @@ and renameVal tmenv x = and copyTycon compgen (tycon: Tycon) = match compgen with | OnlyCloneExprVals -> tycon - | _ -> NewClonedTycon tycon + | _ -> NewClonedTycon tycon /// This operates over a whole nested collection of tycons and vals simultaneously *) and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = @@ -5293,14 +5293,14 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = (tycons, tycons') ||> List.iter2 (fun tcd tcd' -> let tps', tmenvinner2 = tmenvCopyRemapAndBindTypars (remapAttribs g tmenvinner) tmenvinner (tcd.entity_typars.Force(tcd.entity_range)) - tcd'.entity_typars <- LazyWithContext.NotLazy tps' - tcd'.entity_attribs <- tcd.entity_attribs |> remapAttribs g tmenvinner2 - tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr g tmenvinner2 - let typeAbbrevR = tcd.TypeAbbrev |> Option.map (remapType tmenvinner2) - tcd'.entity_tycon_tcaug <- tcd.entity_tycon_tcaug |> remapTyconAug tmenvinner2 + tcd'.entity_typars <- LazyWithContext.NotLazy tps' + tcd'.entity_attribs <- tcd.entity_attribs |> remapAttribs g tmenvinner2 + tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr g tmenvinner2 + let typeAbbrevR = tcd.TypeAbbrev |> Option.map (remapType tmenvinner2) + tcd'.entity_tycon_tcaug <- tcd.entity_tycon_tcaug |> remapTyconAug tmenvinner2 tcd'.entity_modul_contents <- MaybeLazy.Strict (tcd.entity_modul_contents.Value |> mapImmediateValsAndTycons lookupTycon lookupVal) - let exnInfoR = tcd.ExceptionInfo |> remapTyconExnInfo g tmenvinner2 + let exnInfoR = tcd.ExceptionInfo |> remapTyconExnInfo g tmenvinner2 match tcd'.entity_opt_data with | Some optData -> tcd'.entity_opt_data <- Some { optData with entity_tycon_abbrev = typeAbbrevR; entity_exn_info = exnInfoR } | _ -> @@ -5325,9 +5325,9 @@ and allEntitiesOfModDef mdef = | ModuleOrNamespaceBinding.Module(mspec, def) -> yield mspec yield! allEntitiesOfModDef def - | TMDefLet _ -> () - | TMDefDo _ -> () - | TMDefs defs -> + | TMDefLet _ -> () + | TMDefDo _ -> () + | TMDefs defs -> for def in defs do yield! allEntitiesOfModDef def | TMAbstract(ModuleOrNamespaceExprWithSig(mty, _, _)) -> @@ -5341,10 +5341,10 @@ and allValsOfModDef mdef = match mbind with | ModuleOrNamespaceBinding.Binding bind -> yield bind.Var | ModuleOrNamespaceBinding.Module(_, def) -> yield! allValsOfModDef def - | TMDefLet(bind, _) -> + | TMDefLet(bind, _) -> yield bind.Var - | TMDefDo _ -> () - | TMDefs defs -> + | TMDefDo _ -> () + | TMDefs defs -> for def in defs do yield! allValsOfModDef def | TMAbstract(ModuleOrNamespaceExprWithSig(mty, _, _)) -> @@ -5395,7 +5395,7 @@ and remapAndRenameModBind g compgen tmenv x = | ModuleOrNamespaceBinding.Binding bind -> let v2 = bind |> valOfBind |> renameVal tmenv let bind2 = remapAndRenameBind g compgen tmenv bind v2 - ModuleOrNamespaceBinding.Binding bind2 + ModuleOrNamespaceBinding.Binding bind2 | ModuleOrNamespaceBinding.Module(mspec, def) -> let mspec = renameTycon tmenv mspec let def = remapAndRenameModDef g compgen tmenv def @@ -5419,7 +5419,7 @@ let instExpr g tpinst e = remapExpr g CloneAll (mkInstRemap tpinst) e let rec remarkExpr m x = match x with - | Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, b, _, rty) -> + | Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, b, _, rty) -> Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, remarkExpr m b, m, rty) | Expr.TyLambda (uniq, tps, b, _, rty) -> @@ -5465,7 +5465,7 @@ let rec remarkExpr m x = | Expr.App(e1, e1ty, tyargs, args, _) -> Expr.App(remarkExpr m e1, e1ty, tyargs, remarkExprs m args, m) - | Expr.Sequential (e1, e2, dir, _, _) -> + | Expr.Sequential (e1, e2, dir, _, _) -> Expr.Sequential (remarkExpr m e1, remarkExpr m e2, dir, SuppressSequencePointOnExprOfSequential, m) | Expr.StaticOptimization (eqns, e2, e3, _) -> @@ -5523,14 +5523,14 @@ let isRecdOrUnionOrStructTyconRefDefinitelyMutable (tcref: TyconRef) = // Although from the pure F# perspective exception values cannot be changed, the .NET // implementation of exception objects attaches a whole bunch of stack information to -// each raised object. Hence we treat exception objects as if they have identity +// each raised object. Hence we treat exception objects as if they have identity let isExnDefinitelyMutable (_ecref: TyconRef) = true // Some of the implementations of library functions on lists use mutation on the tail // of the cons cell. These cells are always private, i.e. not accessible by any other // code until the construction of the entire return list has been completed. // However, within the implementation code reads of the tail cell must in theory be treated -// with caution. Hence we are conservative and within FSharp.Core we don't treat list +// with caution. Hence we are conservative and within FSharp.Core we don't treat list // reads as if they were pure. let isUnionCaseFieldMutable (g: TcGlobals) (ucref: UnionCaseRef) n = (g.compilingFslib && tyconRefEq g ucref.TyconRef g.list_tcr_canon && n = 1) || @@ -5553,11 +5553,11 @@ let ComputeFieldName tycon f = let isQuotedExprTy g ty = match tryAppTy g ty with ValueSome (tcref, _) -> tyconRefEq g tcref g.expr_tcr | _ -> false -let destQuotedExprTy g ty = match tryAppTy g ty with ValueSome (_, [ty]) -> ty | _ -> failwith "destQuotedExprTy" +let destQuotedExprTy g ty = match tryAppTy g ty with ValueSome (_, [ty]) -> ty | _ -> failwith "destQuotedExprTy" -let mkQuotedExprTy (g: TcGlobals) ty = TType_app(g.expr_tcr, [ty]) +let mkQuotedExprTy (g: TcGlobals) ty = TType_app(g.expr_tcr, [ty]) -let mkRawQuotedExprTy (g: TcGlobals) = TType_app(g.raw_expr_tcr, []) +let mkRawQuotedExprTy (g: TcGlobals) = TType_app(g.raw_expr_tcr, []) let mkAnyTupledTy (g: TcGlobals) tupInfo tys = match tys with @@ -5588,9 +5588,9 @@ let rec tyOfExpr g e = | 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.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, _, _) @@ -5614,7 +5614,7 @@ let rec tyOfExpr g e = | 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.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.ValFieldSet _ | TOp.UnionCaseFieldSet _ | TOp.ExnFieldSet _ | TOp.LValueOp ((LSet | LByrefSet), _)) ->g.unit_ty @@ -5761,7 +5761,7 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = else let branchesToTargets = Array.create targets.Length [] // Build a map showing how each target might be reached - let rec accumulateTipsOfDecisionTree accBinds tree = + let rec accumulateTipsOfDecisionTree accBinds tree = match tree with | TDSwitch (_, cases, dflt, _) -> assert (isNil accBinds) // No switches under bindings @@ -5802,9 +5802,9 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = and rebuildDecisionTreeEdge (TCase(x, t)) = TCase(x, rebuildDecisionTree t) - let tree' = rebuildDecisionTree tree + let tree' = rebuildDecisionTree tree - /// rebuild the targets , replacing linear targets by ones that include all the 'let' bindings from the source + /// rebuild the targets, replacing linear targets by ones that include all the 'let' bindings from the source let targets' = targets |> Array.mapi (fun i (TTarget(vs, exprTarget, spTarget) as tg) -> if isLinearTgtIdx i then @@ -5833,7 +5833,7 @@ let rec simplifyTrivialMatch spBind exprm matchm ty tree (targets : _[]) = primMkMatch (spBind, exprm, tree, targets, matchm, ty) // Simplify a little as we go, including dead target elimination -let mkAndSimplifyMatch spBind exprm matchm ty tree targets = +let mkAndSimplifyMatch spBind exprm matchm ty tree targets = let targets = Array.ofList targets match tree with | TDSuccess _ -> @@ -5881,7 +5881,7 @@ let CanTakeAddressOf g m ty mut = // We can take the address of values of struct type even if the value is immutable // under certain conditions -// - all instances of the type are known to be immutable; OR +// - all instances of the type are known to be immutable; OR // - the operation is known not to mutate // // Note this may be taking the address of a closure field, i.e. a copy @@ -5922,7 +5922,7 @@ let MustTakeAddressOfRecdField (rfref: RecdField) = not rfref.IsStatic && rfref.IsMutable -let MustTakeAddressOfRecdFieldRef (rfref: RecdFieldRef) = MustTakeAddressOfRecdField rfref.RecdField +let MustTakeAddressOfRecdFieldRef (rfref: RecdFieldRef) = MustTakeAddressOfRecdField rfref.RecdField let CanTakeAddressOfRecdFieldRef (g: TcGlobals) m (rfref: RecdFieldRef) tinst mut = // We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields @@ -6002,7 +6002,7 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress let readonly = false // array address is never forced to be readonly let writeonly = false let shape = ILArrayShape.SingleDimensional - let ilInstrReadOnlyAnnotation = if isTyparTy g elemTy && useReadonlyForGenericArrayAddress then ReadonlyAddress else NormalAddress + let ilInstrReadOnlyAnnotation = if isTyparTy g elemTy && useReadonlyForGenericArrayAddress then ReadonlyAddress else NormalAddress let isNativePtr = match addrExprVal with | Some(vf) -> valRefEq g vf g.addrof2_vref @@ -6016,17 +6016,17 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress let readonly = false // array address is never forced to be readonly let writeonly = false let shape = ILArrayShape.FromRank args.Length - let ilInstrReadOnlyAnnotation = if isTyparTy g elemTy && useReadonlyForGenericArrayAddress then ReadonlyAddress else NormalAddress + let ilInstrReadOnlyAnnotation = if isTyparTy g elemTy && useReadonlyForGenericArrayAddress then ReadonlyAddress else NormalAddress let isNativePtr = match addrExprVal with | Some(vf) -> valRefEq g vf g.addrof2_vref | _ -> false - None, mkArrayElemAddress g (readonly, ilInstrReadOnlyAnnotation, isNativePtr, shape, elemTy, (aexpr:: args), m), readonly, writeonly + 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]". + // 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), _, _, _), _, _) - when (valRefEq g (mkLocalValRef vref) vref2) && + when (valRefEq g (mkLocalValRef vref) vref2) && (MustTakeAddressOfByrefGet g vref2 || CanTakeAddressOfByrefGet g vref2 mut) -> let ty = tyOfExpr g e let readonly = isInByrefTy g ty @@ -6111,7 +6111,7 @@ let mkArray (argty, args, m) = Expr.Op(TOp.Array, [argty], args, m) // Compute fixups for letrec's. // // Generate an assignment expression that will fixup the recursion -// amongst the vals on the r.h.s. of a letrec. The returned expressions +// amongst the vals on the r.h.s. of a letrec. The returned expressions // include disorderly constructs such as expressions/statements // to set closure environments and non-mutable fields. These are only ever // generated by the backend code-generator when processing a "letrec" @@ -6127,8 +6127,8 @@ let mkArray (argty, args, m) = Expr.Op(TOp.Array, [argty], args, m) // somehow appears twice on the right. //--------------------------------------------------------------------------- -let rec IterateRecursiveFixups g (selfv: Val option) rvs ((access: Expr), set) exprToFix = - let exprToFix = stripExpr exprToFix +let rec IterateRecursiveFixups g (selfv: Val option) rvs ((access: Expr), set) exprToFix = + let exprToFix = stripExpr exprToFix match exprToFix with | Expr.Const _ -> () | Expr.Op (TOp.Tuple tupInfo, argtys, args, m) when not (evalTupInfoIsStruct tupInfo) -> @@ -6183,24 +6183,24 @@ let JoinTyparStaticReq r1 r2 = //------------------------------------------------------------------------- type ExprFolder<'State> = - { exprIntercept : (* recurseF *) ('State -> Expr -> 'State) -> (* noInterceptF *) ('State -> Expr -> 'State) -> 'State -> Expr -> 'State + { exprIntercept : (* recurseF *) ('State -> Expr -> 'State) -> (* noInterceptF *) ('State -> Expr -> 'State) -> 'State -> Expr -> 'State // the bool is 'bound in dtree' - valBindingSiteIntercept : 'State -> bool * Val -> 'State + valBindingSiteIntercept : 'State -> bool * Val -> 'State // these values are always bound to these expressions. bool indicates 'recursively' - nonRecBindingsIntercept : 'State -> Binding -> 'State - recBindingsIntercept : 'State -> Bindings -> 'State - dtreeIntercept : 'State -> DecisionTree -> 'State - targetIntercept : (* recurseF *) ('State -> Expr -> 'State) -> 'State -> DecisionTreeTarget -> 'State option + nonRecBindingsIntercept : 'State -> Binding -> 'State + recBindingsIntercept : 'State -> Bindings -> 'State + dtreeIntercept : 'State -> DecisionTree -> 'State + targetIntercept : (* recurseF *) ('State -> Expr -> 'State) -> 'State -> DecisionTreeTarget -> 'State option tmethodIntercept : (* recurseF *) ('State -> Expr -> 'State) -> 'State -> ObjExprMethod -> 'State option } let ExprFolder0 = - { exprIntercept = (fun _recurseF noInterceptF z x -> noInterceptF z x) - valBindingSiteIntercept = (fun z _b -> z) - nonRecBindingsIntercept = (fun z _bs -> z) - recBindingsIntercept = (fun z _bs -> z) - dtreeIntercept = (fun z _dt -> z) - targetIntercept = (fun _exprF _z _x -> None) + { exprIntercept = (fun _recurseF noInterceptF z x -> noInterceptF z x) + valBindingSiteIntercept = (fun z _b -> z) + nonRecBindingsIntercept = (fun z _bs -> z) + recBindingsIntercept = (fun z _bs -> z) + dtreeIntercept = (fun z _dt -> z) + targetIntercept = (fun _exprF _z _x -> None) tmethodIntercept = (fun _exprF _z _x -> None) } //------------------------------------------------------------------------- @@ -6223,7 +6223,7 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = and exprNoInterceptF (z: 'State) (x: Expr) = match x with - | Expr.Const _ -> z + | Expr.Const _ -> z | Expr.Val _ -> z @@ -6235,11 +6235,11 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = | Expr.Op (_c, _tyargs, args, _) -> exprsF z args - | Expr.Sequential (x0, x1, _dir, _, _) -> + | Expr.Sequential (x0, x1, _dir, _, _) -> 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) -> @@ -6256,26 +6256,26 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = let z = valBindsF false z binds exprF z body - | Expr.Let (bind, body, _, _) -> + | Expr.Let (bind, body, _, _) -> let z = valBindF false z bind exprF z body | Expr.Link rX -> exprF z (!rX) - | Expr.Match (_spBind, _exprm, dtree, targets, _m, _ty) -> + | Expr.Match (_spBind, _exprm, dtree, targets, _m, _ty) -> let z = dtreeF z dtree let z = Array.fold targetF z targets.[0..targets.Length - 2] // 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, _) -> exprF z e - | Expr.Obj (_n, _typ, _basev, basecall, overrides, iimpls, _m) -> + | Expr.Obj (_n, _typ, _basev, basecall, overrides, iimpls, _m) -> let z = exprF z basecall let z = List.fold tmethodF z overrides List.fold (foldOn snd (List.fold tmethodF)) z iimpls @@ -6298,10 +6298,10 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = and dtreeF z dtree = let z = folders.dtreeIntercept z dtree match dtree with - | TDBind (bind, rest) -> + | TDBind (bind, rest) -> let z = valBindF true z bind dtreeF z rest - | TDSuccess (args, _) -> exprsF z args + | TDSuccess (args, _) -> exprsF z args | TDSwitch (test, dcases, dflt, _) -> let z = exprF z test let z = List.fold dcaseF z dcases @@ -6309,7 +6309,7 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = z and dcaseF z = function - TCase (_, dtree) -> dtreeF z dtree (* not collecting from test *) + TCase (_, dtree) -> dtreeF z dtree (* not collecting from test *) and targetF z x = match folders.targetIntercept exprFClosure z x with @@ -6349,10 +6349,12 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = do exprFClosure <- exprF // allocate one instance of this closure do exprNoInterceptFClosure <- exprNoInterceptF // allocate one instance of this closure + member x.FoldExpr = exprF + member x.FoldImplFile = implF -let FoldExpr folders state expr = ExprFolders(folders).FoldExpr state expr +let FoldExpr folders state expr = ExprFolders(folders).FoldExpr state expr let FoldImplFile folders state implFile = ExprFolders(folders).FoldImplFile state implFile @@ -6369,7 +6371,7 @@ let ExprStats x = #endif //------------------------------------------------------------------------- -// +// Make expressions //------------------------------------------------------------------------- let mkString (g: TcGlobals) m n = Expr.Const(Const.String n, m, g.string_ty) @@ -6386,17 +6388,17 @@ let mkFalse g m = mkBool g m false 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 +let mkZero g m = mkInt g m 0 -let mkOne g m = mkInt g m 1 +let mkOne g m = mkInt g m 1 -let mkTwo g m = mkInt g m 2 +let mkTwo g m = mkInt g m 2 -let mkMinusOne g m = mkInt g m (-1) +let mkMinusOne g m = mkInt g m (-1) let destInt32 = function Expr.Const(Const.Int32 n, _, _) -> Some n | _ -> None @@ -6405,7 +6407,7 @@ let isIDelegateEventType g ty = | ValueSome tcref -> tyconRefEq g g.fslib_IDelegateEvent_tcr tcref | _ -> false -let destIDelegateEventType g ty = +let destIDelegateEventType g ty = if isIDelegateEventType g ty then match argsOfAppTy g ty with | [ty1] -> ty1 @@ -6472,14 +6474,14 @@ let rec existsR a b pred = if a<=b then pred a || existsR (a+1) b pred else fals // Given a permutation for record fields, work out the highest entry that we must lift out // of a record initialization. Lift out xi if xi goes to position that will be preceded by an expr with an effect -// that originally followed xi. If one entry gets lifted then everything before it also gets lifted. +// that originally followed xi. If one entry gets lifted then everything before it also gets lifted. let liftAllBefore sigma = let invSigma = inversePerm sigma let lifted = [ for i in 0 .. sigma.Length - 1 do let i' = sigma.[i] - if existsR 0 (i' - 1) (fun j' -> invSigma.[j'] > i) then + if existsR 0 (i' - 1) (fun j' -> invSigma.[j'] > i) then yield i ] if lifted.IsEmpty then 0 else List.max lifted + 1 @@ -6502,12 +6504,12 @@ let permuteExprList (sigma: int[]) (exprs: Expr list) (ty: TType list) (names: s let newExprs, reversedBinds = List.mapFold rewrite [] (exprs |> List.indexed) let binds = List.rev reversedBinds - let reorderedExprs = permute sigma (Array.ofList newExprs) + let reorderedExprs = permute sigma (Array.ofList newExprs) binds, Array.toList reorderedExprs /// Evaluate the expressions in the original order, but build a record with the results in field order /// Note some fields may be static. If this were not the case we could just use -/// let sigma = Array.map #Index () +/// let sigma = Array.map #Index () /// However the presence of static fields means .Index may index into a non-compact set of instance field indexes. /// We still need to sort by index. let mkRecordExpr g (lnk, tcref, tinst, rfrefs: RecdFieldRef list, args, m) = @@ -6519,19 +6521,18 @@ let mkRecordExpr g (lnk, tcref, tinst, rfrefs: RecdFieldRef list, args, m) = let sigma = Array.create rfrefsArray.Length -1 Array.iteri (fun j (i, _) -> if sigma.[i] <> -1 then error(InternalError("bad permutation", m)) - sigma.[i] <- j) rfrefsArray + sigma.[i] <- j) rfrefsArray - let argTys = List.map (fun rfref -> actualTyOfRecdFieldRef rfref tinst) rfrefs + 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 + let binds, args = permuteExprList sigma args argTys names mkLetsBind m binds (Expr.Op (TOp.Recd(lnk, tcref), tinst, args, m)) - //------------------------------------------------------------------------- // List builders //------------------------------------------------------------------------- -let mkRefCell g m ty e = mkRecordExpr g (RecdExpr, g.refcell_tcr_canon, [ty], [mkRefCellContentsRef g], [e], m) +let mkRefCell g m ty e = mkRecordExpr g (RecdExpr, g.refcell_tcr_canon, [ty], [mkRefCellContentsRef g], [e], m) let mkRefCellGet g m ty e = mkRecdFieldGetViaExprAddr (e, mkRefCellContentsRef g, [ty], m) @@ -6583,7 +6584,7 @@ let mkInitializeArrayMethSpec (g: TcGlobals) = let tref = g.FindSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers" mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy tref, "InitializeArray", [g.ilg.typ_Array;g.iltyp_RuntimeFieldHandle], ILType.Void) -let mkInvalidCastExnNewobj (g: TcGlobals) = +let mkInvalidCastExnNewobj (g: TcGlobals) = mkNormalNewobj (mkILCtorMethSpecForTy (mkILNonGenericBoxedTy (g.FindSysILTypeRef "System.InvalidCastException"), [])) @@ -6794,7 +6795,7 @@ let mkCallSeqFinally g m elemTy arg1 arg2 = mkApps g (typedExprForIntrinsic g m g.seq_finally_info, [[elemTy]], [ arg1; arg2 ], m) let mkCallSeqOfFunctions g m ty1 ty2 arg1 arg2 arg3 = - mkApps g (typedExprForIntrinsic g m g.seq_of_functions_info, [[ty1;ty2]], [ arg1; arg2; arg3 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_of_functions_info, [[ty1;ty2]], [ arg1; arg2; arg3 ], m) let mkCallSeqToArray g m elemTy arg1 = mkApps g (typedExprForIntrinsic g m g.seq_to_array_info, [[elemTy]], [ arg1 ], m) @@ -6827,9 +6828,9 @@ let mkCallLiftValueWithName (g: TcGlobals) m ty nm e1 = // Use "Expr.ValueWithName" if it exists in FSharp.Core match vref.TryDeref with | ValueSome _ -> - mkApps g (typedExprForIntrinsic g m g.lift_value_with_name_info , [[ty]], [mkRefTupledNoTypes g m [e1; mkString g m nm]], m) + mkApps g (typedExprForIntrinsic g m g.lift_value_with_name_info, [[ty]], [mkRefTupledNoTypes g m [e1; mkString g m nm]], m) | ValueNone -> - mkApps g (typedExprForIntrinsic g m g.lift_value_info , [[ty]], [e1], m) + mkApps g (typedExprForIntrinsic g m g.lift_value_info, [[ty]], [e1], m) let mkCallLiftValueWithDefn g m qty e1 = assert isQuotedExprTy g qty @@ -6840,7 +6841,7 @@ let mkCallLiftValueWithDefn g m qty e1 = | ValueSome _ -> let copyOfExpr = copyExpr g ValCopyFlag.CloneAll e1 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) + 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) @@ -6848,13 +6849,13 @@ let mkCallCheckThis g m ty e1 = mkApps g (typedExprForIntrinsic g m g.check_this_info, [[ty]], [e1], m) let mkCallFailInit g m = - mkApps g (typedExprForIntrinsic g m g.fail_init_info , [], [mkUnit g m], m) + mkApps g (typedExprForIntrinsic g m g.fail_init_info, [], [mkUnit g m], m) let mkCallFailStaticInit g m = - mkApps g (typedExprForIntrinsic g m g.fail_static_init_info , [], [mkUnit g m], m) + mkApps g (typedExprForIntrinsic g m g.fail_static_init_info, [], [mkUnit g m], m) let mkCallQuoteToLinqLambdaExpression g m ty e1 = - mkApps g (typedExprForIntrinsic g m g.quote_to_linq_lambda_info , [[ty]], [e1], m) + mkApps g (typedExprForIntrinsic g m g.quote_to_linq_lambda_info, [[ty]], [e1], m) let mkLazyDelayed g m ty f = mkApps g (typedExprForIntrinsic g m g.lazy_create_info, [[ty]], [ f ], m) @@ -6891,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 @@ -6908,9 +6909,9 @@ let mkLdelem (_g: TcGlobals) m ty arre idxe = mkAsmExpr ([ IL.I_ldelem_any (ILAr // It is understood by the quotation processor and turned into "Equality" nodes. // // Note: this is IL assembly code, don't go inserting this in expressions which will be exposed via quotations -let mkILAsmCeq (g: TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_ceq ], [], [e1; e2], [g.bool_ty], m) +let mkILAsmCeq (g: TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_ceq ], [], [e1; e2], [g.bool_ty], m) -let mkILAsmClt (g: TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_clt ], [], [e1; e2], [g.bool_ty], m) +let mkILAsmClt (g: TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_clt ], [], [e1; e2], [g.bool_ty], m) // This is generated in the initialization of the "ctorv" field in the typechecker's compilation of // an implicit class construction. @@ -6933,15 +6934,15 @@ let mkReraise m returnTy = Expr.Op (TOp.Reraise, [returnTy], [], m) (* could sup // CompilationMappingAttribute, SourceConstructFlags //---------------------------------------------------------------------------- -let tnameCompilationSourceNameAttr = FSharpLib.Core + ".CompilationSourceNameAttribute" +let tnameCompilationSourceNameAttr = FSharpLib.Core + ".CompilationSourceNameAttribute" let tnameCompilationArgumentCountsAttr = FSharpLib.Core + ".CompilationArgumentCountsAttribute" -let tnameCompilationMappingAttr = FSharpLib.Core + ".CompilationMappingAttribute" -let tnameSourceConstructFlags = FSharpLib.Core + ".SourceConstructFlags" +let tnameCompilationMappingAttr = FSharpLib.Core + ".CompilationMappingAttribute" +let tnameSourceConstructFlags = FSharpLib.Core + ".SourceConstructFlags" let tref_CompilationArgumentCountsAttr (g: TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationArgumentCountsAttr) -let tref_CompilationMappingAttr (g: TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationMappingAttr) -let tref_CompilationSourceNameAttr (g: TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationSourceNameAttr) -let tref_SourceConstructFlags (g: TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameSourceConstructFlags) +let tref_CompilationMappingAttr (g: TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationMappingAttr) +let tref_CompilationSourceNameAttr (g: TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationSourceNameAttr) +let tref_SourceConstructFlags (g: TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameSourceConstructFlags) let mkCompilationMappingAttrPrim (g: TcGlobals) k nums = mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, @@ -6961,7 +6962,7 @@ let mkCompilationArgumentCountsAttr (g: TcGlobals) nums = []) let mkCompilationSourceNameAttr (g: TcGlobals) n = - mkILCustomAttribute g.ilg (tref_CompilationSourceNameAttr g, [ g.ilg.typ_String ], + mkILCustomAttribute g.ilg (tref_CompilationSourceNameAttr g, [ g.ilg.typ_String ], [ILAttribElem.String(Some n)], []) @@ -7003,7 +7004,7 @@ let tnames_SignatureDataVersionAttr = splitILTypeName tname_SignatureDataVersion let tref_SignatureDataVersionAttr () = mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), tname_SignatureDataVersionAttr) -let mkSignatureDataVersionAttr (g: TcGlobals) ((v1, v2, v3, _) : ILVersionInfo) = +let mkSignatureDataVersionAttr (g: TcGlobals) ((v1, v2, v3, _) : ILVersionInfo) = mkILCustomAttribute g.ilg (tref_SignatureDataVersionAttr(), [g.ilg.typ_Int32;g.ilg.typ_Int32;g.ilg.typ_Int32], @@ -7018,8 +7019,8 @@ let IsSignatureDataVersionAttr cattr = isILAttribByName ([], tname_SignatureData let TryFindAutoOpenAttr (ilg: IL.ILGlobals) cattr = if isILAttribByName ([], tname_AutoOpenAttr) cattr then match decodeILAttribData ilg cattr with - | [ILAttribElem.String s], _ -> s - | [], _ -> None + | [ILAttribElem.String s], _ -> s + | [], _ -> None | _ -> warning(Failure(FSComp.SR.tastUnexpectedDecodeOfAutoOpenAttribute())) None @@ -7031,18 +7032,18 @@ let tname_InternalsVisibleToAttr = "System.Runtime.CompilerServices.InternalsVis let TryFindInternalsVisibleToAttr ilg cattr = if isILAttribByName ([], tname_InternalsVisibleToAttr) cattr then match decodeILAttribData ilg cattr with - | [ILAttribElem.String s], _ -> s - | [], _ -> None + | [ILAttribElem.String s], _ -> s + | [], _ -> None | _ -> warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInternalsVisibleToAttribute())) None else None -let IsMatchingSignatureDataVersionAttr ilg ((v1, v2, v3, _) : ILVersionInfo) cattr = +let IsMatchingSignatureDataVersionAttr ilg ((v1, v2, v3, _) : ILVersionInfo) cattr = IsSignatureDataVersionAttr cattr && match decodeILAttribData ilg cattr with - | [ILAttribElem.Int32 u1; ILAttribElem.Int32 u2;ILAttribElem.Int32 u3 ], _ -> + | [ILAttribElem.Int32 u1; ILAttribElem.Int32 u2;ILAttribElem.Int32 u3 ], _ -> (v1 = uint16 u1) && (v2 = uint16 u2) && (v3 = uint16 u3) | _ -> warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInterfaceDataVersionAttribute())) @@ -7054,7 +7055,7 @@ let mkCompilerGeneratedAttr (g: TcGlobals) n = //-------------------------------------------------------------------------- // tupled lambda --> method/function with a given topValInfo specification. // -// AdjustArityOfLambdaBody: "(vs, body)" represents a lambda "fun (vs) -> body". The +// AdjustArityOfLambdaBody: "(vs, body)" represents a lambda "fun (vs) -> body". The // aim is to produce a "static method" represented by a pair // "(mvs, body)" where mvs has the List.length "arity". //-------------------------------------------------------------------------- @@ -7063,7 +7064,7 @@ let untupledToRefTupled g vs = let untupledTys = typesOfVals vs let m = (List.head vs).Range let tupledv, tuplede = mkCompGenLocal m "tupledArg" (mkRefTupledTy g untupledTys) - let untupling_es = List.mapi (fun i _ -> mkTupleFieldGet g (tupInfoRef, tuplede, untupledTys, i, m)) untupledTys + let untupling_es = List.mapi (fun i _ -> mkTupleFieldGet g (tupInfoRef, tuplede, untupledTys, i, m)) untupledTys // These are non-sticky - at the caller,any sequence point for 'body' goes on 'body' _after_ the binding has been made tupledv, mkInvisibleLets m vs untupling_es @@ -7080,7 +7081,7 @@ let AdjustArityOfLambdaBody g arity (vs: Val list) body = elif nvs = 1 then let v = vs.Head let untupledTys = destRefTupleTy g v.Type - if (untupledTys.Length <> arity) then failwith "length untupledTys <> arity" + if (untupledTys.Length <> arity) then failwith "length untupledTys <> arity" let dummyvs, dummyes = untupledTys |> List.mapi (fun i ty -> mkCompGenLocal v.Range (v.LogicalName + "_" + string i) ty) @@ -7089,7 +7090,7 @@ let AdjustArityOfLambdaBody g arity (vs: Val list) body = let body = mkInvisibleLet v.Range v (mkRefTupled g v.Range dummyes untupledTys) body dummyvs, body else - let tupledv, untupler = untupledToRefTupled g vs + let tupledv, untupler = untupledToRefTupled g vs [tupledv], untupler body let MultiLambdaToTupledLambda g vs body = @@ -7097,7 +7098,7 @@ let MultiLambdaToTupledLambda g vs body = | [] -> failwith "MultiLambdaToTupledLambda: expected some argments" | [v] -> v, body | vs -> - let tupledv, untupler = untupledToRefTupled g vs + let tupledv, untupler = untupledToRefTupled g vs tupledv, untupler body let (|RefTuple|_|) expr = @@ -7110,14 +7111,14 @@ let MultiLambdaToTupledLambdaIfNeeded g (vs, arg) body = | [], _ -> failwith "MultiLambdaToTupledLambda: expected some argments" | [v], _ -> [(v, arg)], body | vs, RefTuple args when args.Length = vs.Length -> List.zip vs args, body - | vs, _ -> - let tupledv, untupler = untupledToRefTupled g vs + | vs, _ -> + let tupledv, untupler = untupledToRefTupled g vs [(tupledv, arg)], untupler body //-------------------------------------------------------------------------- // Beta reduction via let-bindings. Reduce immediate apps. of lambdas to let bindings. // Includes binding the immediate application of generic -// functions. Input type is the type of the function. Makes use of the invariant +// functions. Input type is the type of the function. Makes use of the invariant // that any two expressions have distinct local variables (because we explicitly copy // expressions). //------------------------------------------------------------------------ @@ -7159,7 +7160,7 @@ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl: TType list list, arg // VALID: // (fun a b -> E[a, b]) t1 t2 ---> let a = t1 in let b = t2 in E[t1, t2] // INVALID: - // (fun a -> E[a]) t1 t2 ---> let a = t1 in E[a] t2 UNLESS: E[a] has no effects OR t2 has no effects + // (fun a -> E[a]) t1 t2 ---> let a = t1 in E[a] t2 UNLESS: E[a] has no effects OR t2 has no effects match tryStripLambdaN argsl.Length f with | Some (argvsl, body) -> @@ -7222,7 +7223,7 @@ let stripTupledFunTy g ty = let (|ExprValWithPossibleTypeInst|_|) expr = match expr with - | Expr.App (Expr.Val (vref, flags, m), _fty, tyargs, [], _) -> + | Expr.App (Expr.Val (vref, flags, m), _fty, tyargs, [], _) -> Some (vref, flags, tyargs, m) | Expr.Val (vref, flags, m) -> Some (vref, flags, [], m) @@ -7265,7 +7266,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex match expr with | Expr.Op (TOp.Coerce, [inputTy;actualTy], [exprWithActualTy], m) when - isFunTy g actualTy && isFunTy g inputTy -> + isFunTy g actualTy && isFunTy g inputTy -> if typeEquiv g actualTy inputTy then Some(exprWithActualTy, suppliedArgs) @@ -7344,7 +7345,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex mkRefTupled g appm ((actualTys, argTys) ||> List.mapi2 (fun i actualTy dummyTy -> let argExprElement = mkTupleFieldGet g (tupInfoRef, tupleVar, argTys, i, appm) - mkCoerceIfNeeded g actualTy dummyTy argExprElement)) + mkCoerceIfNeeded g actualTy dummyTy argExprElement)) actualTys /// Given an argument that has a tuple type that satisfies the input argument types, @@ -7352,7 +7353,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex let CoerceTupled niceNames (argExpr: Expr) (actualTys: TType list) = let argExprTy = (tyOfExpr g argExpr) - let argTys = + let argTys = match actualTys with | [_] -> [tyOfExpr g argExpr] @@ -7374,7 +7375,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex let binderBuilder = (fun tm -> mkCompGenLet appm v argExpr tm) let expr = match actualTys, argTys with - | [actualTy], [argTy] -> mkCoerceIfNeeded g actualTy argTy ve + | [actualTy], [argTy] -> mkCoerceIfNeeded g actualTy argTy ve | _ -> CoerceBoundTuple ve argTys actualTys binderBuilder, expr @@ -7383,7 +7384,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex (fun tm -> tm), argExpr else - let detupledArgs, argTys = + let detupledArgs, argTys = match actualTys with | [_actualType] -> [argExpr], [tyOfExpr g argExpr] @@ -7397,7 +7398,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex // for // let f (x, y) = 1 // and we're not building lambdas, just coerce the arguments in place - if detupledArgs.Length = actualTys.Length then + if detupledArgs.Length = actualTys.Length then (fun tm -> tm), CoerceDetupled argTys detupledArgs actualTys else // In this case there is a tuple mismatch. @@ -7429,7 +7430,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex assert (inpArgTys.Length = actualArgTys.Length) - let inpsAsVars, inpsAsExprs = inpArgTys |> List.mapi (fun j ty -> mkCompGenLocal appm ("arg" + string i + string j) ty) |> List.unzip + let inpsAsVars, inpsAsExprs = inpArgTys |> List.mapi (fun j ty -> mkCompGenLocal appm ("arg" + string i + string j) ty) |> List.unzip let inpsAsActualArg = CoerceDetupled inpArgTys inpsAsExprs actualArgTys let inpCloVarType = (mkFunTy (mkRefTupledTy g actualArgTys) cloVar.Type) let newResTy = mkFunTy inpArgTy resTy @@ -7481,7 +7482,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex let lambdaBuilder = (fun tm -> tm) lambdaBuilder, binderBuilder, inpsAsActualArg | None -> - let inpsAsVars, inpsAsExprs = (niceNames, inpArgTys) ||> List.map2 (fun nm ty -> mkCompGenLocal appm nm ty) |> List.unzip + let inpsAsVars, inpsAsExprs = (niceNames, inpArgTys) ||> List.map2 (fun nm ty -> mkCompGenLocal appm nm ty) |> List.unzip let inpsAsActualArg = CoerceDetupled inpArgTys inpsAsExprs actualArgTys let lambdaBuilder = (fun tm -> mkMultiLambda appm inpsAsVars (tm, tyOfExpr g tm)) let binderBuilder = (fun tm -> tm) @@ -7518,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 | _ -> @@ -7535,7 +7536,7 @@ let NormalizeAndAdjustPossibleSubsumptionExprs g inputExpr = //--------------------------------------------------------------------------- -// LinearizeTopMatch - when only one non-failing target, make linear. The full +// LinearizeTopMatch - when only one non-failing target, make linear. The full // complexity of this is only used for spectacularly rare bindings such as // type ('a, 'b) either = This of 'a | That of 'b // let this_f1 = This (fun x -> x) @@ -7560,18 +7561,18 @@ let AdjustValToTopVal (tmp: Val) parent valData = /// tree, T0(v0, .., vN) => rhs ; T1() => fail ; ... /// Convert it to bind T0's variables, then continue with T0's rhs: /// let tmp = switch tree, TO(fv0, ..., fvN) => Tup (fv0, ..., fvN) ; T1() => fail; ... -/// let v1 = #1 tmp in ... -/// and vN = #N tmp +/// let v1 = #1 tmp in ... +/// and vN = #N tmp /// rhs /// Motivation: /// - For top-level let bindings with possibly failing matches, /// this makes clear that subsequent bindings (if reached) are top-level ones. -let LinearizeTopMatchAux g parent (spBind, m, tree, targets, m2, ty) = +let LinearizeTopMatchAux g parent (spBind, m, tree, targets, m2, ty) = let targetsL = Array.toList targets (* items* package up 0, 1, more items *) let itemsProj tys i x = match tys with - | [] -> failwith "itemsProj: no items?" + | [] -> failwith "itemsProj: no items?" | [_] -> x (* no projection needed *) | tys -> Expr.Op (TOp.TupleFieldGet(tupInfoRef, i), tys, [x], m) let isThrowingTarget = function TTarget(_, x, _) -> isThrow x @@ -7579,30 +7580,30 @@ let LinearizeTopMatchAux g parent (spBind, m, tree, targets, m2, ty) = (* Have failing targets and ONE successful one, so linearize *) let (TTarget (vs, rhs, spTarget)) = Option.get (List.tryFind (isThrowingTarget >> not) targetsL) (* note - old code here used copy value to generate locals - this was not right *) - let fvs = vs |> List.map (fun v -> fst(mkLocal v.Range v.LogicalName v.Type)) (* fresh *) - let vtys = vs |> List.map (fun v -> v.Type) - let tmpTy = mkRefTupledVarsTy g vs + let fvs = vs |> List.map (fun v -> fst(mkLocal v.Range v.LogicalName v.Type)) (* fresh *) + let vtys = vs |> List.map (fun v -> v.Type) + let tmpTy = mkRefTupledVarsTy g vs let tmp, tmpe = mkCompGenLocal m "matchResultHolder" tmpTy AdjustValToTopVal tmp parent ValReprInfo.emptyValData - let newTg = TTarget (fvs, mkRefTupledVars g m fvs, spTarget) + let newTg = TTarget (fvs, mkRefTupledVars g m fvs, spTarget) let fixup (TTarget (tvs, tx, spTarget)) = match destThrow tx with | Some (m, _, e) -> let tx = mkThrow m tmpTy e TTarget(tvs, tx, spTarget) (* Throwing targets, recast it's "return type" *) - | None -> newTg (* Non-throwing target, replaced [new/old] *) + | None -> newTg (* Non-throwing target, replaced [new/old] *) - let targets = Array.map fixup targets - let binds = + let targets = Array.map fixup targets + let binds = vs |> List.mapi (fun i v -> let ty = v.Type - let rhs = etaExpandTypeLambda g m v.Typars (itemsProj vtys i tmpe, ty) + let rhs = etaExpandTypeLambda g m v.Typars (itemsProj vtys i tmpe, ty) // update the arity of the value v.SetValReprInfo (Some (InferArityOfExpr g AllowTypeDirectedDetupling.Yes ty [] [] rhs)) // This binding is deliberately non-sticky - any sequence point for 'rhs' goes on 'rhs' _after_ the binding has been evaluated - mkInvisibleBind v rhs) in (* vi = proj tmp *) + mkInvisibleBind v rhs) in (* vi = proj tmp *) mkCompGenLet m tmp (primMkMatch (spBind, m, tree, targets, m2, tmpTy)) (* note, probably retyped match, but note, result still has same type *) (mkLetsFromBindings m binds rhs) @@ -7620,8 +7621,8 @@ let LinearizeTopMatch g parent = function //--------------------------------------------------------------------------- -let commaEncs strs = String.concat "," strs -let angleEnc str = "{" + str + "}" +let commaEncs strs = String.concat "," strs +let angleEnc str = "{" + str + "}" let ticksAndArgCountTextOfTyconRef (tcref: TyconRef) = // Generic type names are (name + "`" + digits) where name does not contain "`". let path = Array.toList (fullMangledPathToTyconRef tcref) @ [tcref.CompiledName] @@ -7629,12 +7630,14 @@ let ticksAndArgCountTextOfTyconRef (tcref: TyconRef) = let typarEnc _g (gtpsType, gtpsMethod) typar = match List.tryFindIndex (typarEq typar) gtpsType with - | Some idx -> "`" + string idx // single-tick-index for typar from type - | None -> + | Some idx -> "`" + string idx // single-tick-index for typar from type + | None -> match List.tryFindIndex (typarEq typar) gtpsMethod with - | Some idx -> "``" + string idx // double-tick-index for typar from method - | None -> warning(InternalError("Typar not found during XmlDoc generation", typar.Range)) - "``0" // REVIEW: this should be ERROR not WARNING? + | Some idx -> + "``" + string idx // double-tick-index for typar from method + | None -> + warning(InternalError("Typar not found during XmlDoc generation", typar.Range)) + "``0" let rec typeEnc g (gtpsType, gtpsMethod) ty = if verbose then dprintf "--> typeEnc" @@ -7643,16 +7646,11 @@ let rec typeEnc g (gtpsType, gtpsMethod) ty = | TType_forall _ -> "Microsoft.FSharp.Core.FSharpTypeFunc" - | _ when isArrayTy g ty -> + | _ when isArrayTy g ty -> let tcref, tinst = destAppTy g ty let arraySuffix = match rankOfArrayTyconRef g tcref with - // The easy case | 1 -> "[]" - // REVIEW - // In fact IL supports 3 kinds of multidimensional arrays, and each kind of array has its own xmldoc spec. - // We don't support all these, and instead always pull xmldocs for 0-based-arbitrary-length ("0:") multidimensional arrays. - // This is probably the 99% case anyway. | 2 -> "[0:, 0:]" | 3 -> "[0:, 0:, 0:]" | 4 -> "[0:, 0:, 0:, 0:]" @@ -7660,7 +7658,7 @@ let rec typeEnc g (gtpsType, gtpsMethod) ty = typeEnc g (gtpsType, gtpsMethod) (List.head tinst) + arraySuffix | TType_ucase (UCRef(tcref, _), tinst) - | TType_app (tcref, tinst) -> + | TType_app (tcref, tinst) -> if tyconRefEq g g.byref_tcr tcref then typeEnc g (gtpsType, gtpsMethod) (List.head tinst) + "@" elif tyconRefEq g tcref g.nativeptr_tcr then @@ -7669,12 +7667,14 @@ let rec typeEnc g (gtpsType, gtpsMethod) ty = let tyName = let ty = stripTyEqnsAndMeasureEqns g ty match ty with - | TType_app (tcref, _tinst) -> + | TType_app (tcref, _tinst) -> // Generic type names are (name + "`" + digits) where name does not contain "`". // In XML doc, when used in type instances, these do not use the ticks. let path = Array.toList (fullMangledPathToTyconRef tcref) @ [tcref.CompiledName] textOfPath (List.map DemangleGenericTypeName path) - | _ -> assert(false); failwith "impossible" + | _ -> + assert false + failwith "impossible" tyName + tyargsEnc g (gtpsType, gtpsMethod) tinst | TType_anon (anonInfo, tinst) -> @@ -7686,10 +7686,10 @@ let rec typeEnc g (gtpsType, gtpsMethod) ty = else sprintf "System.Tuple%s"(tyargsEnc g (gtpsType, gtpsMethod) tys) - | TType_fun (f, x) -> + | TType_fun (f, x) -> "Microsoft.FSharp.Core.FSharpFunc" + tyargsEnc g (gtpsType, gtpsMethod) [f;x] - | TType_var typar -> + | TType_var typar -> typarEnc g (gtpsType, gtpsMethod) typar | TType_measure _ -> "?" @@ -7743,7 +7743,7 @@ let XmlDocSigOfVal g path (v: Val) = let tps, argInfos, _, _ = GetTopValTypeInCompiledForm g w v.Type v.Range let name = v.CompiledName let prefix = - if w.NumCurriedArgs = 0 && isNil tps then "P:" + if w.NumCurriedArgs = 0 && isNil tps then "P:" else "M:" [], tps, argInfos, prefix, path, name let argTs = argInfos |> List.concat |> List.map fst @@ -7752,17 +7752,17 @@ let XmlDocSigOfVal g path (v: Val) = let genArity = if arity=0 then "" else sprintf "``%d" arity prefix + prependPath path name + genArity + args -let BuildXmlDocSig prefix paths = prefix + List.fold prependPath "" paths +let BuildXmlDocSig prefix paths = prefix + List.fold prependPath "" paths let XmlDocSigOfUnionCase = BuildXmlDocSig "T:" // Would like to use "U:", but ParseMemberSignature only accepts C# signatures -let XmlDocSigOfField = BuildXmlDocSig "F:" +let XmlDocSigOfField = BuildXmlDocSig "F:" -let XmlDocSigOfProperty = BuildXmlDocSig "P:" +let XmlDocSigOfProperty = BuildXmlDocSig "P:" -let XmlDocSigOfTycon = BuildXmlDocSig "T:" +let XmlDocSigOfTycon = BuildXmlDocSig "T:" -let XmlDocSigOfSubModul = BuildXmlDocSig "T:" +let XmlDocSigOfSubModul = BuildXmlDocSig "T:" let XmlDocSigOfEntity (eref: EntityRef) = XmlDocSigOfTycon [(buildAccessPath eref.CompilationPathOpt); eref.Deref.CompiledName] @@ -7772,14 +7772,14 @@ let XmlDocSigOfEntity (eref: EntityRef) = //-------------------------------------------------------------------------- -let enum_CompilationRepresentationAttribute_Static = 0b0000000000000001 -let enum_CompilationRepresentationAttribute_Instance = 0b0000000000000010 +let enum_CompilationRepresentationAttribute_Static = 0b0000000000000001 +let enum_CompilationRepresentationAttribute_Instance = 0b0000000000000010 let enum_CompilationRepresentationAttribute_StaticInstanceMask = 0b0000000000000011 -let enum_CompilationRepresentationAttribute_ModuleSuffix = 0b0000000000000100 -let enum_CompilationRepresentationAttribute_PermitNull = 0b0000000000001000 +let enum_CompilationRepresentationAttribute_ModuleSuffix = 0b0000000000000100 +let enum_CompilationRepresentationAttribute_PermitNull = 0b0000000000001000 let HasUseNullAsTrueValueAttribute g attribs = - match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attribs with + match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attribs with | Some(flags) -> ((flags &&& enum_CompilationRepresentationAttribute_PermitNull) <> 0) | _ -> false @@ -7917,7 +7917,7 @@ let mkIsInstConditional g m tgty vinpe v e2 e3 = let tg3 = mbuilder.AddResultTarget(e3, SuppressSequencePointAtTarget) let dtree = TDSwitch(exprForVal m v, [TCase(DecisionTreeTest.IsNull, tg3)], Some tg2, m) let expr = mbuilder.Close(dtree, m, tyOfExpr g e2) - mkCompGenLet m v (mkIsInst tgty vinpe m) expr + mkCompGenLet m v (mkIsInst tgty vinpe m) expr else let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m) @@ -7939,7 +7939,7 @@ let mkNullTest g m e1 e2 e3 = let dtree = TDSwitch(e1, [TCase(DecisionTreeTest.IsNull, tg3)], Some tg2, m) let expr = mbuilder.Close(dtree, m, tyOfExpr g e2) expr -let mkNonNullTest (g: TcGlobals) m e = mkAsmExpr ([ IL.AI_ldnull ; IL.AI_cgt_un ], [], [e], [g.bool_ty], m) +let mkNonNullTest (g: TcGlobals) m e = mkAsmExpr ([ IL.AI_ldnull ; IL.AI_cgt_un ], [], [e], [g.bool_ty], m) let mkNonNullCond g m ty e1 e2 e3 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m ty (mkNonNullTest g m e1) e2 e3 let mkIfThen (g: TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.unit_ty e1 e2 (mkUnit g m) @@ -8004,7 +8004,7 @@ let ValSpecIsCompiledAsInstance g (v: Val) = // These only differ if the value is an extension member, and in that case MemberIsCompiledAsInstance always returns // false anyway MemberIsCompiledAsInstance g v.MemberApparentEntity v.IsExtensionMember membInfo v.Attribs - | _ -> false + | _ -> false let ValRefIsCompiledAsInstanceMember g (vref: ValRef) = ValSpecIsCompiledAsInstance g vref.Deref @@ -8022,14 +8022,14 @@ let GetMemberCallInfo g (vref: ValRef, vFlags) = membInfo.MemberFlags.IsDispatchSlot) && not membInfo.MemberFlags.IsFinal && (match vFlags with VSlotDirectCall -> false | _ -> true) - let isNewObj = (membInfo.MemberFlags.MemberKind = MemberKind.Constructor) && (match vFlags with NormalValUse -> true | _ -> false) + let isNewObj = (membInfo.MemberFlags.MemberKind = MemberKind.Constructor) && (match vFlags with NormalValUse -> true | _ -> false) let isSuperInit = (membInfo.MemberFlags.MemberKind = MemberKind.Constructor) && (match vFlags with CtorValUsedAsSuperInit -> true | _ -> false) - let isSelfInit = (membInfo.MemberFlags.MemberKind = MemberKind.Constructor) && (match vFlags with CtorValUsedAsSelfInit -> true | _ -> false) + let isSelfInit = (membInfo.MemberFlags.MemberKind = MemberKind.Constructor) && (match vFlags with CtorValUsedAsSelfInit -> true | _ -> false) let isCompiledAsInstance = ValRefIsCompiledAsInstanceMember g vref let takesInstanceArg = isCompiledAsInstance && not isNewObj let isPropGet = (membInfo.MemberFlags.MemberKind = MemberKind.PropertyGet) && (membInfo.MemberFlags.IsInstance = isCompiledAsInstance) let isPropSet = (membInfo.MemberFlags.MemberKind = MemberKind.PropertySet) && (membInfo.MemberFlags.IsInstance = isCompiledAsInstance) - numEnclTypeArgs, virtualCall, isNewObj, isSuperInit, isSelfInit , takesInstanceArg, isPropGet, isPropSet + numEnclTypeArgs, virtualCall, isNewObj, isSuperInit, isSelfInit, takesInstanceArg, isPropGet, isPropSet | _ -> 0, false, false, false, false, false, false, false @@ -8053,7 +8053,7 @@ type ActivePatternElemRef with | None -> error(InternalError("not an active pattern name", vref.Range)) | Some apinfo -> let nms = apinfo.ActiveTags - if n < 0 || n >= List.length nms then error(InternalError("name_of_apref: index out of range for active pattern reference", vref.Range)) + if n < 0 || n >= List.length nms then error(InternalError("name_of_apref: index out of range for active pattern reference", vref.Range)) List.item n nms let mkChoiceTyconRef (g: TcGlobals) m n = @@ -8093,11 +8093,11 @@ type PrettyNaming.ActivePatternInfo with // check if an active pattern takes type parameters only bound by the return types, // not by their argument types. let doesActivePatternHaveFreeTypars g (v: ValRef) = - let vty = v.TauType + let vty = v.TauType let vtps = v.Typars |> Zset.ofList typarOrder if not (isFunTy g v.TauType) then errorR(Error(FSComp.SR.activePatternIdentIsNotFunctionTyped(v.LogicalName), v.Range)) - let argtys, resty = stripFunTy g vty + let argtys, resty = stripFunTy g vty let argtps, restps= (freeInTypes CollectTypars argtys).FreeTypars, (freeInType CollectTypars resty).FreeTypars // Error if an active pattern is generic in type variables that only occur in the result Choice<_, ...>. // Note: The test restricts to v.Typars since typars from the closure are considered fixed. @@ -8115,7 +8115,7 @@ type ExprRewritingEnv = IsUnderQuotations: bool } let rec rewriteBind env bind = - match env.PreInterceptBinding with + match env.PreInterceptBinding with | Some f -> match f (RewriteExpr env) bind with | Some res -> res @@ -8142,7 +8142,7 @@ and RewriteExpr env expr = postRewriteExpr env expr and preRewriteExpr env expr = - match env.PreIntercept with + match env.PreIntercept with | Some f -> f (RewriteExpr env) expr | None -> None @@ -8157,7 +8157,7 @@ and rewriteExprStructure env expr = | Expr.Val _ -> expr | Expr.App(f0, f0ty, tyargs, args, m) -> - let f0' = RewriteExpr env f0 + 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) @@ -8222,7 +8222,7 @@ and rewriteLinearExpr env expr contf = rewriteLinearExpr env bodyExpr (contf << (fun bodyExpr' -> mkLetBind m bind bodyExpr')) - | Expr.Sequential (expr1, expr2, dir, spSeq, m) -> + | Expr.Sequential (expr1, expr2, dir, spSeq, m) -> let expr1' = RewriteExpr env expr1 // tailcall rewriteLinearExpr env expr2 (contf << (fun expr2' -> @@ -8280,17 +8280,17 @@ and rewriteObjExprInterfaceImpl env (ty, overrides) = and rewriteModuleOrNamespaceExpr env x = match x with - | ModuleOrNamespaceExprWithSig(mty, def, m) -> ModuleOrNamespaceExprWithSig(mty, rewriteModuleOrNamespaceDef env def, m) + | ModuleOrNamespaceExprWithSig(mty, def, m) -> ModuleOrNamespaceExprWithSig(mty, rewriteModuleOrNamespaceDef env def, m) and rewriteModuleOrNamespaceDefs env x = List.map (rewriteModuleOrNamespaceDef env) x and rewriteModuleOrNamespaceDef env x = match x with | TMDefRec(isRec, tycons, mbinds, m) -> TMDefRec(isRec, tycons, rewriteModuleOrNamespaceBindings env mbinds, m) - | TMDefLet(bind, m) -> TMDefLet(rewriteBind env bind, m) - | TMDefDo(e, m) -> TMDefDo(RewriteExpr env e, m) - | TMDefs defs -> TMDefs(rewriteModuleOrNamespaceDefs env defs) - | TMAbstract mexpr -> TMAbstract(rewriteModuleOrNamespaceExpr env mexpr) + | TMDefLet(bind, m) -> TMDefLet(rewriteBind env bind, m) + | TMDefDo(e, m) -> TMDefDo(RewriteExpr env e, m) + | TMDefs defs -> TMDefs(rewriteModuleOrNamespaceDefs env defs) + | TMAbstract mexpr -> TMAbstract(rewriteModuleOrNamespaceExpr env mexpr) and rewriteModuleOrNamespaceBinding env x = match x with @@ -8337,7 +8337,7 @@ let MakeExportRemapping viewedCcu (mspec: ModuleOrNamespace) = allRemap //-------------------------------------------------------------------------- -// Apply a "local to nonlocal" renaming to a module type. This can't use +// Apply a "local to nonlocal" renaming to a module type. This can't use // remap_mspec since the remapping we want isn't to newly created nodes // but rather to remap to the nonlocal references. This is deliberately // "breaking" the binding structure implicit in the module type, which is @@ -8348,31 +8348,31 @@ let MakeExportRemapping viewedCcu (mspec: ModuleOrNamespace) = let rec remapEntityDataToNonLocal g tmenv (d: Entity) = let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv (d.entity_typars.Force(d.entity_range)) - let typarsR = LazyWithContext.NotLazy tps' - let attribsR = d.entity_attribs |> remapAttribs g tmenvinner - let tyconReprR = d.entity_tycon_repr |> remapTyconRepr g tmenvinner - let tyconAbbrevR = d.TypeAbbrev |> Option.map (remapType tmenvinner) - let tyconTcaugR = d.entity_tycon_tcaug |> remapTyconAug tmenvinner - let modulContentsR = + let typarsR = LazyWithContext.NotLazy tps' + let attribsR = d.entity_attribs |> remapAttribs g tmenvinner + let tyconReprR = d.entity_tycon_repr |> remapTyconRepr g tmenvinner + let tyconAbbrevR = d.TypeAbbrev |> Option.map (remapType tmenvinner) + let tyconTcaugR = d.entity_tycon_tcaug |> remapTyconAug tmenvinner + let modulContentsR = MaybeLazy.Strict (d.entity_modul_contents.Value |> mapImmediateValsAndTycons (remapTyconToNonLocal g tmenv) (remapValToNonLocal g tmenv)) - let exnInfoR = d.ExceptionInfo |> remapTyconExnInfo g tmenvinner + let exnInfoR = d.ExceptionInfo |> remapTyconExnInfo g tmenvinner { d with - entity_typars = typarsR - entity_attribs = attribsR - entity_tycon_repr = tyconReprR - entity_tycon_tcaug = tyconTcaugR + entity_typars = typarsR + entity_attribs = attribsR + entity_tycon_repr = tyconReprR + entity_tycon_tcaug = tyconTcaugR entity_modul_contents = modulContentsR - entity_opt_data = + entity_opt_data = match d.entity_opt_data with | Some dd -> - Some { dd with entity_tycon_abbrev = tyconAbbrevR; entity_exn_info = exnInfoR } + Some { dd with entity_tycon_abbrev = tyconAbbrevR; entity_exn_info = exnInfoR } | _ -> None } and remapTyconToNonLocal g tmenv x = x |> NewModifiedTycon (remapEntityDataToNonLocal g tmenv) -and remapValToNonLocal g tmenv inp = +and remapValToNonLocal g tmenv inp = // creates a new stamp inp |> NewModifiedVal (remapValData g tmenv) @@ -8411,7 +8411,7 @@ type Entity with | Some membInfo -> let argInfos = ArgInfosOfMember g vref argInfos.Length = 1 && - List.lengthsEqAndForall2 (typeEquiv g) (List.map fst (List.head argInfos)) argtys && + List.lengthsEqAndForall2 (typeEquiv g) (List.map fst (List.head argInfos)) argtys && membInfo.MemberFlags.IsOverrideOrExplicitImpl) member tycon.HasMember g nm argtys = @@ -8451,24 +8451,24 @@ let IsSimpleSyntacticConstantExpr g inputExpr = -> checkExpr vrefs arg // compare, =, <>, +, -, <, >, <=, >=, <<<, >>>, &&& | BinopExpr g (vref, arg1, arg2) - when (valRefEq g vref g.equals_operator_vref || - valRefEq g vref g.compare_operator_vref || - valRefEq g vref g.unchecked_addition_vref || - valRefEq g vref g.less_than_operator_vref || - valRefEq g vref g.less_than_or_equals_operator_vref || - valRefEq g vref g.greater_than_operator_vref || - valRefEq g vref g.greater_than_or_equals_operator_vref || - valRefEq g vref g.not_equals_operator_vref || - valRefEq g vref g.unchecked_addition_vref || - valRefEq g vref g.unchecked_multiply_vref || - valRefEq g vref g.unchecked_subtraction_vref || + when (valRefEq g vref g.equals_operator_vref || + valRefEq g vref g.compare_operator_vref || + valRefEq g vref g.unchecked_addition_vref || + valRefEq g vref g.less_than_operator_vref || + valRefEq g vref g.less_than_or_equals_operator_vref || + valRefEq g vref g.greater_than_operator_vref || + valRefEq g vref g.greater_than_or_equals_operator_vref || + valRefEq g vref g.not_equals_operator_vref || + valRefEq g vref g.unchecked_addition_vref || + valRefEq g vref g.unchecked_multiply_vref || + valRefEq g vref g.unchecked_subtraction_vref || // Note: division and modulus can raise exceptions, so are not included - valRefEq g vref g.bitwise_shift_left_vref || - valRefEq g vref g.bitwise_shift_right_vref || - valRefEq g vref g.bitwise_xor_vref || - valRefEq g vref g.bitwise_and_vref || + valRefEq g vref g.bitwise_shift_left_vref || + valRefEq g vref g.bitwise_shift_right_vref || + valRefEq g vref g.bitwise_xor_vref || + valRefEq g vref g.bitwise_and_vref || 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) ) + (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) @@ -8501,16 +8501,16 @@ 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.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)) + with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m)) // See also PostTypeCheckSemanticChecks.CheckAttribArgExpr, which must match this precisely let rec EvalAttribArgExpr g x = @@ -8521,19 +8521,19 @@ let rec EvalAttribArgExpr g x = match c with | Const.Bool _ | Const.Int32 _ - | Const.SByte _ - | Const.Int16 _ + | Const.SByte _ + | Const.Int16 _ | Const.Int32 _ | Const.Int64 _ - | Const.Byte _ - | Const.UInt16 _ - | Const.UInt32 _ - | Const.UInt64 _ + | Const.Byte _ + | Const.UInt16 _ + | Const.UInt32 _ + | Const.UInt64 _ | Const.Double _ | Const.Single _ | Const.Char _ | Const.Zero _ - | Const.String _ -> + | Const.String _ -> x | Const.Decimal _ | Const.IntPtr _ | Const.UIntPtr _ | Const.Unit _ -> errorR (Error ( FSComp.SR.tastNotAConstantExpression(), m)) @@ -8574,27 +8574,27 @@ let rec EvalAttribArgExpr g x = and EvaledAttribExprEquality g e1 e2 = match e1, e2 with | Expr.Const(c1, _, _), Expr.Const(c2, _, _) -> c1 = c2 - | TypeOfExpr g ty1, TypeOfExpr g ty2 -> typeEquiv g ty1 ty2 + | TypeOfExpr g ty1, TypeOfExpr g ty2 -> typeEquiv g ty1 ty2 | TypeDefOfExpr g ty1, TypeDefOfExpr g ty2 -> typeEquiv g ty1 ty2 | _ -> false let (|ConstToILFieldInit|_|) c = match c with - | Const.SByte n -> Some (ILFieldInit.Int8 n) - | Const.Int16 n -> Some (ILFieldInit.Int16 n) - | Const.Int32 n -> Some (ILFieldInit.Int32 n) - | Const.Int64 n -> Some (ILFieldInit.Int64 n) - | Const.Byte n -> Some (ILFieldInit.UInt8 n) - | Const.UInt16 n -> Some (ILFieldInit.UInt16 n) - | Const.UInt32 n -> Some (ILFieldInit.UInt32 n) - | Const.UInt64 n -> Some (ILFieldInit.UInt64 n) - | Const.Bool n -> Some (ILFieldInit.Bool n) - | Const.Char n -> Some (ILFieldInit.Char (uint16 n)) - | Const.Single n -> Some (ILFieldInit.Single n) - | Const.Double n -> Some (ILFieldInit.Double n) - | Const.String s -> Some (ILFieldInit.String s) - | Const.Zero -> Some (ILFieldInit.Null) - | _ -> None + | Const.SByte n -> Some (ILFieldInit.Int8 n) + | Const.Int16 n -> Some (ILFieldInit.Int16 n) + | Const.Int32 n -> Some (ILFieldInit.Int32 n) + | Const.Int64 n -> Some (ILFieldInit.Int64 n) + | Const.Byte n -> Some (ILFieldInit.UInt8 n) + | Const.UInt16 n -> Some (ILFieldInit.UInt16 n) + | Const.UInt32 n -> Some (ILFieldInit.UInt32 n) + | Const.UInt64 n -> Some (ILFieldInit.UInt64 n) + | Const.Bool n -> Some (ILFieldInit.Bool n) + | Const.Char n -> Some (ILFieldInit.Char (uint16 n)) + | Const.Single n -> Some (ILFieldInit.Single n) + | Const.Double n -> Some (ILFieldInit.Double n) + | Const.String s -> Some (ILFieldInit.String s) + | Const.Zero -> Some (ILFieldInit.Null) + | _ -> None let EvalLiteralExprOrAttribArg g x = match x with @@ -8648,7 +8648,7 @@ let rec mkCompiledTuple g isStruct (argtys, args, m) = | [ty8], [arg8] -> match ty8 with // if it's already been nested or ended, pass it through - | TType_app(tn, _) when (isCompiledTupleTyconRef g tn) -> + | TType_app(tn, _) when (isCompiledTupleTyconRef g tn) -> ty8, arg8 | _ -> let ty8enc = TType_app((if isStruct then g.struct_tuple1_tcr else g.ref_tuple1_tcr), [ty8]) @@ -8670,7 +8670,7 @@ 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) /// Match an Int32 constant expression @@ -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)) @@ -8788,12 +8788,12 @@ let DetectAndOptimizeForExpression g option expr = elif isListTy g enumerableTy then // type is list, optimize for expression as: // let mutable $currentVar = listExpr - // let mutable $nextVar = $tailOrNull + // let mutable $nextVar = $tailOrNull // while $guardExpr do // let i = $headExpr // bodyExpr () - // $current <- $next - // $next <- $tailOrNull + // $current <- $next + // $next <- $tailOrNull let IndexHead = 0 let IndexTail = 1 @@ -8833,7 +8833,7 @@ let DetectAndOptimizeForExpression g option expr = let (|InnerExprPat|) expr = stripExpr expr /// One of the transformations performed by the compiler -/// is to eliminate variables of static type "unit". These is a +/// is to eliminate variables of static type "unit". These is a /// utility function related to this. let BindUnitVars g (mvs: Val list, paramInfos: ArgReprInfo list, body) = diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index 95f471c6fd4..8e210613e65 100755 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -838,7 +838,7 @@ let unpickleObjWithDanglingCcus file ilscope (iILModule: ILModuleDef option) u ( iccus= new_itbl "iccus (fake)" [| |] ientities= NodeInTable<_, _>.Create (Tycon.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "itycons", 0) itypars= NodeInTable<_, _>.Create (Typar.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "itypars", 0) - ivals = NodeInTable<_, _>.Create (Val.NewUnlinked , (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ivals", 0) + ivals = NodeInTable<_, _>.Create (Val.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ivals", 0) ianoninfos=NodeInTable<_, _>.Create(AnonRecdTypeInfo.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ianoninfos", 0) istrings = new_itbl "istrings (fake)" [| |] inlerefs = new_itbl "inlerefs (fake)" [| |] @@ -871,7 +871,7 @@ let unpickleObjWithDanglingCcus file ilscope (iILModule: ILModuleDef option) u ( iilscope= ilscope ientities= NodeInTable<_, _>.Create(Tycon.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "itycons", ntycons) itypars= NodeInTable<_, _>.Create(Typar.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "itypars", ntypars) - ivals= NodeInTable<_, _>.Create(Val.NewUnlinked , (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ivals", nvals) + ivals= NodeInTable<_, _>.Create(Val.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ivals", nvals) ianoninfos=NodeInTable<_, _>.Create(AnonRecdTypeInfo.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ianoninfos", nanoninfos) istrings = stringTab ipubpaths = pubpathTab @@ -1797,7 +1797,7 @@ and p_tycon_repr x st = p_byte 0 st; false else // Pickle generated type definitions as a TAsmRepr - p_byte 1 st; p_byte 2 st; p_ILType (mkILBoxedType(ILTypeSpec.Create(ExtensionTyping.GetILTypeRefOfProvidedType(info.ProvidedType , range0), []))) st; true + p_byte 1 st; p_byte 2 st; p_ILType (mkILBoxedType(ILTypeSpec.Create(ExtensionTyping.GetILTypeRefOfProvidedType(info.ProvidedType, range0), []))) st; true | TProvidedNamespaceExtensionPoint _ -> p_byte 0 st; false #endif | TILObjectRepr (TILObjectReprData (_, _, td)) -> error (Failure("Unexpected IL type definition"+td.Name)) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index d85cf3e5e63..6c47f4e262c 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1,6 +1,6 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -/// The typechecker. Left-to-right constrained type checking +/// The typechecker. Left-to-right constrained type checking /// with generalization at appropriate points. module internal FSharp.Compiler.TypeChecker @@ -56,7 +56,7 @@ exception BakedInMemberConstraintName of string * range exception FunctionExpected of DisplayEnv * TType * range exception NotAFunction of DisplayEnv * TType * range * range exception NotAFunctionButIndexer of DisplayEnv * TType * string option * range * range -exception Recursion of DisplayEnv * Ident * TType * TType * range +exception Recursion of DisplayEnv * Ident * TType * TType * range exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range exception LetRecCheckedAtRuntime of range @@ -127,15 +127,15 @@ type CtorInfo = } /// Represents an item in the environment that may restrict the automatic generalization of later -/// declarations because it refers to type inference variables. As type inference progresses +/// declarations because it refers to type inference variables. As type inference progresses /// these type inference variables may get solved. [] type UngeneralizableItem(computeFreeTyvars: (unit -> FreeTyvars)) = // Flag is for: have we determined that this item definitely has // no free type inference variables? This implies that - // (a) it will _never_ have any free type inference variables as further constraints are added to the system. - // (b) its set of FreeTycons will not change as further constraints are added to the system + // (a) it will _never_ have any free type inference variables as further constraints are added to the system. + // (b) its set of FreeTycons will not change as further constraints are added to the system let mutable willNeverHaveFreeTypars = false // If WillNeverHaveFreeTypars then we can cache the computation of FreeTycons, since they are invariant. @@ -224,7 +224,7 @@ type TcEnv = let computeAccessRights eAccessPath eInternalsVisibleCompPaths eFamilyType = AccessibleFrom (eAccessPath :: eInternalsVisibleCompPaths, eFamilyType) // env.eAccessRights -let emptyTcEnv g = +let emptyTcEnv g = let cpath = compPathInternal // allow internal access initially { eNameResEnv = NameResolutionEnv.Empty g eUngeneralizableItems = [] @@ -265,19 +265,19 @@ let EnterFamilyRegion tcref env = let ExitFamilyRegion env = let eFamilyType = None match env.eFamilyType with - | None -> env // optimization to avoid reallocation + | None -> env // optimization to avoid reallocation | _ -> { env with - eAccessRights = computeAccessRights env.eAccessPath env.eInternalsVisibleCompPaths eFamilyType // update this computed field + eAccessRights = computeAccessRights env.eAccessPath env.eInternalsVisibleCompPaths eFamilyType // update this computed field eFamilyType = eFamilyType } -let AreWithinCtorShape env = match env.eCtorInfo with None -> false | Some ctorInfo -> ctorInfo.ctorShapeCounter > 0 -let AreWithinImplicitCtor env = match env.eCtorInfo with None -> false | Some ctorInfo -> ctorInfo.ctorIsImplicit -let GetCtorShapeCounter env = match env.eCtorInfo with None -> 0 | Some ctorInfo -> ctorInfo.ctorShapeCounter -let GetRecdInfo env = match env.eCtorInfo with None -> RecdExpr | Some ctorInfo -> if ctorInfo.ctorShapeCounter = 1 then RecdExprIsObjInit else RecdExpr +let AreWithinCtorShape env = match env.eCtorInfo with None -> false | Some ctorInfo -> ctorInfo.ctorShapeCounter > 0 +let AreWithinImplicitCtor env = match env.eCtorInfo with None -> false | Some ctorInfo -> ctorInfo.ctorIsImplicit +let GetCtorShapeCounter env = match env.eCtorInfo with None -> 0 | Some ctorInfo -> ctorInfo.ctorShapeCounter +let GetRecdInfo env = match env.eCtorInfo with None -> RecdExpr | Some ctorInfo -> if ctorInfo.ctorShapeCounter = 1 then RecdExprIsObjInit else RecdExpr -let AdjustCtorShapeCounter f env = {env with eCtorInfo = Option.map (fun ctorInfo -> { ctorInfo with ctorShapeCounter = f ctorInfo.ctorShapeCounter }) env.eCtorInfo } -let ExitCtorShapeRegion env = AdjustCtorShapeCounter (fun _ -> 0) env +let AdjustCtorShapeCounter f env = {env with eCtorInfo = Option.map (fun ctorInfo -> { ctorInfo with ctorShapeCounter = f ctorInfo.ctorShapeCounter }) env.eCtorInfo } +let ExitCtorShapeRegion env = AdjustCtorShapeCounter (fun _ -> 0) env /// Add a type to the TcEnv, i.e. register it as ungeneralizable. let addFreeItemOfTy ty eUngeneralizableItems = @@ -385,7 +385,7 @@ let AddRootModuleOrNamespaceRefs g amap m env modrefs = { env with eNameResEnv = AddModuleOrNamespaceRefsToNameEnv g amap m true env.eAccessRights env.eNameResEnv modrefs } /// Adjust the TcEnv to account for a new referenced assembly -let AddNonLocalCcu g amap scopem env assemblyName (ccu: CcuThunk, internalsVisibleToAttributes) = +let AddNonLocalCcu g amap scopem env assemblyName (ccu: CcuThunk, internalsVisibleToAttributes) = let internalsVisible = internalsVisibleToAttributes @@ -590,7 +590,7 @@ let MakeInnerEnvForMember env (v: Val) = let GetCurrAccumulatedModuleOrNamespaceType env = !(env.eModuleOrNamespaceTypeAccumulator) /// Set the current accumulator for the namespace/module we're in, updating the inferred contents -let SetCurrAccumulatedModuleOrNamespaceType env x = env.eModuleOrNamespaceTypeAccumulator := x +let SetCurrAccumulatedModuleOrNamespaceType env x = env.eModuleOrNamespaceTypeAccumulator := x /// Set up the initial environment accounting for the enclosing "namespace X.Y.Z" definition let LocateEnv ccu env enclosingNamespacePath = @@ -609,7 +609,7 @@ let LocateEnv ccu env enclosingNamespacePath = let BuildRootModuleType enclosingNamespacePath (cpath: CompilationPath) mtyp = (enclosingNamespacePath, (cpath, (mtyp, []))) ||> List.foldBack (fun id (cpath, (mtyp, mspecs)) -> - let a, b = wrapModuleOrNamespaceTypeInNamespace id cpath.ParentCompPath mtyp + let a, b = wrapModuleOrNamespaceTypeInNamespace id cpath.ParentCompPath mtyp cpath.ParentCompPath, (a, b :: mspecs)) |> fun (_, (mtyp, mspecs)) -> mtyp, List.rev mspecs @@ -775,7 +775,7 @@ let UnifyFunctionType extraInfo cenv denv mFunExpr ty = | ValueNone -> match extraInfo with | Some argm -> error (NotAFunction(denv, ty, mFunExpr, argm)) - | None -> error (FunctionExpected(denv, ty, mFunExpr)) + | None -> error (FunctionExpected(denv, ty, mFunExpr)) let ReportImplicitlyIgnoredBoolExpression denv m ty expr = let checkExpr m expr = @@ -848,9 +848,9 @@ let UnifyUnitType cenv (env: TcEnv) m ty expr = // Logically extends System.AttributeTargets module AttributeTargets = - let FieldDecl = AttributeTargets.Field ||| AttributeTargets.Property + let FieldDecl = AttributeTargets.Field ||| AttributeTargets.Property let FieldDeclRestricted = AttributeTargets.Field - let UnionCaseDecl = AttributeTargets.Method ||| AttributeTargets.Property + let UnionCaseDecl = AttributeTargets.Method ||| AttributeTargets.Property let TyconDecl = AttributeTargets.Class ||| AttributeTargets.Interface ||| AttributeTargets.Delegate ||| AttributeTargets.Struct ||| AttributeTargets.Enum let ExnDecl = AttributeTargets.Class let ModuleDecl = AttributeTargets.Class @@ -908,7 +908,7 @@ let TcConst cenv ty m env c = | SynConst.Measure(_, SynMeasure.Anon _) -> (mkAppTy tcr [TType_measure (Measure.Var (NewAnonTypar (TyparKind.Measure, m, TyparRigidity.Anon, (if iszero then NoStaticReq else HeadTypeStaticReq), TyparDynamicReq.No)))]) - | SynConst.Measure(_, ms) -> mkAppTy tcr [TType_measure (tcMeasure ms)] + | SynConst.Measure(_, ms) -> mkAppTy tcr [TType_measure (tcMeasure ms)] | _ -> mkAppTy tcr [TType_measure Measure.One] unif measureTy @@ -919,19 +919,19 @@ let TcConst cenv ty m env c = | SynConst.Int16 i -> unif cenv.g.int16_ty; Const.Int16 i | SynConst.Int32 i -> unif cenv.g.int_ty; Const.Int32 i | SynConst.Int64 i -> unif cenv.g.int64_ty; Const.Int64 i - | SynConst.IntPtr i -> unif cenv.g.nativeint_ty; Const.IntPtr i + | SynConst.IntPtr i -> unif cenv.g.nativeint_ty; Const.IntPtr i | SynConst.Byte i -> unif cenv.g.byte_ty; Const.Byte i | SynConst.UInt16 i -> unif cenv.g.uint16_ty; Const.UInt16 i | SynConst.UInt32 i -> unif cenv.g.uint32_ty; Const.UInt32 i | SynConst.UInt64 i -> unif cenv.g.uint64_ty; Const.UInt64 i | SynConst.UIntPtr i -> unif cenv.g.unativeint_ty; Const.UIntPtr i | SynConst.Measure(SynConst.Single f, _) | SynConst.Single f -> unifyMeasureArg (f=0.0f) cenv.g.pfloat32_tcr c; Const.Single f - | SynConst.Measure(SynConst.Double f, _) | SynConst.Double f -> unifyMeasureArg (f=0.0) cenv.g.pfloat_tcr c; Const.Double f - | SynConst.Measure(SynConst.Decimal s, _) | SynConst.Decimal s -> unifyMeasureArg false cenv.g.pdecimal_tcr c; Const.Decimal s - | SynConst.Measure(SynConst.SByte i, _) | SynConst.SByte i -> unifyMeasureArg (i=0y) cenv.g.pint8_tcr c; Const.SByte i - | SynConst.Measure(SynConst.Int16 i, _) | SynConst.Int16 i -> unifyMeasureArg (i=0s) cenv.g.pint16_tcr c; Const.Int16 i - | SynConst.Measure(SynConst.Int32 i, _) | SynConst.Int32 i -> unifyMeasureArg (i=0) cenv.g.pint_tcr c; Const.Int32 i - | SynConst.Measure(SynConst.Int64 i, _) | SynConst.Int64 i -> unifyMeasureArg (i=0L) cenv.g.pint64_tcr c; Const.Int64 i + | SynConst.Measure(SynConst.Double f, _) | SynConst.Double f -> unifyMeasureArg (f=0.0) cenv.g.pfloat_tcr c; Const.Double f + | SynConst.Measure(SynConst.Decimal s, _) | SynConst.Decimal s -> unifyMeasureArg false cenv.g.pdecimal_tcr c; Const.Decimal s + | SynConst.Measure(SynConst.SByte i, _) | SynConst.SByte i -> unifyMeasureArg (i=0y) cenv.g.pint8_tcr c; Const.SByte i + | SynConst.Measure(SynConst.Int16 i, _) | SynConst.Int16 i -> unifyMeasureArg (i=0s) cenv.g.pint16_tcr c; Const.Int16 i + | SynConst.Measure(SynConst.Int32 i, _) | SynConst.Int32 i -> unifyMeasureArg (i=0) cenv.g.pint_tcr c; Const.Int32 i + | SynConst.Measure(SynConst.Int64 i, _) | SynConst.Int64 i -> unifyMeasureArg (i=0L) cenv.g.pint64_tcr c; Const.Int64 i | SynConst.Char c -> unif cenv.g.char_ty; Const.Char c | SynConst.String (s, _) -> unif cenv.g.string_ty; Const.String s | SynConst.UserNum _ -> error (InternalError(FSComp.SR.tcUnexpectedBigRationalConstant(), m)) @@ -945,9 +945,9 @@ let TcFieldInit (_m: range) lit = PatternMatchCompilation.ilFieldToTastConst lit //------------------------------------------------------------------------- // Arities. These serve two roles in the system: -// 1. syntactic arities come from the syntactic forms found +// 1. syntactic arities come from the syntactic forms found // signature files and the syntactic forms of function and member definitions. -// 2. compiled arities representing representation choices w.r.t. internal representations of +// 2. compiled arities representing representation choices w.r.t. internal representations of // functions and members. //------------------------------------------------------------------------- @@ -1008,11 +1008,11 @@ let ComputeLogicalName (id: Ident) memberFlags = | MemberKind.Constructor -> ".ctor" | MemberKind.Member -> match id.idText with - | (".ctor" | ".cctor") as r -> errorR(Error(FSComp.SR.tcInvalidMemberNameCtor(), id.idRange)); r + | (".ctor" | ".cctor") as r -> errorR(Error(FSComp.SR.tcInvalidMemberNameCtor(), id.idRange)); r | r -> r - | MemberKind.PropertyGetSet -> error(InternalError(FSComp.SR.tcMemberKindPropertyGetSetNotExpected(), id.idRange)) - | MemberKind.PropertyGet -> "get_" + id.idText - | MemberKind.PropertySet -> "set_" + id.idText + | MemberKind.PropertyGetSet -> error(InternalError(FSComp.SR.tcMemberKindPropertyGetSetNotExpected(), id.idRange)) + | MemberKind.PropertyGet -> "get_" + id.idText + | MemberKind.PropertySet -> "set_" + id.idText /// ValMemberInfoTransient(memberInfo, logicalName, compiledName) type ValMemberInfoTransient = ValMemberInfoTransient of ValMemberInfo * string * string @@ -1020,7 +1020,7 @@ type ValMemberInfoTransient = ValMemberInfoTransient of ValMemberInfo * string * /// Make the unique "name" for a member. // // optImplSlotTy = None (for classes) or Some ty (when implementing interface type ty) -let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, optImplSlotTys, memberFlags, valSynData, id, isCompGen) = +let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, optImplSlotTys, memberFlags, valSynData, id, isCompGen) = let logicalName = ComputeLogicalName id memberFlags let optIntfSlotTys = if optImplSlotTys |> List.forall (isInterfaceTy g) then optImplSlotTys else [] let memberInfo: ValMemberInfo = @@ -1109,26 +1109,26 @@ type DeclKind = static member IsModuleOrMemberOrExtensionBinding x = match x with | ModuleOrMemberBinding -> true - | IntrinsicExtensionBinding -> true + | IntrinsicExtensionBinding -> true | ExtrinsicExtensionBinding -> true | ClassLetBinding _ -> false | ObjectExpressionOverrideBinding -> false | ExpressionBinding -> false - static member MustHaveArity x = DeclKind.IsModuleOrMemberOrExtensionBinding x + static member MustHaveArity x = DeclKind.IsModuleOrMemberOrExtensionBinding x member x.CanBeDllImport = match x with | ModuleOrMemberBinding -> true - | IntrinsicExtensionBinding -> true + | IntrinsicExtensionBinding -> true | ExtrinsicExtensionBinding -> true | ClassLetBinding _ -> true | ObjectExpressionOverrideBinding -> false | ExpressionBinding -> false - static member IsAccessModifierPermitted x = DeclKind.IsModuleOrMemberOrExtensionBinding x + static member IsAccessModifierPermitted x = DeclKind.IsModuleOrMemberOrExtensionBinding x - static member ImplicitlyStatic x = DeclKind.IsModuleOrMemberOrExtensionBinding x + static member ImplicitlyStatic x = DeclKind.IsModuleOrMemberOrExtensionBinding x static member AllowedAttribTargets memberFlagsOpt x = match x with @@ -1140,25 +1140,25 @@ type DeclKind = | Some flags when flags.MemberKind = MemberKind.PropertySet -> AttributeTargets.Property | Some _ -> AttributeTargets.Method | None -> AttributeTargets.Field ||| AttributeTargets.Method ||| AttributeTargets.Property - | IntrinsicExtensionBinding -> AttributeTargets.Method ||| AttributeTargets.Property + | IntrinsicExtensionBinding -> AttributeTargets.Method ||| AttributeTargets.Property | ExtrinsicExtensionBinding -> AttributeTargets.Method ||| AttributeTargets.Property | ClassLetBinding _ -> AttributeTargets.Field ||| AttributeTargets.Method | ExpressionBinding -> enum 0 // indicates attributes not allowed on expression 'let' bindings // Note: now always true - static member CanGeneralizeConstrainedTypars x = + static member CanGeneralizeConstrainedTypars x = match x with | ModuleOrMemberBinding -> true - | IntrinsicExtensionBinding -> true + | IntrinsicExtensionBinding -> true | ExtrinsicExtensionBinding -> true | ClassLetBinding _ -> true | ObjectExpressionOverrideBinding -> true | ExpressionBinding -> true - static member ConvertToLinearBindings x = + static member ConvertToLinearBindings x = match x with | ModuleOrMemberBinding -> true - | IntrinsicExtensionBinding -> true + | IntrinsicExtensionBinding -> true | ExtrinsicExtensionBinding -> true | ClassLetBinding _ -> true | ObjectExpressionOverrideBinding -> true @@ -1205,7 +1205,7 @@ type PrelimValScheme2 = Ident * TypeScheme * PartialValReprInfo option * - ValMemberInfoTransient option * + ValMemberInfoTransient option * bool * ValInline * ValBaseOrThisInfo * @@ -1222,8 +1222,8 @@ type ValScheme = Ident * TypeScheme * ValReprInfo option * - ValMemberInfoTransient option * - bool * // isMutable + ValMemberInfoTransient option * + bool * // isMutable ValInline * ValBaseOrThisInfo * SynAccess option * @@ -1335,7 +1335,7 @@ let PublishValueDefn cenv env declKind (vspec: Val) = let vref = mkLocalValRef vspec tcaug.tcaug_adhoc <- NameMultiMap.add vspec.LogicalName vref tcaug.tcaug_adhoc tcaug.tcaug_adhoc_list.Add (ValRefIsExplicitImpl cenv.g vref, vref) - | _ -> () + | _ -> () let CombineVisibilityAttribs vis1 vis2 m = match vis1 with @@ -1449,7 +1449,7 @@ let MakeAndPublishVal cenv env (altActualParent, inSig, declKind, vrec, vscheme, else let implflags = match TryFindFSharpAttribute cenv.g cenv.g.attrib_MethodImplAttribute attrs with - | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags + | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags | _ -> 0x0 // MethodImplOptions.NoInlining = 0x8 let NO_INLINING = 0x8 @@ -1674,7 +1674,7 @@ let ChooseCanonicalValSchemeAfterInference g denv valscheme m = let valscheme = ValScheme(id, typeScheme, arityInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, compgen, isIncrClass, isTyFunc, hasDeclaredTypars) valscheme -let PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars = +let PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars = declaredTypars @ (generalizedTypars |> List.filter (fun tp -> not (ListSet.contains typarEq tp declaredTypars))) let SetTyparRigid _g denv m (tp: Typar) = @@ -1700,7 +1700,7 @@ let GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTyparsForThisBind // Trim out anything not in type of the value (as opposed to the type of the r.h.s) // This is important when a single declaration binds // multiple generic items, where each item does not use all the polymorphism - // of the r.h.s. , e.g. let x, y = None, [] + // of the r.h.s., e.g. let x, y = None, [] let computeRelevantTypars thruFlag = let ftps = freeInTypeLeftToRight cenv.g thruFlag ty let generalizedTypars = generalizedTyparsForThisBinding |> List.filter (fun tp -> ListSet.contains typarEq tp ftps) @@ -1760,10 +1760,10 @@ let UseSyntacticArity declKind typeScheme partialValReprInfo = // Some is done by InferArityOfExpr. // // However, there are some corner cases in this specification. In particular, consider -// let f () () = 1 // [0;1] or [0;0]? Answer: [0;1] -// let f (a: unit) = 1 // [0] or [1]? Answer: [1] -// let f = (fun () -> 1) // [0] or [1]? Answer: [0] -// let f = (fun (a: unit) -> 1) // [0] or [1]? Answer: [1] +// let f () () = 1 // [0;1] or [0;0]? Answer: [0;1] +// let f (a: unit) = 1 // [0] or [1]? Answer: [1] +// let f = (fun () -> 1) // [0] or [1]? Answer: [0] +// let f = (fun (a: unit) -> 1) // [0] or [1]? Answer: [1] // // The particular choice of [1] for // let f (a: unit) = 1 @@ -1781,12 +1781,12 @@ let UseSyntacticArity declKind typeScheme partialValReprInfo = let CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme = let (PrelimValScheme2(_, typeScheme, partialValReprInfoOpt, memberInfoOpt, isMutable, _, _, ArgAndRetAttribs(argAttribs, retAttribs), _, _, _)) = prelimScheme match partialValReprInfoOpt, DeclKind.MustHaveArity declKind with - | _ , false -> None - | None , true -> Some(PartialValReprInfo([], ValReprInfo.unnamedRetVal)) + | _, false -> None + | None, true -> Some(PartialValReprInfo([], ValReprInfo.unnamedRetVal)) // 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 @@ -1835,10 +1835,10 @@ let UseNoArity prelimScheme = BuildValScheme ExpressionBinding None prelimScheme let MakeSimpleVals cenv env names = - let tyschemes = DontGeneralizeVals names + let tyschemes = DontGeneralizeVals names let valSchemes = NameMap.map UseNoArity tyschemes - let values = MakeAndPublishVals cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valSchemes, [], XmlDoc.Empty, None) - let vspecMap = NameMap.map fst values + let values = MakeAndPublishVals cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valSchemes, [], XmlDoc.Empty, None) + let vspecMap = NameMap.map fst values values, vspecMap let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = @@ -1894,7 +1894,7 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = values, vspecMap - let envinner = AddLocalValMap cenv.tcSink m vspecMap env + let envinner = AddLocalValMap cenv.tcSink m vspecMap env envinner, values, vspecMap @@ -2028,7 +2028,7 @@ let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m cenv env overa let ad = env.eAccessRights match item with | Item.ExnCase ecref -> - CheckEntityAttributes cenv.g ecref m |> CommitOperationResult + CheckEntityAttributes cenv.g ecref m |> CommitOperationResult UnifyTypes cenv env m overallTy cenv.g.exn_ty CheckTyconAccessible cenv.amap m ad ecref |> ignore let mkf = makerForExnTag ecref @@ -2158,7 +2158,7 @@ module GeneralizationHelpers = 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 @@ -2363,7 +2363,7 @@ module GeneralizationHelpers = // can't infer extra polymorphism for properties | MemberKind.PropertyGet | MemberKind.PropertySet -> false // can't infer extra polymorphism for class constructors - | MemberKind.ClassConstructor -> false + | MemberKind.ClassConstructor -> false // can't infer extra polymorphism for constructors | MemberKind.Constructor -> false // feasible to infer extra polymorphism @@ -2410,17 +2410,17 @@ let ComputeInlineFlag memFlagsOption isInline isMutable m = // // This is because the first lambda in a function definition "let F x = e" // now looks like a constructor application, i.e. let (F x) = e ... -// also let A.F x = e ... -// also let f x = e ... +// also let A.F x = e ... +// also let f x = e ... // // The other parts turn property definitions into method definitions. //------------------------------------------------------------------------- // NormalizedBindingRhs records the r.h.s. of a binding after some munging just before type checking. -// NOTE: This is a bit of a mess. In the early implementation of F# we decided +// NOTE: This is a bit of a mess. In the early implementation of F# we decided // to have the parser convert "let f x = e" into -// "let f = fun x -> e". This is called "pushing" a pattern across to the right hand side. Complex +// "let f = fun x -> e". This is called "pushing" a pattern across to the right hand side. Complex // patterns (e.g. non-tuple patterns) result in a computation on the right. // However, this approach really isn't that great - especially since // the language is now considerably more complex, e.g. we use @@ -2448,8 +2448,8 @@ type NormalizedBinding = | NormalizedBinding of SynAccess option * SynBindingKind * - bool * (* pesudo/mustinline value? *) - bool * (* mutable *) + bool * (* pesudo/mustinline value? *) + bool * (* mutable *) SynAttributes * XmlDoc * SynValTyparDecls * @@ -2486,12 +2486,12 @@ module BindingNormalization = if memberFlags.IsInstance then // instance method without adhoc "this" argument error(Error(FSComp.SR.tcInstanceMemberRequiresTarget(), m)) - match args, memberFlags.MemberKind with - | _, MemberKind.PropertyGetSet -> error(Error(FSComp.SR.tcUnexpectedPropertyInSyntaxTree(), m)) + match args, memberFlags.MemberKind with + | _, MemberKind.PropertyGetSet -> error(Error(FSComp.SR.tcUnexpectedPropertyInSyntaxTree(), m)) | [], MemberKind.ClassConstructor -> error(Error(FSComp.SR.tcStaticInitializerRequiresArgument(), m)) - | [], MemberKind.Constructor -> error(Error(FSComp.SR.tcObjectConstructorRequiresArgument(), m)) + | [], MemberKind.Constructor -> error(Error(FSComp.SR.tcObjectConstructorRequiresArgument(), m)) | [_], MemberKind.ClassConstructor - | [_], MemberKind.Constructor -> MakeNormalizedStaticOrValBinding cenv ValOrMemberBinding id vis typars args rhsExpr valSynData + | [_], MemberKind.Constructor -> MakeNormalizedStaticOrValBinding cenv ValOrMemberBinding id vis typars args rhsExpr valSynData // Static property declared using 'static member P = expr': transformed to a method taking a "unit" argument // static property: these transformed into methods taking one "unit" argument | [], MemberKind.Member -> @@ -2508,10 +2508,10 @@ module BindingNormalization = if not memberFlags.IsInstance then // static method with adhoc "this" argument error(Error(FSComp.SR.tcStaticMemberShouldNotHaveThis(), m)) - match args, memberFlags.MemberKind with - | _, MemberKind.ClassConstructor -> error(Error(FSComp.SR.tcExplicitStaticInitializerSyntax(), m)) - | _, MemberKind.Constructor -> error(Error(FSComp.SR.tcExplicitObjectConstructorSyntax(), m)) - | _, MemberKind.PropertyGetSet -> error(Error(FSComp.SR.tcUnexpectedPropertySpec(), m)) + match args, memberFlags.MemberKind with + | _, MemberKind.ClassConstructor -> error(Error(FSComp.SR.tcExplicitStaticInitializerSyntax(), m)) + | _, MemberKind.Constructor -> error(Error(FSComp.SR.tcExplicitObjectConstructorSyntax(), m)) + | _, MemberKind.PropertyGetSet -> error(Error(FSComp.SR.tcUnexpectedPropertySpec(), m)) // Instance property declared using 'x.Member': transformed to methods taking a "this" and a "unit" argument // We push across the 'this' arg in mk_rec_binds | [], MemberKind.Member -> @@ -2539,7 +2539,7 @@ module BindingNormalization = | None -> match ResolvePatternLongIdent cenv.tcSink nameResolver AllIdsOK true m ad env.eNameResEnv TypeNameResolutionInfo.Default longId with | Item.NewDef id -> - if id.idText = opNameCons then + if id.idText = opNameCons then NormalizedBindingPat(pat, rhsExpr, valSynData, typars) else if isObjExprBinding = ObjExprBinding then @@ -2552,8 +2552,8 @@ module BindingNormalization = match longId with // x.Member in member binding patterns. | [thisId;memberId] -> NormalizeInstanceMemberBinding cenv memberFlags valSynData thisId memberId toolId vis typars args m rhsExpr - | [memberId] -> NormalizeStaticMemberBinding cenv memberFlags valSynData memberId vis typars args m rhsExpr - | _ -> NormalizedBindingPat(pat, rhsExpr, valSynData, typars) + | [memberId] -> NormalizeStaticMemberBinding cenv memberFlags valSynData memberId vis typars args m rhsExpr + | _ -> NormalizedBindingPat(pat, rhsExpr, valSynData, typars) // Object constructors are normalized in TcLetrec // Here we are normalizing member definitions with simple (not long) ids, @@ -2598,7 +2598,7 @@ module EventDeclarationNormalization = // reconstitute valSynInfo by adding the argument let argInfos = match argInfos with - | [[thisArgInfo];[]] -> [[thisArgInfo];SynInfo.unnamedTopArg] // instance property getter + | [[thisArgInfo];[]] -> [[thisArgInfo];SynInfo.unnamedTopArg] // instance property getter | [[]] -> [SynInfo.unnamedTopArg] // static property getter | _ -> error(BadEventTransformation(m)) @@ -2623,7 +2623,7 @@ module EventDeclarationNormalization = match declPattern with | SynPat.FromParseError(p, _) -> RenameBindingPattern f p | SynPat.Typed(pat', _, _) -> RenameBindingPattern f pat' - | SynPat.Named (SynPat.Wild m1, id, x2, vis2, m) -> SynPat.Named (SynPat.Wild m1, ident(f id.idText, id.idRange) , x2, vis2, m) + | SynPat.Named (SynPat.Wild m1, id, x2, vis2, m) -> SynPat.Named (SynPat.Wild m1, ident(f id.idText, id.idRange), x2, vis2, m) | SynPat.InstanceMember(thisId, id, toolId, vis2, m) -> SynPat.InstanceMember(thisId, ident(f id.idText, id.idRange), toolId, vis2, m) | _ -> error(Error(FSComp.SR.tcOnlySimplePatternsInLetRec(), declPattern.Range)) @@ -2719,7 +2719,7 @@ let TcValEarlyGeneralizationConsistencyCheck cenv (env: TcEnv) (v: Val, vrec, ti //printfn "running post-inference check for '%s'" v.DisplayName //printfn "tau = '%s'" (DebugPrint.showType tau) //printfn "vty = '%s'" (DebugPrint.showType vty) - let tpsorig, tau2 = tryDestForallTy cenv.g vty + let tpsorig, tau2 = tryDestForallTy cenv.g vty //printfn "tau2 = '%s'" (DebugPrint.showType tau2) if not (isNil tpsorig) then let tpsorig = NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g tpsorig @@ -2740,9 +2740,9 @@ let TcValEarlyGeneralizationConsistencyCheck cenv (env: TcEnv) (v: Val, vrec, ti /// F# object model member, in which case the optInst is the type instantiation /// inferred by member overload resolution, and vrefFlags indicate if the /// member is being used in a special way, i.e. may be one of: -/// | CtorValUsedAsSuperInit "inherit Panel()" -/// | CtorValUsedAsSelfInit "new() = new OwnType(3)" -/// | VSlotDirectCall "base.OnClick(eventArgs)" +/// | CtorValUsedAsSuperInit "inherit Panel()" +/// | CtorValUsedAsSelfInit "new() = new OwnType(3)" +/// | VSlotDirectCall "base.OnClick(eventArgs)" let TcVal checkAttributes cenv env tpenv (vref: ValRef) optInst optAfterResolution m = let (tpsorig, _, _, _, tinst, _) as res = let v = vref.Deref @@ -2750,7 +2750,7 @@ let TcVal checkAttributes cenv env tpenv (vref: ValRef) optInst optAfterResoluti v.SetHasBeenReferenced() CheckValAccessible m env.eAccessRights vref if checkAttributes then - CheckValAttributes cenv.g vref m |> CommitOperationResult + CheckValAttributes cenv.g vref m |> CommitOperationResult let vty = vref.Type // byref-typed values get dereferenced if isByrefTy cenv.g vty then @@ -2769,7 +2769,7 @@ let TcVal checkAttributes cenv env tpenv (vref: ValRef) optInst optAfterResoluti | None -> // References to 'this' in classes get dereferenced from their implicit reference cell and poked - if v.BaseOrThisInfo = CtorThisVal && isRefCellTy cenv.g vty then + if v.BaseOrThisInfo = CtorThisVal && isRefCellTy cenv.g vty then let exprForVal = exprForValRef m vref //if AreWithinCtorPreConstruct env then // warning(SelfRefObjCtor(AreWithinImplicitCtor env, m)) @@ -2789,7 +2789,7 @@ let TcVal checkAttributes cenv env tpenv (vref: ValRef) optInst optAfterResoluti match vrec with | ValInRecScope false -> - let tpsorig, tau = vref.TypeScheme + let tpsorig, tau = vref.TypeScheme let tinst = tpsorig |> List.map mkTyparTy tpsorig, NormalValUse, tinst, tau, tpenv | ValInRecScope true @@ -2804,7 +2804,7 @@ let TcVal checkAttributes cenv env tpenv (vref: ValRef) optInst optAfterResoluti warning(Error(FSComp.SR.tcDoesNotAllowExplicitTypeArguments(v.DisplayName), m)) match vrec with | ValInRecScope false -> - let tpsorig, tau = vref.TypeScheme + let tpsorig, tau = vref.TypeScheme let (tinst: TypeInst), tpenv = checkTys tpenv (tpsorig |> List.map (fun tp -> tp.Kind)) checkInst tinst if tpsorig.Length <> tinst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tpsorig.Length, tinst.Length), m)) @@ -2834,7 +2834,7 @@ let TcVal checkAttributes cenv env tpenv (vref: ValRef) optInst optAfterResoluti valRefEq cenv.g vref cenv.g.splice_expr_vref || valRefEq cenv.g vref cenv.g.splice_raw_expr_vref - let exprForVal = RecordUseOfRecValue cenv vrec vref exprForVal m + let exprForVal = RecordUseOfRecValue cenv vrec vref exprForVal m tpsorig, exprForVal, isSpecial, tau, tinst, tpenv @@ -2903,7 +2903,7 @@ type ApplicableExpr = member x.Expr = match x with - | ApplicableExpr(_, e, _) -> e + | ApplicableExpr(_, e, _) -> e let MakeApplicableExprNoFlex cenv expr = ApplicableExpr (cenv, expr, true) @@ -2914,7 +2914,7 @@ let MakeApplicableExprNoFlex cenv expr = /// De-condensation is determined BEFORE any arguments are checked. Thus /// let f (x:'a) (y:'a) = () /// -/// f (new obj()) "string" +/// f (new obj()) "string" /// /// does not type check (the argument instantiates 'a to "obj" but there is no flexibility on the /// second argument position. @@ -3049,7 +3049,7 @@ let BuildDisposableCleanup cenv env m (v: Val) = let ad = env.eAccessRights let disposeMethod = match TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Dispose" cenv.g.system_IDisposable_ty with - | [x] -> x + | [x] -> x | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(), m)) @@ -3074,7 +3074,7 @@ let BuildOffsetToStringData cenv env m = let ad = env.eAccessRights let offsetToStringDataMethod = match TryFindIntrinsicOrExtensionMethInfo cenv env m ad "get_OffsetToStringData" cenv.g.system_RuntimeHelpers_ty with - | [x] -> x + | [x] -> x | _ -> error(Error(FSComp.SR.tcCouldNotFindOffsetToStringData(), m)) let offsetExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false offsetToStringDataMethod NormalValUse [] [] [] @@ -3149,7 +3149,7 @@ let (|BinOpExpr|_|) e = let (|SimpleEqualsExpr|_|) e = match e with - | BinOpExpr(opId, a, b) when opId.idText = opNameEquals -> Some (a, b) + | BinOpExpr(opId, a, b) when opId.idText = opNameEquals -> Some (a, b) | _ -> None // For join clauses that join on nullable, we syntactically insert the creation of nullable values on the appropriate side of the condition, @@ -3272,7 +3272,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let tryType (exprToSearchForGetEnumeratorAndItem, tyToSearchForGetEnumeratorAndItem) = match findMethInfo true m "GetEnumerator" tyToSearchForGetEnumeratorAndItem with | Exception e -> Exception e - | Result getEnumerator_minfo -> + | Result getEnumerator_minfo -> let getEnumerator_minst = FreshenMethInfo m getEnumerator_minfo let retTypeOfGetEnumerator = getEnumerator_minfo.GetFSharpReturnTy(cenv.amap, m, getEnumerator_minst) @@ -3280,11 +3280,11 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr match findMethInfo false m "MoveNext" retTypeOfGetEnumerator with | Exception e -> Exception e - | Result moveNext_minfo -> + | Result moveNext_minfo -> let moveNext_minst = FreshenMethInfo m moveNext_minfo let retTypeOfMoveNext = moveNext_minfo.GetFSharpReturnTy(cenv.amap, m, moveNext_minst) - if not (typeEquiv cenv.g cenv.g.bool_ty retTypeOfMoveNext) then err false retTypeOfGetEnumerator else + if not (typeEquiv cenv.g cenv.g.bool_ty retTypeOfMoveNext) then err false retTypeOfGetEnumerator else if hasArgs moveNext_minfo moveNext_minst then err false retTypeOfGetEnumerator else match findMethInfo false m "get_Current" retTypeOfGetEnumerator with @@ -3293,7 +3293,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let get_Current_minst = FreshenMethInfo m get_Current_minfo if hasArgs get_Current_minfo get_Current_minst then err false retTypeOfGetEnumerator else - let enumElemTy = get_Current_minfo.GetFSharpReturnTy(cenv.amap, m, get_Current_minst) + let enumElemTy = get_Current_minfo.GetFSharpReturnTy(cenv.amap, m, get_Current_minst) // Compute the element type of the strongly typed enumerator // @@ -3352,8 +3352,8 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr else Tastops.mkCompGenLocal m "enumerator" retTypeOfGetEnumerator, retTypeOfGetEnumerator - let getEnumExpr, getEnumTy = - let (getEnumExpr, getEnumTy) as res = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false getEnumerator_minfo NormalValUse getEnumerator_minst [exprToSearchForGetEnumeratorAndItem] [] + let getEnumExpr, getEnumTy = + let (getEnumExpr, getEnumTy) as res = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false getEnumerator_minfo NormalValUse getEnumerator_minst [exprToSearchForGetEnumeratorAndItem] [] if not isEnumeratorTypeStruct || localAlloc then res else // wrap enumerators that are represented as mutable structs into ref cells @@ -3361,9 +3361,9 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let getEnumTy = mkRefCellTy cenv.g getEnumTy getEnumExpr, getEnumTy - let guardExpr , guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNext_minfo NormalValUse moveNext_minst [enumeratorExpr] [] - let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true get_Current_minfo NormalValUse get_Current_minst [enumeratorExpr] [] - let currentExpr = mkCoerceExpr(currentExpr, enumElemTy, currentExpr.Range, currentTy) + let guardExpr, guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNext_minfo NormalValUse moveNext_minst [enumeratorExpr] [] + let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true get_Current_minfo NormalValUse get_Current_minst [enumeratorExpr] [] + let currentExpr = mkCoerceExpr(currentExpr, enumElemTy, currentExpr.Range, currentTy) let currentExpr, enumElemTy = // Implicitly dereference byref for expr 'for x in ...' if isByrefTy cenv.g enumElemTy then @@ -3377,13 +3377,13 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr // First try the original known static type match (if isArray1DTy cenv.g exprty then Exception (Failure "") else tryType (expr, exprty)) with - | Result res -> res + | Result res -> res | Exception e -> let probe ty = if (AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m ty exprty) then match tryType (mkCoerceExpr(expr, ty, expr.Range, exprty), ty) with - | Result res -> Some res + | Result res -> Some res | Exception e -> PreserveStackTrace(e) raise e @@ -3699,9 +3699,9 @@ type PreInitializationGraphEliminationBinding = /// Check for safety and determine if we need to insert lazy thunks let EliminateInitializationGraphs (getTyconBinds: 'TyconDataIn -> PreInitializationGraphEliminationBinding list) - (morphTyconBinds: (PreInitializationGraphEliminationBinding list -> Binding list) -> 'TyconDataIn -> 'TyconDataOut) + (morphTyconBinds: (PreInitializationGraphEliminationBinding list -> Binding list) -> 'TyconDataIn -> 'TyconDataOut) (getLetBinds: 'LetDataIn list -> PreInitializationGraphEliminationBinding list) - (morphLetBinds: (PreInitializationGraphEliminationBinding list -> Binding list) -> 'LetDataIn list -> Binding list) + (morphLetBinds: (PreInitializationGraphEliminationBinding list -> Binding list) -> 'LetDataIn list -> Binding list) g mustHaveArity denv (fixupsAndBindingsWithoutLaziness: MutRecShape<_, _, _, _, _> list) bindsm = @@ -3756,12 +3756,12 @@ let EliminateInitializationGraphs // NOTE: we can't fixup recursive references inside delegates since the closure delegee of a delegate is not accessible // from outside. Object expressions implementing interfaces can, on the other hand, be fixed up. See FSharp 1.0 bug 1469 if isInterfaceTy g ty then - List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> checkDelayed st e) overrides - List.iter (snd >> List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> checkDelayed st e)) extraImpls + List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> checkDelayed st e) overrides + List.iter (snd >> List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> checkDelayed st e)) extraImpls else CheckExpr (strict st) e - List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> CheckExpr (lzy (strict st)) e) overrides - List.iter (snd >> List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> CheckExpr (lzy (strict st)) e)) extraImpls + List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> CheckExpr (lzy (strict st)) e) overrides + List.iter (snd >> List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> CheckExpr (lzy (strict st)) e)) extraImpls // Expressions where fixups may be needed | Expr.Val (v, _, m) -> CheckValRef st v m @@ -3772,7 +3772,7 @@ let EliminateInitializationGraphs // Composite expressions | Expr.Const _ -> () - | Expr.LetRec (binds, e, _, _) -> + | Expr.LetRec (binds, e, _, _) -> binds |> List.iter (CheckBinding (strict st)) CheckExpr (strict st) e | Expr.Let (bind, e, _, _) -> @@ -3787,13 +3787,13 @@ let EliminateInitializationGraphs // Binary expressions | Expr.Sequential (e1, e2, _, _, _) | Expr.StaticOptimization (_, e1, e2, _) -> - CheckExpr (strict st) e1; CheckExpr (strict st) 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.TyChoose (_, b, _) -> CheckExpr st b - | Expr.Quote _ -> () + | Expr.TyChoose (_, b, _) -> CheckExpr st b + | Expr.Quote _ -> () and CheckBinding st (TBind(_, e, _)) = CheckExpr st e and CheckDecisionTree st = function @@ -3868,11 +3868,11 @@ let EliminateInitializationGraphs let vty = (mkLazyTy g ty) let fty = (g.unit_ty --> ty) - let flazy, felazy = Tastops.mkCompGenLocal m v.LogicalName fty + let flazy, felazy = Tastops.mkCompGenLocal m v.LogicalName fty let frhs = mkUnitDelayLambda g m e if mustHaveArity then flazy.SetValReprInfo (Some(InferArityOfExpr g AllowTypeDirectedDetupling.Yes fty [] [] frhs)) - let vlazy, velazy = Tastops.mkCompGenLocal m v.LogicalName vty + let vlazy, velazy = Tastops.mkCompGenLocal m v.LogicalName vty let vrhs = (mkLazyDelayed g m ty felazy) if mustHaveArity then vlazy.SetValReprInfo (Some(InferArityOfExpr g AllowTypeDirectedDetupling.Yes vty [] [] vrhs)) @@ -3917,7 +3917,7 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr: Expr) = | Some safeInitVal -> let ty = tyOfExpr g recdExpr let thisExpr = mkGetArg0 m ty - let setExpr = mkRefCellSet g m ty (exprForValRef m (mkLocalValRef safeInitVal)) thisExpr + let setExpr = mkRefCellSet g m ty (exprForValRef m (mkLocalValRef safeInitVal)) thisExpr Expr.Sequential(recdExpr, setExpr, ThenDoSeq, SuppressSequencePointOnExprOfSequential, m) let recdExpr = match ctorInfo.safeInitInfo with @@ -3938,19 +3938,19 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr: 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) // = "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) -> @@ -4002,9 +4002,9 @@ 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 -> + || valRefEq g vf g.and2_vref -> MakeApplicableExprNoFlex cenv (mkLazyAnd g m x0 arg), resultTy // Special rule for building applications of the 'x || y' operator @@ -4065,7 +4065,7 @@ let buildApp cenv expr resultTy arg m = let wrap, e1a', _readonly, _writeonly = mkExprAddrOfExpr g true false AddressOfOp arg (Some(vf)) m MakeApplicableExprNoFlex cenv (wrap(e1a')), resultTy - | _ when isByrefTy g 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) @@ -4189,7 +4189,7 @@ type RecursiveBindingInfo = Val * ExplicitTyparInfo * PartialValReprInfo * - ValMemberInfoTransient option * + ValMemberInfoTransient option * Val option * Val option * SafeInitData * @@ -4198,12 +4198,12 @@ type RecursiveBindingInfo = DeclKind member x.EnclosingDeclaredTypars = let (RBInfo(_, _, enclosingDeclaredTypars, _, _, _, _, _, _, _, _, _, _, _)) = x in enclosingDeclaredTypars - member x.Val = let (RBInfo(_, _, _, _, vspec, _, _, _, _, _, _, _, _, _)) = x in vspec - member x.ExplicitTyparInfo = let (RBInfo(_, _, _, _, _, flex, _, _, _, _, _, _, _, _)) = x in flex - member x.DeclaredTypars = let (ExplicitTyparInfo(_, declaredTypars, _)) = x.ExplicitTyparInfo in declaredTypars - member x.Index = let (RBInfo(i, _, _, _, _, _, _, _, _, _, _, _, _, _)) = x in i - member x.ContainerInfo = let (RBInfo(_, c, _, _, _, _, _, _, _, _, _, _, _, _)) = x in c - member x.DeclKind = let (RBInfo(_, _, _, _, _, _, _, _, _, _, _, _, _, declKind)) = x in declKind + member x.Val = let (RBInfo(_, _, _, _, vspec, _, _, _, _, _, _, _, _, _)) = x in vspec + member x.ExplicitTyparInfo = let (RBInfo(_, _, _, _, _, flex, _, _, _, _, _, _, _, _)) = x in flex + member x.DeclaredTypars = let (ExplicitTyparInfo(_, declaredTypars, _)) = x.ExplicitTyparInfo in declaredTypars + member x.Index = let (RBInfo(i, _, _, _, _, _, _, _, _, _, _, _, _, _)) = x in i + member x.ContainerInfo = let (RBInfo(_, c, _, _, _, _, _, _, _, _, _, _, _, _)) = x in c + member x.DeclKind = let (RBInfo(_, _, _, _, _, _, _, _, _, _, _, _, _, declKind)) = x in declKind type PreCheckingRecursiveBinding = { SyntacticBinding: NormalizedBinding @@ -4242,7 +4242,7 @@ let GetInstanceMemberThisVariable (v: Val, x) = match e with | Expr.TyLambda (_, _, b, _, _) -> firstArg b | Expr.TyChoose (_, b, _) -> firstArg b - | Expr.Lambda (_, _, _, [v], _, _, _) -> Some v + | Expr.Lambda (_, _, _, [v], _, _, _) -> Some v | _ -> failwith "GetInstanceMemberThisVariable: instance member did not have expected internal form" firstArg x @@ -4315,7 +4315,7 @@ let rec TcTyparConstraint ridx cenv newOk checkCxs occ (env: TcEnv) tpenv c = | WhereTyparSupportsMember(tps, memSpfn, m) -> let traitInfo, tpenv = TcPseudoMemberSpec cenv newOk env tps tpenv memSpfn m match traitInfo with - | TTrait(objtys, ".ctor", memberFlags, argTys, returnTy, _) when memberFlags.MemberKind = MemberKind.Constructor -> + | TTrait(objtys, ".ctor", memberFlags, argTys, returnTy, _) when memberFlags.MemberKind = MemberKind.Constructor -> match objtys, argTys with | [ty], [] when typeEquiv cenv.g ty (GetFSharpViewOfReturnType cenv.g returnTy) -> AddCxTypeMustSupportDefaultCtor env.DisplayEnv cenv.css m NoTrace ty @@ -4343,7 +4343,7 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv memSpfn m = let memberConstraintTypars, _ = tryDestForallTy cenv.g memberConstraintTy let topValInfo = TranslatePartialArity memberConstraintTypars partialValReprInfo let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g topValInfo memberConstraintTy m - //if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcInvalidConstraint(), m)) + //if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcInvalidConstraint(), m)) let argTys = List.concat curriedArgInfos let argTys = List.map fst argTys let logicalCompiledName = ComputeLogicalName id memberFlags @@ -4583,7 +4583,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | SynType.LongIdent(LongIdentWithDots(tc, _) as lidwd) -> let m = lidwd.Range let ad = env.eAccessRights - let tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) match optKind, tcref.TypeOrMeasureKind with | Some TyparKind.Type, TyparKind.Measure -> error(Error(FSComp.SR.tcExpectedTypeNotUnitOfMeasure(), m)) @@ -4660,7 +4660,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope sortedArgTys |> List.iteri (fun i (x,_) -> let item = Item.AnonRecdField(anonInfo, sortedCheckedArgTys, i, x.idRange) CallNameResolutionSink cenv.tcSink (x.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.UseInType,env.DisplayEnv,env.eAccessRights)) - TType_anon(anonInfo, sortedCheckedArgTys),tpenv + TType_anon(anonInfo, sortedCheckedArgTys),tpenv | SynType.Fun(domainTy, resultTy, _) -> let domainTy', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv domainTy @@ -4693,7 +4693,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | SynType.HashConstraint(ty, m) -> let tp = TcAnonTypeOrMeasure (Some TyparKind.Type) cenv TyparRigidity.WarnIfNotRigid TyparDynamicReq.Yes newOk m let ty', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty - AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty' (mkTyparTy tp) + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty' (mkTyparTy tp) tp.AsType, tpenv | SynType.StaticConstant (c, m) -> @@ -4821,20 +4821,20 @@ and TcStaticConstantParameter cenv (env: TcEnv) tpenv kind (v: SynType) idOpt co | SynType.StaticConstant(sc, _) -> let v = match sc with - | SynConst.Byte n when typeEquiv cenv.g cenv.g.byte_ty kind -> record(cenv.g.byte_ty); box (n: byte) - | SynConst.Int16 n when typeEquiv cenv.g cenv.g.int16_ty kind -> record(cenv.g.int16_ty); box (n: int16) - | SynConst.Int32 n when typeEquiv cenv.g cenv.g.int32_ty kind -> record(cenv.g.int32_ty); box (n: int) - | SynConst.Int64 n when typeEquiv cenv.g cenv.g.int64_ty kind -> record(cenv.g.int64_ty); box (n: int64) - | SynConst.SByte n when typeEquiv cenv.g cenv.g.sbyte_ty kind -> record(cenv.g.sbyte_ty); box (n: sbyte) - | SynConst.UInt16 n when typeEquiv cenv.g cenv.g.uint16_ty kind -> record(cenv.g.uint16_ty); box (n: uint16) - | SynConst.UInt32 n when typeEquiv cenv.g cenv.g.uint32_ty kind -> record(cenv.g.uint32_ty); box (n: uint32) - | SynConst.UInt64 n when typeEquiv cenv.g cenv.g.uint64_ty kind -> record(cenv.g.uint64_ty); box (n: uint64) - | SynConst.Decimal n when typeEquiv cenv.g cenv.g.decimal_ty kind -> record(cenv.g.decimal_ty); box (n: decimal) - | SynConst.Single n when typeEquiv cenv.g cenv.g.float32_ty kind -> record(cenv.g.float32_ty); box (n: single) - | SynConst.Double n when typeEquiv cenv.g cenv.g.float_ty kind -> record(cenv.g.float_ty); box (n: double) - | SynConst.Char n when typeEquiv cenv.g cenv.g.char_ty kind -> record(cenv.g.char_ty); box (n: char) - | SynConst.String (s, _) when s <> null && typeEquiv cenv.g cenv.g.string_ty kind -> record(cenv.g.string_ty); box (s: string) - | SynConst.Bool b when typeEquiv cenv.g cenv.g.bool_ty kind -> record(cenv.g.bool_ty); box (b: bool) + | SynConst.Byte n when typeEquiv cenv.g cenv.g.byte_ty kind -> record(cenv.g.byte_ty); box (n: byte) + | SynConst.Int16 n when typeEquiv cenv.g cenv.g.int16_ty kind -> record(cenv.g.int16_ty); box (n: int16) + | SynConst.Int32 n when typeEquiv cenv.g cenv.g.int32_ty kind -> record(cenv.g.int32_ty); box (n: int) + | SynConst.Int64 n when typeEquiv cenv.g cenv.g.int64_ty kind -> record(cenv.g.int64_ty); box (n: int64) + | SynConst.SByte n when typeEquiv cenv.g cenv.g.sbyte_ty kind -> record(cenv.g.sbyte_ty); box (n: sbyte) + | SynConst.UInt16 n when typeEquiv cenv.g cenv.g.uint16_ty kind -> record(cenv.g.uint16_ty); box (n: uint16) + | SynConst.UInt32 n when typeEquiv cenv.g cenv.g.uint32_ty kind -> record(cenv.g.uint32_ty); box (n: uint32) + | SynConst.UInt64 n when typeEquiv cenv.g cenv.g.uint64_ty kind -> record(cenv.g.uint64_ty); box (n: uint64) + | SynConst.Decimal n when typeEquiv cenv.g cenv.g.decimal_ty kind -> record(cenv.g.decimal_ty); box (n: decimal) + | SynConst.Single n when typeEquiv cenv.g cenv.g.float32_ty kind -> record(cenv.g.float32_ty); box (n: single) + | SynConst.Double n when typeEquiv cenv.g cenv.g.float_ty kind -> record(cenv.g.float_ty); box (n: double) + | SynConst.Char n when typeEquiv cenv.g cenv.g.char_ty kind -> record(cenv.g.char_ty); box (n: char) + | SynConst.String (s, _) when s <> null && typeEquiv cenv.g cenv.g.string_ty kind -> record(cenv.g.string_ty); box (s: string) + | SynConst.Bool b when typeEquiv cenv.g cenv.g.bool_ty kind -> record(cenv.g.bool_ty); box (b: bool) | _ -> fail() v, tpenv | SynType.StaticConstantExpr(e, _ ) -> @@ -4849,22 +4849,22 @@ and TcStaticConstantParameter cenv (env: TcEnv) tpenv kind (v: SynType) idOpt co // Check we have a residue constant. We know the type was correct because we checked the expression with this type. | Expr.Const(c, _, _) -> match c with - | Const.Byte n -> record(cenv.g.byte_ty); box (n: byte) - | Const.Int16 n -> record(cenv.g.int16_ty); box (n: int16) - | Const.Int32 n -> record(cenv.g.int32_ty); box (n: int) - | Const.Int64 n -> record(cenv.g.int64_ty); box (n: int64) - | Const.SByte n -> record(cenv.g.sbyte_ty); box (n: sbyte) - | Const.UInt16 n -> record(cenv.g.uint16_ty); box (n: uint16) - | Const.UInt32 n -> record(cenv.g.uint32_ty); box (n: uint32) - | Const.UInt64 n -> record(cenv.g.uint64_ty); box (n: uint64) - | Const.Decimal n -> record(cenv.g.decimal_ty); box (n: decimal) - | Const.Single n -> record(cenv.g.float32_ty); box (n: single) - | Const.Double n -> record(cenv.g.float_ty); box (n: double) - | Const.Char n -> record(cenv.g.char_ty); box (n: char) - | Const.String null -> fail() - | Const.String s -> record(cenv.g.string_ty); box (s: string) - | Const.Bool b -> record(cenv.g.bool_ty); box (b: bool) - | _ -> fail() + | Const.Byte n -> record(cenv.g.byte_ty); box (n: byte) + | Const.Int16 n -> record(cenv.g.int16_ty); box (n: int16) + | Const.Int32 n -> record(cenv.g.int32_ty); box (n: int) + | Const.Int64 n -> record(cenv.g.int64_ty); box (n: int64) + | Const.SByte n -> record(cenv.g.sbyte_ty); box (n: sbyte) + | Const.UInt16 n -> record(cenv.g.uint16_ty); box (n: uint16) + | Const.UInt32 n -> record(cenv.g.uint32_ty); box (n: uint32) + | Const.UInt64 n -> record(cenv.g.uint64_ty); box (n: uint64) + | Const.Decimal n -> record(cenv.g.decimal_ty); box (n: decimal) + | Const.Single n -> record(cenv.g.float32_ty); box (n: single) + | Const.Double n -> record(cenv.g.float_ty); box (n: double) + | Const.Char n -> record(cenv.g.char_ty); box (n: char) + | Const.String null -> fail() + | Const.String s -> record(cenv.g.string_ty); box (s: string) + | Const.Bool b -> record(cenv.g.bool_ty); box (b: bool) + | _ -> fail() | _ -> error(Error(FSComp.SR.tcInvalidConstantExpression(), v.Range)) v, tpenv' | SynType.LongIdent(lidwd) -> @@ -4916,7 +4916,7 @@ and CrackStaticConstantArgs cenv env tpenv (staticParameters: Tainted if sp.PUntaint((fun sp -> sp.IsOptional), m) then match sp.PUntaint((fun sp -> sp.RawDefaultValue), m) with - | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName) , m)) + | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m)) | v -> v else error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m)) @@ -5027,7 +5027,7 @@ and TcTypeApp cenv newOk checkCxs occ env tpenv m tcref pathTypeArgs (synArgTys: ty, tpenv -and TcTypeOrMeasureAndRecover optKind cenv newOk checkCxs occ env tpenv ty = +and TcTypeOrMeasureAndRecover optKind cenv newOk checkCxs occ env tpenv ty = try TcTypeOrMeasure optKind cenv newOk checkCxs occ env tpenv ty with e -> errorRecovery e ty.Range @@ -5040,7 +5040,7 @@ and TcTypeOrMeasureAndRecover optKind cenv newOk checkCxs occ env tpenv ty = rty, tpenv -and TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty = +and TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty = TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkCxs occ env tpenv ty and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty tyargs = @@ -5058,7 +5058,7 @@ and TryAdjustHiddenVarNameToCompGenName cenv env (id: Ident) altNameRefCellOpt = | Some ({contents = Undecided altId } as altNameRefCell) -> match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false id.idRange env.eAccessRights env.eNameResEnv TypeNameResolutionInfo.Default [id] with | Item.NewDef _ -> None // the name is not in scope as a pattern identifier (e.g. union case), so do not use the alternate ID - | _ -> altNameRefCell := Decided altId; Some altId // the name is in scope as a pattern identifier, so use the alternate ID + | _ -> altNameRefCell := Decided altId; Some altId // the name is in scope as a pattern identifier, so use the alternate ID | Some ({contents = Decided altId }) -> Some altId | None -> None @@ -5115,7 +5115,7 @@ and ValidateOptArgOrder (spats: SynSimplePats) = /// Bind the patterns used in argument position for a function, method or lambda. -and TcSimplePats cenv optArgsOK checkCxs ty env (tpenv, names, takenNames: Set<_>) p = +and TcSimplePats cenv optArgsOK checkCxs ty env (tpenv, names, takenNames: Set<_>) p = // validate optional argument declaration ValidateOptArgOrder p @@ -5152,7 +5152,7 @@ and TcSimplePats cenv optArgsOK checkCxs ty env (tpenv, names, takenNames: Set< | SynSimplePats.SimplePats([SynSimplePat.Id(_, _, _, _, true, _)], _) -> UnifyTypes cenv env m ty (mkOptionTy cenv.g cty') | _ -> UnifyTypes cenv env m ty cty' - TcSimplePats cenv optArgsOK checkCxs ty env (tpenv, names, takenNames) p + TcSimplePats cenv optArgsOK checkCxs ty env (tpenv, names, takenNames) p and TcSimplePatsOfUnknownType cenv optArgsOK checkCxs env tpenv spats = let argty = NewInferenceType () @@ -5327,7 +5327,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p | 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 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) @@ -5378,7 +5378,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p // | Case(_, v) let result = Array.zeroCreate numArgTys for (id, pat) in pairs do - match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with + match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with | None -> match item with | Item.UnionCase(uci, _) -> @@ -5447,7 +5447,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p // LITERAL F# FIELDS CheckRecdFieldInfoAccessible cenv.amap m env.eAccessRights rfinfo if not rfinfo.IsStatic then errorR (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.Name), m)) - CheckRecdFieldInfoAttributes cenv.g rfinfo m |> CommitOperationResult + CheckRecdFieldInfoAttributes cenv.g rfinfo m |> CommitOperationResult match rfinfo.LiteralValue with | None -> error (Error(FSComp.SR.tcFieldNotLiteralCannotBeUsedInPattern(), m)) | Some lit -> @@ -5472,7 +5472,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, env.AccessRights) (fun _ -> TPat_const (lit, m)), (tpenv, names, takenNames) - | _ -> error (Error(FSComp.SR.tcRequireVarConstRecogOrLiteral(), m)) + | _ -> error (Error(FSComp.SR.tcRequireVarConstRecogOrLiteral(), m)) | SynPat.QuoteExpr(_, m) -> error (Error(FSComp.SR.tcInvalidPattern(), m)) @@ -5494,7 +5494,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p else List.foldBack (mkConsListPat cenv.g argty) args' (mkNilListPat cenv.g m argty)), acc | SynPat.Record (flds, m) -> - let tcref, fldsmap, _fldsList = BuildFieldMap cenv env true ty flds m + let tcref, fldsmap, _fldsList = BuildFieldMap cenv env true ty flds m // REVIEW: use _fldsList to type check pattern in code order not field defn order let _, inst, tinst, gtyp = infoOfTyconRef m tcref UnifyTypes cenv env m ty gtyp @@ -5524,7 +5524,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p suppressErrorReporting (fun () -> TcPatAndRecover warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) (NewErrorType()) pat) and TcPatterns warnOnUpper cenv env vFlags s argTys args = - assert (List.length args = List.length argTys) + assert (List.length args = List.length argTys) List.mapFold (fun s (ty, pat) -> TcPat warnOnUpper cenv env None vFlags s ty pat) s (List.zip argTys args) @@ -5545,7 +5545,7 @@ and RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects cenv env tpenv // The tricky bit is to not also have any other effects from typechecking, namely producing error diagnostics (which may be spurious) or having // side-effects on the typecheck environment. // - // REVIEW: We are yet to deal with the tricky bit. As it stands, we turn off error logging, but still have typechecking environment effects. As a result, + // REVIEW: We are yet to deal with the tricky bit. As it stands, we turn off error logging, but still have typechecking environment effects. As a result, // at the very least, you cannot call this function unless you're already reported a typechecking error (the 'worst' possible outcome would be // to incorrectly solve typecheck constraints as a result of effects in this function, and then have the code compile successfully and behave // in some weird way; so ensure the code can't possibly compile before calling this function as an expedient way to get better IntelliSense). @@ -5582,7 +5582,7 @@ and TcExprFlex cenv flex compat ty (env: TcEnv) tpenv (e: SynExpr) = if compat then (destTyparTy cenv.g argty).SetIsCompatFlex(true) AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css e.Range NoTrace ty argty - let e', tpenv = TcExpr cenv argty env tpenv e + let e', tpenv = TcExpr cenv argty env tpenv e let e' = mkCoerceIfNeeded cenv.g ty argty e' e', tpenv else @@ -5615,7 +5615,7 @@ and TcExprNoRecover cenv ty (env: TcEnv) tpenv (expr: SynExpr) = // This recursive entry is only used from one callsite (DiscardAfterMissingQualificationAfterDot) -// and has been added relatively late in F# 4.0 to preserve the structure of previous code. It pushes a 'delayed' parameter +// and has been added relatively late in F# 4.0 to preserve the structure of previous code. It pushes a 'delayed' parameter // through TcExprOfUnknownType, TcExpr and TcExprNoRecover and TcExprOfUnknownTypeThen cenv env tpenv expr delayed = let exprty = NewInferenceType () @@ -5700,7 +5700,7 @@ and TcExprThen cenv overallTy env tpenv synExpr delayed = | SynExpr.DotIndexedSet (e1, e2, _, _, mDot, mWholeExpr) -> TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv synExpr e1 e2 delayed - | _ -> + | _ -> match delayed with | [] -> TcExprUndelayed cenv overallTy env tpenv synExpr | _ -> @@ -5775,7 +5775,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = let idv1, idve1 = mkCompGenLocal mArg (cenv.synArgNameGenerator.New()) domainTy let envinner = ExitFamilyRegion env let idv2, matchExpr, tpenv = TcAndPatternCompileMatchClauses m mArg (if isExnMatch then Throw else ThrowIncompleteMatchException) cenv None domainTy resultTy envinner tpenv clauses - let overallExpr = mkMultiLambda m [idv1] ((mkLet spMatch m idv2 idve1 matchExpr), resultTy) + let overallExpr = mkMultiLambda m [idv1] ((mkLet spMatch m idv2 idve1 matchExpr), resultTy) overallExpr, tpenv | SynExpr.Assert (x, m) -> @@ -5786,7 +5786,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = // e: ty | SynExpr.Typed (synBodyExpr, synType, m) -> - let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType + let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType UnifyTypes cenv env m overallTy tgtTy let expr, tpenv = TcExpr cenv overallTy env tpenv synBodyExpr expr, tpenv @@ -5795,7 +5795,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = | SynExpr.TypeTest (synInnerExpr, tgtTy, m) -> let innerExpr, srcTy, tpenv = TcExprOfUnknownType cenv env tpenv synInnerExpr UnifyTypes cenv env m overallTy cenv.g.bool_ty - let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgtTy + let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgtTy TcRuntimeTypeTest (*isCast*)false (*isOperator*)true cenv env.DisplayEnv m tgtTy srcTy let expr = mkCallTypeTest cenv.g m tgtTy innerExpr expr, tpenv @@ -5835,7 +5835,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = // TcRuntimeTypeTest ensures tgtTy is a nominal type. Hence we can insert a check here // based on the nullness semantics of the nominal type. - let expr = mkCallUnbox cenv.g m tgtTy innerExpr + let expr = mkCallUnbox cenv.g m tgtTy innerExpr expr, tpenv | SynExpr.Null m -> @@ -5904,9 +5904,9 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = | SynExpr.For (spBind, id, start, dir, finish, body, m) -> UnifyTypes cenv env m overallTy cenv.g.unit_ty - let startExpr , tpenv = TcExpr cenv cenv.g.int_ty env tpenv start + let startExpr, tpenv = TcExpr cenv cenv.g.int_ty env tpenv start let finishExpr, tpenv = TcExpr cenv cenv.g.int_ty env tpenv finish - let idv, _ = mkLocal id.idRange id.idText cenv.g.int_ty + let idv, _ = mkLocal id.idRange id.idText cenv.g.int_ty let envinner = AddLocalVal cenv.tcSink m idv env // notify name resolution sink about loop variable @@ -5914,7 +5914,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = CallNameResolutionSink cenv.tcSink (idv.Range, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights) let bodyExpr, tpenv = TcStmt cenv envinner tpenv body - mkFastForLoop cenv.g (spBind, m, idv, startExpr, dir, finishExpr, bodyExpr), tpenv + mkFastForLoop cenv.g (spBind, m, idv, startExpr, dir, finishExpr, bodyExpr), tpenv | SynExpr.ForEach (spForLoop, SeqExprOnly seqExprOnly, isFromSource, pat, enumSynExpr, bodySynExpr, m) -> assert isFromSource @@ -5936,7 +5936,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = TcComputationOrSequenceExpression cenv env overallTy m None tpenv comp - | SynExpr.ArrayOrListOfSeqExpr (isArray, comp, m) -> + | SynExpr.ArrayOrListOfSeqExpr (isArray, comp, m) -> CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) match comp with @@ -5966,11 +5966,11 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = let genCollElemTy = NewInferenceType () - let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy + let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy UnifyTypes cenv env m overallTy genCollTy - let exprty = mkSeqTy cenv.g genCollElemTy + let exprty = mkSeqTy cenv.g genCollElemTy // Check the comprehension let expr, tpenv = TcExpr cenv exprty env tpenv comp @@ -6100,7 +6100,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = TcLongIdentThen cenv overallTy env tpenv lidwd [ DelayedApp(ExprAtomicFlag.Atomic, e1, mStmt); MakeDelayedSet(e2, mStmt) ] | SynExpr.TraitCall(tps, memSpfn, arg, m) -> - let synTypes = tps |> List.map (fun tp -> SynType.Var(tp, 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 warning(BakedInMemberConstraintName(logicalCompiledName, m)) @@ -6126,7 +6126,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = | SynExpr.LibraryOnlyUnionCaseFieldSet (e1, c, n, e2, m) -> UnifyTypes cenv env m overallTy cenv.g.unit_ty let e1', ty1, tpenv = TcExprOfUnknownType cenv env tpenv e1 - let mkf, ty2 = TcUnionCaseOrExnField cenv env ty1 m c n + let mkf, ty2 = TcUnionCaseOrExnField cenv env ty1 m c n ((fun (a, b) n e2' -> if not (isUnionCaseFieldMutable cenv.g a n) then errorR(Error(FSComp.SR.tcFieldIsNotMutable(), m)) mkUnionCaseFieldSet(e1', a, b, n, e2', m)), @@ -6168,8 +6168,8 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = | SynExpr.ImplicitZero m -> error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(), m)) - | SynExpr.DoBang (_, m) - | SynExpr.LetOrUseBang (_, _, _, _, _, _, m) -> + | SynExpr.DoBang (_, m) + | SynExpr.LetOrUseBang (_, _, _, _, _, _, m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) | SynExpr.MatchBang (_, _, _, m) -> @@ -6186,7 +6186,7 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = let envinner = if isMember then envinner else ExitFamilyRegion envinner let bodyExpr, tpenv = TcIteratedLambdas cenv false envinner resultTy takenNames tpenv bodyExpr // See bug 5758: Non-monotonicity in inference: need to ensure that parameters are never inferred to have byref type, instead it is always declared - byrefs |> Map.iter (fun _ (orig, v) -> + byrefs |> Map.iter (fun _ (orig, v) -> if not orig && isByrefTy cenv.g v.Type then errorR(Error(FSComp.SR.tcParameterInferredByref v.DisplayName, v.Range))) mkMultiLambda m (List.map (fun nm -> NameMap.find nm vspecMap) vs) (bodyExpr, resultTy), tpenv | e -> @@ -6199,7 +6199,7 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = // Check expr.[idx] // This is a little over complicated for my liking. Basically we want to interpret e1.[idx] as e1.Item(idx). // However it's not so simple as all that. First "Item" can have a different name according to an attribute in -// .NET metadata. This means we manually typecheck 'e1' and look to see if it has a nominal type. We then +// .NET metadata. This means we manually typecheck 'e1' and look to see if it has a nominal type. We then // do the right thing in each case. and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArgs delayed = let ad = env.eAccessRights @@ -6238,7 +6238,7 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg let GetIndexArgs (es: SynIndexerArg list) = [ for e in es do yield! e.Exprs ] let MakeIndexParam vopt = match indexArgs with - | [] -> failwith "unexpected empty index list" + | [] -> 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) @@ -6253,9 +6253,9 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg | 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(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) @@ -6326,7 +6326,7 @@ and TcNewExpr cenv env tpenv objTy mObjTyOpt superInit arg mWholeExprOrObjTy = | SynExpr.Const (SynConst.Unit, _) -> () | _ -> errorR(Error(FSComp.SR.tcObjectConstructorsOnTypeParametersCannotTakeArguments(), mWholeExprOrObjTy)) - mkCallCreateInstance cenv.g mWholeExprOrObjTy objTy , tpenv + mkCallCreateInstance cenv.g mWholeExprOrObjTy objTy, tpenv else if not (isAppTy cenv.g objTy) && not (isAnyTupleTy cenv.g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"), mWholeExprOrObjTy)) let item = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mWholeExprOrObjTy ad objTy) @@ -6433,19 +6433,19 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExprInfo objTy fldsList if optOrigExprInfo.IsNone && not (Zset.subset ns2 ns1) then error (MissingFields(Zset.elements (Zset.diff ns2 ns1), m)) - if not (Zset.subset ns1 ns2) then + if not (Zset.subset ns1 ns2) then error (Error(FSComp.SR.tcExtraneousFieldsGivenValues(), m)) // Build record let rfrefs = List.map (fst >> mkRecdFieldRef tcref) fldsList // Check accessibility: this is also done in BuildFieldMap, but also need to check - // for fields in { new R with a=1 and b=2 } constructions and { r with a=1 } copy-and-update expressions + // for fields in { new R with a=1 and b=2 } constructions and { r with a=1 } copy-and-update expressions rfrefs |> List.iter (fun rfref -> CheckRecdFieldAccessible cenv.amap m env.eAccessRights rfref |> ignore CheckFSharpAttributes cenv.g rfref.PropertyAttribs m |> CommitOperationResult) - let args = List.map snd fldsList + let args = List.map snd fldsList let expr = mkRecordExpr cenv.g (GetRecdInfo env, tcref, tinst, rfrefs, args, m) @@ -6531,9 +6531,9 @@ and FreshenObjExprAbstractSlot cenv (env: TcEnv) (implty: TType) virtNameAndArit errorR(ErrorWithSuggestions(FSComp.SR.tcMemberFoundIsNotAbstractOrVirtual(tcref.DisplayName, bindName), mBinding, bindName, suggestVirtualMembers)) else errorR(ErrorWithSuggestions(FSComp.SR.tcNoAbstractOrVirtualMemberFound(bindName), mBinding, bindName, suggestVirtualMembers)) - | [(_, absSlot: MethInfo)] -> + | [(_, absSlot: MethInfo)] -> errorR(Error(FSComp.SR.tcArgumentArityMismatch(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot), mBinding)) - | (_, absSlot: MethInfo) :: _ -> + | (_, absSlot: MethInfo) :: _ -> errorR(Error(FSComp.SR.tcArgumentArityMismatchOneOverload(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot), mBinding)) None @@ -6568,7 +6568,7 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo, bind) = bindingRhs, logicalMethId, memberFlags | SynPat.InstanceMember(thisId, memberId, _, _, _), Some memberFlags -> - CheckMemberFlags None NewSlotsOK OverridesOK memberFlags mBinding + CheckMemberFlags None NewSlotsOK OverridesOK memberFlags mBinding let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar thisId) bindingRhs let logicalMethId = ident (ComputeLogicalName memberId memberFlags, memberId.idRange) bindingRhs, logicalMethId, memberFlags @@ -6607,7 +6607,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 declaredTypars = ChooseCanonicalDeclaredTyparsAfterInference cenv.g env.DisplayEnv declaredTypars m + let declaredTypars = ChooseCanonicalDeclaredTyparsAfterInference cenv.g env.DisplayEnv declaredTypars m let generalizedTypars = PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars @@ -6621,12 +6621,12 @@ and ComputeObjectExprOverrides cenv (env: TcEnv) tpenv impls = let slotImplSets = DispatchSlotChecking.GetSlotImplSets cenv.infoReader env.DisplayEnv true (impls |> List.map (fun (m, ty, _) -> ty, m)) let allImpls = - (impls, slotImplSets) ||> List.map2 (fun (m, ty, binds) implTySet -> + (impls, slotImplSets) ||> List.map2 (fun (m, ty, binds) implTySet -> let binds = binds |> List.map (BindingNormalization.NormalizeBinding ObjExprBinding cenv env) m, ty, binds, implTySet) let overridesAndVirts, tpenv = - (tpenv, allImpls) ||> List.mapFold (fun tpenv (m, implty, binds, SlotImplSet(reqdSlots, dispatchSlotsKeyed, availPriorOverrides, _) ) -> + (tpenv, allImpls) ||> List.mapFold (fun tpenv (m, implty, binds, SlotImplSet(reqdSlots, dispatchSlotsKeyed, availPriorOverrides, _) ) -> // Generate extra bindings fo object expressions with bindings using the CLIEvent attribute let binds, bindsAttributes = @@ -6657,7 +6657,7 @@ and ComputeObjectExprOverrides cenv (env: TcEnv) tpenv impls = // 3. infer must-have types by name/arity let preAssignedVirtsPerBinding = - bindKeys |> List.map (fun bkey -> List.filter (fst >> (=) bkey) virtNameAndArityPairs) + bindKeys |> List.map (fun bkey -> List.filter (fst >> (=) bkey) virtNameAndArityPairs) let absSlotInfo = (List.zip4 binds bindsAttributes bindNames preAssignedVirtsPerBinding) @@ -6692,7 +6692,7 @@ and CheckSuperType cenv ty m = and TcObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, mNewExpr, mWholeExpr) = let mObjTy = synObjTy.Range - let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synObjTy + let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synObjTy match tryDestAppTy cenv.g objTy with | ValueNone -> error(Error(FSComp.SR.tcNewMustBeUsedWithNamedType(), mNewExpr)) | ValueSome tcref -> @@ -6702,7 +6702,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, CheckSuperType cenv objTy synObjTy.Range // Add the object type to the ungeneralizable items - let env = {env with eUngeneralizableItems = addFreeItemOfTy objTy env.eUngeneralizableItems } + let env = {env with eUngeneralizableItems = addFreeItemOfTy objTy env.eUngeneralizableItems } // Object expression members can access protected members of the implemented type let env = EnterFamilyRegion tcref env @@ -6732,7 +6732,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, // Work out the type of any interfaces to implement let extraImpls, tpenv = - (tpenv , extraImpls) ||> List.mapFold (fun tpenv (InterfaceImpl(synIntfTy, overrides, m)) -> + (tpenv, extraImpls) ||> List.mapFold (fun tpenv (InterfaceImpl(synIntfTy, overrides, m)) -> let intfTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synIntfTy if not (isInterfaceTy cenv.g intfTy) then error(Error(FSComp.SR.tcExpectedInterfaceType(), m)) @@ -6822,7 +6822,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, //------------------------------------------------------------------------- /// Check a constant string expression. It might be a 'printf' format string -and TcConstStringExpr cenv overallTy env m tpenv s = +and TcConstStringExpr cenv overallTy env m tpenv s = if (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy cenv.g.string_ty) then mkString cenv.g m s, tpenv @@ -6842,7 +6842,7 @@ and TcConstStringExpr cenv overallTy env m tpenv s = match cenv.tcSink.CurrentSink with | None -> () - | Some sink -> + | Some sink -> for specifierLocation, numArgs in specifierLocations do sink.NotifyFormatSpecifierLocation(specifierLocation, numArgs) @@ -6858,7 +6858,7 @@ and TcConstStringExpr cenv overallTy env m tpenv s = //------------------------------------------------------------------------- /// Check a constant expression. -and TcConstExpr cenv overallTy env m tpenv c = +and TcConstExpr cenv overallTy env m tpenv c = match c with // NOTE: these aren't "really" constants @@ -6911,7 +6911,7 @@ and TcConstExpr cenv overallTy env m tpenv c = //------------------------------------------------------------------------- // Check an 'assert(x)' expression. -and TcAssertExpr cenv overallTy env (m: range) tpenv x = +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", // wrap an extra parentheses so 'assert(x=1) isn't considered a named argument to a method call @@ -7055,7 +7055,7 @@ and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs let wrap, oldveaddr, _readonly, _writeonly = mkExprAddrOfExpr cenv.g origExprIsStruct false NeverMutates oldve None mOrigExpr - // Put all the expressions in unsorted order. The new bindings come first. The origin of each is tracked using + // Put all the expressions in unsorted order. The new bindings come first. The origin of each is tracked using /// - Choice1Of2 for a new binding /// - Choice2Of2 for a binding coming from the original expression let unsortedIdAndExprsAll = @@ -7070,7 +7070,7 @@ and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs let tcref, tinst = destAppTy cenv.g origExprTy let fspecs = tcref.Deref.TrueInstanceFieldsAsList for fspec in fspecs do - yield fspec.Id, Choice2Of2 (mkRecdFieldGetViaExprAddr (oldveaddr , tcref.MakeNestedRecdFieldRef fspec, tinst, mOrigExpr)) + yield fspec.Id, Choice2Of2 (mkRecdFieldGetViaExprAddr (oldveaddr, tcref.MakeNestedRecdFieldRef fspec, tinst, mOrigExpr)) else error (Error (FSComp.SR.tcCopyAndUpdateNeedsRecordType(), mOrigExpr)) |] |> Array.distinctBy (fst >> textOfId) @@ -7105,7 +7105,7 @@ and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs expr, tpenv -and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWholeExpr, spForLoop) = +and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWholeExpr, spForLoop) = UnifyTypes cenv env mWholeExpr overallTy cenv.g.unit_ty let mPat = pat.Range @@ -7126,7 +7126,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol (cenv.g.int32_ty, (fun _ x -> x), id, Choice1Of3 (startExpr, finishExpr)) // optimize 'for i in arr do' - | _ when isArray1DTy cenv.g enumExprTy -> + | _ when isArray1DTy cenv.g enumExprTy -> let arrVar, arrExpr = mkCompGenLocal mEnumExpr "arr" enumExprTy let idxVar, idxExpr = mkCompGenLocal mPat "idx" cenv.g.int32_ty let elemTy = destArrayTy cenv.g enumExprTy @@ -7201,7 +7201,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol mForLoopStart), cleanupE, mForLoopStart, cenv.g.unit_ty, NoSequencePointAtTry, NoSequencePointAtFinally)))) - let overallExpr = overallExprFixup overallExpr + let overallExpr = overallExprFixup overallExpr overallExpr, tpenv //------------------------------------------------------------------------- @@ -7339,7 +7339,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv match customOperationMethodsIndexedByKeyword.TryGetValue nm.idText with | true, [opData] -> let (opName, maintainsVarSpaceUsingBind, maintainsVarSpace, _allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, _joinConditionWord, methInfo) = opData - if (maintainsVarSpaceUsingBind && maintainsVarSpace) || (isLikeZip && isLikeJoin) || (isLikeZip && isLikeGroupJoin) || (isLikeJoin && isLikeGroupJoin) then + if (maintainsVarSpaceUsingBind && maintainsVarSpace) || (isLikeZip && isLikeJoin) || (isLikeZip && isLikeGroupJoin) || (isLikeJoin && isLikeGroupJoin) then errorR(Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) match customOperationMethodsIndexedByMethodName.TryGetValue methInfo.LogicalName with | true, [_] -> () @@ -7351,43 +7351,43 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv /// Decide if the identifier represents a use of a custom query operator let hasCustomOperations () = not (isNil customOperationMethods) - let isCustomOperation nm = tryGetDataForCustomOperation nm |> Option.isSome + let isCustomOperation nm = tryGetDataForCustomOperation nm |> Option.isSome // Check for the MaintainsVariableSpace on custom operation let customOperationMaintainsVarSpace (nm: Ident) = match tryGetDataForCustomOperation nm with | None -> false - | Some (_nm, _maintainsVarSpaceUsingBind, maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> maintainsVarSpace + | Some (_nm, _maintainsVarSpaceUsingBind, maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> maintainsVarSpace let customOperationMaintainsVarSpaceUsingBind (nm: Ident) = match tryGetDataForCustomOperation nm with | None -> false - | Some (_nm, maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> maintainsVarSpaceUsingBind + | Some (_nm, maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> maintainsVarSpaceUsingBind let customOperationIsLikeZip (nm: Ident) = match tryGetDataForCustomOperation nm with | None -> false - | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeZip + | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeZip let customOperationIsLikeJoin (nm: Ident) = match tryGetDataForCustomOperation nm with | None -> false - | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeJoin + | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeJoin let customOperationIsLikeGroupJoin (nm: Ident) = match tryGetDataForCustomOperation nm with | None -> false - | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeGroupJoin + | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeGroupJoin let customOperationJoinConditionWord (nm: Ident) = match tryGetDataForCustomOperation nm with - | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, Some joinConditionWord, _methInfo) -> joinConditionWord + | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, Some joinConditionWord, _methInfo) -> joinConditionWord | _ -> "on" let customOperationAllowsInto (nm: Ident) = match tryGetDataForCustomOperation nm with | None -> false - | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> allowInto + | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> allowInto let customOpUsageText nm = match tryGetDataForCustomOperation nm with @@ -7431,7 +7431,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let expectedArgCountForCustomOperator (nm: Ident) = match tryGetArgInfosForCustomOperator nm with | None -> 0 - | Some argInfos -> max (argInfos.Length - 1) 0 // drop the computation context argument + | Some argInfos -> max (argInfos.Length - 1) 0 // drop the computation context argument // Check for the [] attribute on an argument position let isCustomOperationProjectionParameter i (nm: Ident) = @@ -7453,7 +7453,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | SingleIdent nm when isCustomOperation nm && predicate nm -> Some nm | _ -> None - // e1 in e2 ('in' is parsed as 'JOIN_IN') + // 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) @@ -7526,7 +7526,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (|JoinExpr|_|) (e: SynExpr) = match e with - | InExpr (JoinOp(nm, innerSourcePat, _, alreadyGivenError), onExpr, mJoinCore) -> + | InExpr (JoinOp(nm, innerSourcePat, _, alreadyGivenError), onExpr, mJoinCore) -> let (innerSource, keySelectors) = MatchOnExprOrRecover alreadyGivenError nm onExpr Some(nm, innerSourcePat, innerSource, keySelectors, mJoinCore) | JoinOp (nm, innerSourcePat, mJoinCore, alreadyGivenError) -> @@ -7565,7 +7565,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some(nm, secondSourcePat, secondSource, None, None, mZipCore) // zip (without secondSource or in - gives error) - | CustomOpId customOperationIsLikeZip nm -> + | CustomOpId customOperationIsLikeZip nm -> errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) Some(nm, arbPat e.Range, arbExpr("_secondSource", e.Range), None, None, e.Range) @@ -7600,7 +7600,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let rec strip e = match e with | SynExpr.FromParseError(SynExpr.App(_, _, f, arg, _), _) - | SynExpr.App(_, _, f, arg, _) -> + | SynExpr.App(_, _, f, arg, _) -> let g, acc = strip f g, (arg::acc) | _ -> e, [] @@ -7614,7 +7614,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (|CustomOperationClause|_|) e = match e with - | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, optInto) when isCustomOperation nm -> + | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, optInto) when isCustomOperation nm -> // Now we know we have a custom operation, commit the name resolution let optIntoInfo = match optInto with @@ -7710,7 +7710,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // ... // --> // zip expr1 expr2 (fun pat1 pat3 -> ...) - | ForEachThenJoinOrGroupJoinOrZipClause (isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, secondResultPatOpt, mOpCore, innerComp) -> + | ForEachThenJoinOrGroupJoinOrZipClause (isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, secondResultPatOpt, mOpCore, innerComp) -> if not q then error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere(), nm.idRange)) @@ -7764,14 +7764,14 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv secondSource (mkSynLambda firstSourceSimplePats keySelector1 mSynthetic) (mkSynLambda secondSourceSimplePats keySelector2 mSynthetic) - (mkSynLambda firstSourceSimplePats (mkSynLambda innerPat e mSynthetic) mSynthetic) ] + (mkSynLambda firstSourceSimplePats (mkSynLambda innerPat e mSynthetic) mSynthetic) ] let mkZipExpr e = let mSynthetic = mOpCore.MakeSynthetic() mkSynCall methInfo.DisplayName mOpCore [ firstSource secondSource - (mkSynLambda firstSourceSimplePats (mkSynLambda secondSourceSimplePats e mSynthetic) mSynthetic) ] + (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(...) @@ -7851,7 +7851,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // Case from C# spec: A query expression with a join clause with an into followed by something other than a select clause // Case from C# spec: A query expression with a join clause without an into followed by something other than a select clause let valsInner, _env = varSpaceInner.Force mOpCore - let varSpaceExpr = mkExprForVarSpace mOpCore valsInner + let varSpaceExpr = mkExprForVarSpace mOpCore valsInner let varSpacePat = mkPatForVarSpace mOpCore valsInner let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr Some (trans true q varSpaceInner (SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, varSpacePat, joinExpr, innerComp, mOpCore)) translatedCtxt) @@ -7908,7 +7908,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // 'join' clauses preceded by 'let' and other constructs get processed by repackaging with a 'for' loop. let patvs, _env = varSpace.Force comp.Range - let varSpaceExpr = mkExprForVarSpace mClause patvs + let varSpaceExpr = mkExprForVarSpace mClause patvs let varSpacePat = mkPatForVarSpace mClause patvs let dataCompPrior = @@ -7927,7 +7927,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv if not q then error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere(), opExpr.Range)) let patvs, _env = varSpace.Force comp.Range - let varSpaceExpr = mkExprForVarSpace mClause patvs + let varSpaceExpr = mkExprForVarSpace mClause patvs let dataCompPriorToOp = let isYield = not (customOperationMaintainsVarSpaceUsingBind nm) @@ -7957,7 +7957,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv errorR(Error(FSComp.SR.tcBinaryOperatorRequiresBody(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) match optionalCont with | None -> - // we are about to drop the 'opExpr' AST on the floor. we've already reported an error. attempt to get name resolutions before dropping it + // we are about to drop the 'opExpr' AST on the floor. we've already reported an error. attempt to get name resolutions before dropping it RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects cenv env tpenv opExpr dataCompPrior | Some contExpr -> consumeClauses varSpace dataCompPrior contExpr lastUsesBind @@ -7982,7 +7982,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv match optionalCont with | None -> - match optionalIntoPat with + match optionalIntoPat with | Some intoPat -> errorR(Error(FSComp.SR.tcIntoNeedsRestOfQuery(), intoPat.Range)) | None -> () dataCompAfterOp @@ -8042,7 +8042,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv if isQuery && not(innerComp1.IsArbExprAndThusAlreadyReportedError) then match innerComp1 with - | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential + | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential | _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(), innerComp1.RangeOfFirstPortion)) match tryTrans true false varSpace innerComp1 id with @@ -8055,7 +8055,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | SynExpr.IfThenElse (_, _, _, _, _, mIfToThen, _m) -> mIfToThen | SynExpr.Match (SequencePointAtBinding mMatch, _, _, _) -> mMatch | SynExpr.TryWith (_, _, _, _, _, SequencePointAtTry mTry, _) -> mTry - | SynExpr.TryFinally (_, _, _, SequencePointAtTry mTry, _) -> mTry + | SynExpr.TryFinally (_, _, _, SequencePointAtTry mTry, _) -> mTry | SynExpr.For (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind | SynExpr.ForEach (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind | SynExpr.While (SequencePointAtWhileLoop mWhile, _, _, _) -> mWhile @@ -8128,7 +8128,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv 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)) + // 'let! pat = expr in expr' --> build.Bind(e1, (function _argN -> match _argN with pat -> expr)) | SynExpr.LetOrUseBang(spBind, false, isFromSource, pat, rhsExpr, innerComp, _) -> let bindRange = match spBind with SequencePointAtBinding(m) -> m | _ -> rhsExpr.Range @@ -8146,10 +8146,10 @@ 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) - translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr]))) + 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, _) + // '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, _) -> let bindRange = match spBind with SequencePointAtBinding(m) -> m | _ -> rhsExpr.Range @@ -8187,7 +8187,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv 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) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryWith" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"), mTry)) + 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])) @@ -8241,7 +8241,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv else if isQuery && not comp.IsArbExprAndThusAlreadyReportedError then match comp with - | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential + | 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))) @@ -8272,9 +8272,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv match comp with | SynExpr.YieldOrReturn ((true, _), _, _) -> { env with eContextInfo = ContextInfo.YieldInComputationExpression } | SynExpr.YieldOrReturn ((_, true), _, _) -> { env with eContextInfo = ContextInfo.ReturnInComputationExpression } - | _ -> env + | _ -> env - let lambdaExpr , tpenv= TcExpr cenv (builderTy --> overallTy) env tpenv lambdaExpr + let lambdaExpr, tpenv= TcExpr cenv (builderTy --> overallTy) env tpenv lambdaExpr // beta-var-reduce to bind the builder using a 'let' binding let coreExpr = mkApps cenv.g ((lambdaExpr, tyOfExpr cenv.g lambdaExpr), [], [interpExpr], mBuilderVal) @@ -8330,7 +8330,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = let matchv, matchExpr = compileSeqExprMatchClauses cenv env enumExprMark (pat', vspecs) innerExpr None enumElemTy genOuterTy let lam = mkLambda enumExprMark matchv (matchExpr, tyOfExpr cenv.g matchExpr) - Some(mkSeqCollect cenv env m enumElemTy genOuterTy lam enumExpr , tpenv) + Some(mkSeqCollect cenv env m enumElemTy genOuterTy lam enumExpr, tpenv) | SynExpr.For (spBind, id, start, dir, finish, innerComp, m) -> Some(tcSequenceExprBody env genOuterTy tpenv (elimFastIntegerForLoop (spBind, id, start, dir, finish, innerComp, m))) @@ -8393,7 +8393,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = tpenv true comp - (fun x -> x) |> Some + (fun x -> x) |> Some // 'use x = expr in expr' | SynExpr.LetOrUse (_isRec, true, [Binding (_vis, NormalBinding, _, _, _, _, _, pat, _, rhsExpr, _, _spBind)], innerComp, wholeExprMark) -> @@ -8436,7 +8436,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = if not isYield then errorR(Error(FSComp.SR.tcUseYieldBangForMultipleResults(), m)) - AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genOuterTy genExprTy + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genOuterTy genExprTy Some(mkCoerceExpr(resultExpr, genOuterTy, m, genExprTy), tpenv) | SynExpr.YieldOrReturn((isYield, _), yieldExpr, m) -> @@ -8501,7 +8501,7 @@ and Propagate cenv overallTy env tpenv (expr: ApplicableExpr) exprty delayed = | DelayedDotLookup _ :: _ -> () | DelayedTypeApp (_, _mTypeArgs, mExprAndTypeArgs) :: delayedList' -> // Note this case should not occur: would eventually give an "Unexpected type application" error in TcDelayed - propagate isAddrOf delayedList' mExprAndTypeArgs exprty + propagate isAddrOf delayedList' mExprAndTypeArgs exprty | DelayedApp (_, arg, mExprAndArg) :: delayedList' -> let denv = env.DisplayEnv @@ -8517,7 +8517,7 @@ and Propagate cenv overallTy env tpenv (expr: ApplicableExpr) exprty delayed = valRefEq cenv.g vf cenv.g.nativeptr_tobyref_vref) -> true | _ -> false - propagate isAddrOf delayedList' mExprAndArg resultTy + propagate isAddrOf delayedList' mExprAndArg resultTy | _ -> let mArg = arg.Range @@ -8585,8 +8585,8 @@ and TcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFlag: ExprAtomic /// Convert the delayed identifiers to a dot-lookup. /// -/// TcItemThen: For StaticItem [.Lookup] , mPrior is the range of StaticItem -/// TcLookupThen: For expr.InstanceItem [.Lookup] , mPrior is the range of expr.InstanceItem +/// TcItemThen: For StaticItem [.Lookup], mPrior is the range of StaticItem +/// TcLookupThen: For expr.InstanceItem [.Lookup], mPrior is the range of expr.InstanceItem and delayRest rest mPrior delayed = match rest with | [] -> delayed @@ -8693,7 +8693,7 @@ 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 + | SynExpr.Tuple(false, args, _, _) when numArgTys > 1 -> Some args | SynExprParen(arg, _, _, _) | arg when numArgTys = 1 -> Some [arg] | _ -> None @@ -8870,7 +8870,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let tyargs, tpenv = TcTypesOrMeasures None cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mTypeArgs // FUTURE: can we do better than emptyTyparInst here, in order to display instantiations - // of type variables in the quick info provided in the IDE? But note we haven't yet even checked if the + // of type variables in the quick info provided in the IDE? But note we haven't yet even checked if the // number of type arguments is correct... CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) @@ -8992,7 +8992,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | 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.DotIndexedGet(synExpr, _, _, _) -> isSimpleArgument synExpr | SynExpr.ObjExpr _ | SynExpr.AnonRecd _ | SynExpr.While _ @@ -9025,7 +9025,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | SynExpr.ArbitraryAfterError(_, _) | SynExpr.FromParseError(_, _) | SynExpr.DiscardAfterMissingQualificationAfterDot(_, _) - | SynExpr.ImplicitZero _ + | SynExpr.ImplicitZero _ | SynExpr.YieldOrReturn _ | SynExpr.YieldOrReturnFrom _ | SynExpr.MatchBang _ @@ -9077,7 +9077,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty vref.Deref.SetHasBeenReferenced() CheckValAccessible mItem env.eAccessRights vref - CheckValAttributes cenv.g vref mItem |> CommitOperationResult + CheckValAttributes cenv.g vref mItem |> CommitOperationResult let vty = vref.Type let vty2 = if isByrefTy cenv.g vty then @@ -9109,7 +9109,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp) // We need to eventually record the type resolution for an expression, but this is done // inside PropagateThenTcDelayed, so we don't have to explicitly call 'CallExprHasTypeSink' here - PropagateThenTcDelayed cenv overallTy env tpenv mExprAndTypeArgs vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic otherDelayed + PropagateThenTcDelayed cenv overallTy env tpenv mExprAndTypeArgs vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic otherDelayed // Value get | _ -> @@ -9137,7 +9137,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let meths = pinfos |> GettersOfPropInfos let isByrefMethReturnSetter = meths |> List.exists (function (_,Some pinfo) -> isByrefTy cenv.g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false) if isByrefMethReturnSetter then - // x.P <- ... byref setter + // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm), mItem)) TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed else @@ -9206,7 +9206,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del let e2', tpenv = TcExprFlex cenv true false fieldTy env tpenv e2 let expr = mkStaticRecdFieldSet (rfinfo.RecdFieldRef, rfinfo.TypeInst, e2', mStmt) expr, tpenv - | _ -> + | _ -> let exprty = fieldTy let expr = match rfinfo.LiteralValue with @@ -9322,7 +9322,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let meths = pinfos |> GettersOfPropInfos let isByrefMethReturnSetter = meths |> List.exists (function (_,Some pinfo) -> isByrefTy cenv.g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false) if isByrefMethReturnSetter then - // x.P <- ... byref setter + // x.P <- ... byref setter 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 @@ -9375,7 +9375,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela | Item.ILField finfo -> // Get or set instance IL field - ILFieldInstanceChecks cenv.g cenv.amap ad mItem finfo + ILFieldInstanceChecks cenv.g cenv.amap ad mItem finfo let exprty = finfo.FieldType(cenv.amap, mItem) match delayed with @@ -9458,7 +9458,7 @@ and TcMethodApplicationThen objArgs // The 'obj' arguments in obj.M(...) and obj.M, if any m // The range of the object argument or whole application. We immediately union this with the range of the arguments mItem // The range of the item that resolved to the method name - methodName // string, name of the method + methodName // string, name of the method ad // accessibility rights of the caller mut // what do we know/assume about whether this method will mutate or not? isProp // is this a property call? Used for better error messages and passed to BuildMethodCall @@ -9466,7 +9466,7 @@ and TcMethodApplicationThen afterResolution // do we need to notify sink after overload resolution isSuperInit // is this a special invocation, e.g. a super-class constructor call. Passed through to BuildMethodCall args // the _syntactic_ method arguments, not yet type checked. - atomicFlag // is the expression atomic or not? + atomicFlag // is the expression atomic or not? delayed // further lookups and applications that follow this = @@ -9511,7 +9511,7 @@ and TcMethodApplication tpenv tyargsOpt objArgs - mMethExpr // range of the entire method expression + mMethExpr // range of the entire method expression mItem methodName (objTyOpt: TType option) @@ -9601,7 +9601,7 @@ and TcMethodApplication // member x.M(arg1, arg2) // being used with // x.M p - // We typecheck this as if it has been written "(fun (v1, v2) -> x.M(v1, v2)) p" + // We typecheck this as if it has been written "(fun (v1, v2) -> x.M(v1, v2)) p" // Without this rule this requires // x.M (fst p, snd p) | [calledMeth] @@ -9644,9 +9644,9 @@ and TcMethodApplication let UnifyMatchingSimpleArgumentTypes exprTy (calledMeth: MethInfo) = let curriedArgTys = GenerateMatchingSimpleArgumentTypes calledMeth let returnTy = - (exprTy, curriedArgTys) ||> List.fold (fun exprTy argTys -> + (exprTy, curriedArgTys) ||> List.fold (fun exprTy argTys -> let domainTy, resultTy = UnifyFunctionType None cenv denv mMethExpr exprTy - UnifyTypes cenv env mMethExpr domainTy (mkRefTupledTy cenv.g argTys) + UnifyTypes cenv env mMethExpr domainTy (mkRefTupledTy cenv.g argTys) resultTy) curriedArgTys, returnTy @@ -9685,7 +9685,7 @@ and TcMethodApplication | None, _ -> let domainTy, returnTy = UnifyFunctionType None cenv denv mMethExpr exprTy - let argTys = if isUnitTy cenv.g domainTy then [] else tryDestRefTupleTy cenv.g domainTy + let argTys = if isUnitTy cenv.g domainTy then [] else tryDestRefTupleTy cenv.g domainTy // Only apply this rule if a candidate method exists with this number of arguments let argTys = if candidates |> List.exists (CalledMethHasSingleArgumentGroupOfThisLength argTys.Length) then @@ -9747,7 +9747,7 @@ and TcMethodApplication UnifyMatchingSimpleArgumentTypes exprTy calledMeth | _ -> let domainTy, returnTy = UnifyFunctionType None cenv denv mMethExpr exprTy - let argTys = if isUnitTy cenv.g domainTy then [] else tryDestRefTupleTy cenv.g domainTy + let argTys = if isUnitTy cenv.g domainTy then [] else tryDestRefTupleTy cenv.g domainTy // Only apply this rule if a candidate method exists with this number of arguments let argTys = if candidates |> List.exists (CalledMethHasSingleArgumentGroupOfThisLength argTys.Length) then @@ -9775,15 +9775,15 @@ and TcMethodApplication match ExamineMethodForLambdaPropagation meth with | Some (unnamedInfo, namedInfo) -> let calledObjArgTys = meth.CalledObjArgTys(mMethExpr) - if (calledObjArgTys, callerObjArgTys) ||> Seq.forall2 (fun calledTy callerTy -> AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv cenv.css mMethExpr calledTy callerTy) then + if (calledObjArgTys, callerObjArgTys) ||> Seq.forall2 (fun calledTy callerTy -> AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv cenv.css mMethExpr calledTy callerTy) then yield (List.toArraySquared unnamedInfo, List.toArraySquared namedInfo) | None -> () |] else [| |] // Now typecheck the argument expressions - let unnamedCurriedCallerArgs, (lambdaPropagationInfo, tpenv) = TcUnnamedMethodArgs cenv env lambdaPropagationInfo tpenv unnamedCurriedCallerArgs - let namedCurriedCallerArgs, (_, tpenv) = TcMethodNamedArgs cenv env lambdaPropagationInfo tpenv namedCurriedCallerArgs + let unnamedCurriedCallerArgs, (lambdaPropagationInfo, tpenv) = TcUnnamedMethodArgs cenv env lambdaPropagationInfo tpenv unnamedCurriedCallerArgs + let namedCurriedCallerArgs, (_, tpenv) = TcMethodNamedArgs cenv env lambdaPropagationInfo tpenv namedCurriedCallerArgs unnamedCurriedCallerArgs, namedCurriedCallerArgs, None, exprTy, tpenv let preArgumentTypeCheckingCalledMethGroup = @@ -9821,7 +9821,7 @@ and TcMethodApplication if not uniquelyResolved then GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, mItem) (//freeInTypeLeftToRight cenv.g false returnTy @ - (unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.Type))) + (unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.Type))) let result, errors = ResolveOverloading csenv NoTrace methodName 0 None callerArgCounts ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy) @@ -9868,7 +9868,7 @@ and TcMethodApplication RaiseOperationResult errors match result with | None -> error(InternalError("at least one error should be returned by failed method overloading", mItem)) - | Some res -> res + | Some res -> res let finalCalledMethInfo = finalCalledMeth.Method let finalCalledMethInst = finalCalledMeth.CalledTyArgs @@ -9898,13 +9898,13 @@ and TcMethodApplication if (isInstance && finalCalledMethInfo.IsInstance && typeEquiv cenv.g finalCalledMethInfo.ApparentEnclosingType cenv.g.obj_ty && - (finalCalledMethInfo.LogicalName = "GetHashCode" || finalCalledMethInfo.LogicalName = "Equals")) then + (finalCalledMethInfo.LogicalName = "GetHashCode" || finalCalledMethInfo.LogicalName = "Equals")) then objArgs |> List.iter (fun expr -> ConstraintSolver.AddCxTypeMustSupportEquality env.DisplayEnv cenv.css mMethExpr NoTrace (tyOfExpr cenv.g expr)) // Uses of a Dictionary() constructor without an IEqualityComparer argument imply an equality constraint // on the first type argument. - if HasHeadType cenv.g cenv.g.tcref_System_Collections_Generic_Dictionary finalCalledMethInfo.ApparentEnclosingType && + if HasHeadType cenv.g cenv.g.tcref_System_Collections_Generic_Dictionary finalCalledMethInfo.ApparentEnclosingType && finalCalledMethInfo.IsConstructor && not (finalCalledMethInfo.GetParamDatas(cenv.amap, mItem, finalCalledMeth.CalledTyArgs) |> List.existsSquared (fun (ParamData(_, _, _, _, _, _, _, ty)) -> @@ -9932,8 +9932,8 @@ and TcMethodApplication // For unapplied 'e.M' we first evaluate 'e' outside the lambda, i.e. 'let v = e in (fun arg -> v.M(arg))' let objArgPreBinder, objArgs = match objArgs, lambdaVars with - | [objArg], Some _ -> - if finalCalledMethInfo.IsExtensionMember && finalCalledMethInfo.ObjArgNeedsAddress(cenv.amap, mMethExpr) then + | [objArg], Some _ -> + if finalCalledMethInfo.IsExtensionMember && finalCalledMethInfo.ObjArgNeedsAddress(cenv.amap, mMethExpr) then error(Error(FSComp.SR.tcCannotPartiallyApplyExtensionMethodForByref(finalCalledMethInfo.DisplayName), mMethExpr)) let objArgTy = tyOfExpr cenv.g objArg let v, ve = mkCompGenLocal mMethExpr "objectArg" objArgTy @@ -9960,7 +9960,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 @@ -10002,7 +10002,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" @@ -10012,14 +10012,14 @@ and TcMethodApplication // CallerSide optional arguments are largely for COM interop, e.g. to PIA assemblies for Word etc. // As a result we follow the VB and C# behavior here. // - // "1. If the parameter is statically typed as System.Object and does not have a value, then there are four cases: - // a. The parameter is marked with MarshalAs(IUnknown), MarshalAs(Interface), or MarshalAs(IDispatch). In this case we pass null. - // b. Else if the parameter is marked with IUnknownConstantAttribute. In this case we pass new System.Runtime.InteropServices.UnknownWrapper(null) - // c. Else if the parameter is marked with IDispatchConstantAttribute. In this case we pass new System.Runtime.InteropServices.DispatchWrapper(null) - // d. Else, we will pass Missing.Value. - // 2. Otherwise, if there is a value attribute, then emit the default value. - // 3. Otherwise, we emit default(T). - // 4. Finally, we apply conversions from the value to the parameter type. This is where the nullable conversions take place for VB. + // "1. If the parameter is statically typed as System.Object and does not have a value, then there are four cases: + // a. The parameter is marked with MarshalAs(IUnknown), MarshalAs(Interface), or MarshalAs(IDispatch). In this case we pass null. + // b. Else if the parameter is marked with IUnknownConstantAttribute. In this case we pass new System.Runtime.InteropServices.UnknownWrapper(null) + // c. Else if the parameter is marked with IDispatchConstantAttribute. In this case we pass new System.Runtime.InteropServices.DispatchWrapper(null) + // d. Else, we will pass Missing.Value. + // 2. Otherwise, if there is a value attribute, then emit the default value. + // 3. Otherwise, we emit default(T). + // 4. Finally, we apply conversions from the value to the parameter type. This is where the nullable conversions take place for VB. // - VB allows you to mark ref parameters as optional. The semantics of this is that we create a temporary // with type = type of parameter, load the optional value to it, and call the method. // - VB also allows you to mark arrays with Nothing as the optional value. @@ -10145,7 +10145,7 @@ and TcMethodApplication finalUnnamedCalledOutArgs |> List.map (fun calledArg -> let calledArgTy = calledArg.CalledArgumentType let outArgTy = destByrefTy cenv.g calledArgTy - let outv, outArgExpr = mkMutableCompGenLocal mMethExpr PrettyNaming.outArgCompilerGeneratedName outArgTy // mutable! + let outv, outArgExpr = mkMutableCompGenLocal mMethExpr PrettyNaming.outArgCompilerGeneratedName outArgTy // mutable! let expr = mkDefault(mMethExpr, outArgTy) let callerArg = CallerArg(calledArgTy, mMethExpr, false, mkValAddr mMethExpr false (mkLocalValRef outv)) let outArg = { NamedArgIdOpt=None;CalledArg=calledArg;CallerArg=callerArg } @@ -10182,7 +10182,7 @@ and TcMethodApplication 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 + let allArgsPreBinders, allArgsCoerced = List.map coerce allArgs |> List.unzip // Make the call expression let expr, exprty = @@ -10203,8 +10203,8 @@ and TcMethodApplication if isNil outArgTmpBinds then expr, exprty else let outArgTys = outArgExprs |> List.map (tyOfExpr cenv.g) - let expr = if isUnitTy cenv.g exprty then mkCompGenSequential mMethExpr expr (mkRefTupled cenv.g mMethExpr outArgExprs outArgTys) - else mkRefTupled cenv.g mMethExpr (expr :: outArgExprs) (exprty :: outArgTys) + let expr = if isUnitTy cenv.g exprty then mkCompGenSequential mMethExpr expr (mkRefTupled cenv.g mMethExpr outArgExprs outArgTys) + else mkRefTupled cenv.g mMethExpr (expr :: outArgExprs) (exprty :: outArgTys) let expr = mkLetsBind mMethExpr outArgTmpBinds expr expr, tyOfExpr cenv.g expr @@ -10217,7 +10217,7 @@ and TcMethodApplication else // This holds the result of the call let objv, objExpr = mkMutableCompGenLocal mMethExpr "returnVal" exprty // mutable in case it's a struct - // This expression mutates the properties on the result of the call + // This expression mutates the properties on the result of the call let setterExprPrebinders, propSetExpr = (mkUnit cenv.g mMethExpr, finalAssignedItemSetters) ||> List.mapFold (fun acc (AssignedItemSetter(id, setter, CallerArg(callerArgTy, m, isOptCallerArg, argExpr))) -> if isOptCallerArg then error(Error(FSComp.SR.tcInvalidOptionalAssignmentToPropertyOrField(), m)) @@ -10234,7 +10234,7 @@ and TcMethodApplication | AssignedILFieldSetter finfo -> // Get or set instance IL field - ILFieldInstanceChecks cenv.g cenv.amap ad m finfo + ILFieldInstanceChecks cenv.g cenv.amap ad m finfo let calledArgTy = finfo.FieldType (cenv.amap, m) let argExprPrebinder, argExpr = coerceExpr false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr let action = BuildILFieldSet cenv.g m objExpr finfo argExpr @@ -10255,7 +10255,7 @@ and TcMethodApplication argExprPrebinder, mkCompGenSequential m acc action) // now put them together - let expr = mkCompGenLet mMethExpr objv expr (mkCompGenSequential mMethExpr propSetExpr objExpr) + let expr = mkCompGenLet mMethExpr objv expr (mkCompGenSequential mMethExpr propSetExpr objExpr) setterExprPrebinders, expr // Build the lambda expression if any @@ -10294,14 +10294,14 @@ and TcMethodApplication and TcUnnamedMethodArgs cenv env lambdaPropagationInfo tpenv args = List.mapiFoldSquared (TcUnnamedMethodArg cenv env) (lambdaPropagationInfo, tpenv) args -and TcUnnamedMethodArg cenv env (lambdaPropagationInfo, tpenv) (i, j, CallerArg(argTy, mArg, isOpt, argExpr)) = +and TcUnnamedMethodArg cenv env (lambdaPropagationInfo, tpenv) (i, j, CallerArg(argTy, mArg, isOpt, argExpr)) = // Try to find the lambda propagation info for the corresponding unnamed argument at this position let lambdaPropagationInfoForArg = [| for (unnamedInfo, _) in lambdaPropagationInfo -> if i < unnamedInfo.Length && j < unnamedInfo.[i].Length then unnamedInfo.[i].[j] else NoInfo |] TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoForArg, CallerArg(argTy, mArg, isOpt, argExpr)) -and TcMethodNamedArgs cenv env lambdaPropagationInfo tpenv args = +and TcMethodNamedArgs cenv env lambdaPropagationInfo tpenv args = List.mapFoldSquared (TcMethodNamedArg cenv env) (lambdaPropagationInfo, tpenv) args and TcMethodNamedArg cenv env (lambdaPropagationInfo, tpenv) (CallerNamedArg(id, arg)) = @@ -10316,7 +10316,7 @@ and TcMethodNamedArg cenv env (lambdaPropagationInfo, tpenv) (CallerNamedArg(id, let arg', (lambdaPropagationInfo, tpenv) = TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoForArg, arg) CallerNamedArg(id, arg'), (lambdaPropagationInfo, tpenv) -and TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoForArg, CallerArg(argTy, mArg, isOpt, argExpr)) = +and TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoForArg, CallerArg(argTy, mArg, isOpt, argExpr)) = // Apply the F# 3.1 rule for extracting information for lambdas // @@ -10362,8 +10362,8 @@ and TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfo let lambdaPropagationInfo = [| for (info, argInfo) in Array.zip lambdaPropagationInfo lambdaPropagationInfoForArg do match argInfo with - | ArgDoesNotMatch _ -> () - | NoInfo | CallerLambdaHasArgTypes _ -> + | ArgDoesNotMatch _ -> () + | NoInfo | CallerLambdaHasArgTypes _ -> yield info | CalledArgMatchesType adjustedCalledTy -> if AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed env.DisplayEnv cenv.css mArg adjustedCalledTy argTy then @@ -10382,7 +10382,7 @@ and TcNewDelegateThen cenv overallTy env tpenv mDelTy mExprAndArg delegateTy arg match args with | [farg], [] -> let m = arg.Range - let callerArg, (_, tpenv) = TcMethodArg cenv env (Array.empty, tpenv) (Array.empty, CallerArg(fty, m, false, farg)) + let callerArg, (_, tpenv) = TcMethodArg cenv env (Array.empty, tpenv) (Array.empty, CallerArg(fty, m, false, farg)) let expr = BuildNewDelegateExpr (None, cenv.g, cenv.amap, delegateTy, invokeMethInfo, delArgTys, callerArg.Expr, fty, m) PropagateThenTcDelayed cenv overallTy env tpenv m (MakeApplicableExprNoFlex cenv expr) delegateTy atomicFlag delayed | _ -> @@ -10443,7 +10443,7 @@ and TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr expr cont = let thenExpr, tpenv = let env = match env.eContextInfo with - | ContextInfo.ElseBranchResult _ -> { env with eContextInfo = ContextInfo.ElseBranchResult synThenExpr.Range } + | ContextInfo.ElseBranchResult _ -> { env with eContextInfo = ContextInfo.ElseBranchResult synThenExpr.Range } | _ -> match synElseExprOpt with | None -> { env with eContextInfo = ContextInfo.OmittedElseBranch synThenExpr.Range } @@ -10485,7 +10485,7 @@ and TcMatchPattern cenv inputTy env tpenv (pat: SynPat, optWhenExpr) = match optWhenExpr with | Some whenExpr -> let guardEnv = { envinner with eContextInfo = ContextInfo.PatternMatchGuard whenExpr.Range } - let whenExpr', tpenv = TcExpr cenv cenv.g.bool_ty guardEnv tpenv whenExpr + let whenExpr', tpenv = TcExpr cenv cenv.g.bool_ty guardEnv tpenv whenExpr Some whenExpr', tpenv | None -> None, tpenv patf' (TcPatPhase2Input (values, true)), optWhenExpr', NameMap.range vspecMap, envinner, tpenv @@ -10524,11 +10524,11 @@ and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBindi match overallExprTy with | ty when isByrefTy cenv.g ty -> let okByRef = - match stripExpr fixedExpr with + match stripExpr fixedExpr with | 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 @@ -10538,7 +10538,7 @@ and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBindi let elemTy = destByrefTy cenv.g overallExprTy UnifyTypes cenv env mBinding (mkNativePtrTy cenv.g elemTy) overallPatTy - mkCompGenLetIn mBinding "pinnedByref" ty fixedExpr (fun (v, ve) -> + mkCompGenLetIn mBinding "pinnedByref" ty fixedExpr (fun (v, ve) -> v.SetIsFixed() mkConvToNativeInt cenv.g ve mBinding) @@ -10580,7 +10580,7 @@ and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBindi // check for non-null and non-empty let zero = mkConvToNativeInt cenv.g (mkInt32 cenv.g mBinding 0) mBinding // This is arr.Length - let arrayLengthExpr = mkCallArrayLength cenv.g mBinding elemTy ve + let arrayLengthExpr = mkCallArrayLength cenv.g mBinding elemTy ve mkNullTest cenv.g mBinding ve (mkNullTest cenv.g mBinding arrayLengthExpr (mkCompGenLetIn mBinding "pinnedByref" (mkByrefTy cenv.g elemTy) elemZeroAddress (fun (v, ve) -> @@ -10708,8 +10708,8 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt let apinfoOpt = match NameMap.range nameToPrelimValSchemeMap with | [PrelimValScheme1(id, _, ty, _, _, _, _, _, _, _, _) ] -> - match ActivePatternInfoOfValName id.idText id.idRange with - | Some apinfo -> Some (apinfo, ty, id.idRange) + match ActivePatternInfoOfValName id.idText id.idRange with + | Some apinfo -> Some (apinfo, ty, id.idRange) | None -> None | _ -> None @@ -10811,7 +10811,7 @@ and TcBindingTyparDecls alwaysRigid cenv env tpenv (SynValTyparDecls(synTypars, declaredTypars |> List.iter (fun tp -> tp.SetRigidity TyparRigidity.WillBeRigid) rigidCopyOfDeclaredTypars - ExplicitTyparInfo(rigidCopyOfDeclaredTypars, declaredTypars, infer) , tpenv + ExplicitTyparInfo(rigidCopyOfDeclaredTypars, declaredTypars, infer), tpenv and TcNonrecBindingTyparDecls cenv env tpenv bind = let (NormalizedBinding(_, _, _, _, _, _, synTyparDecls, _, _, _, _, _)) = bind @@ -10826,12 +10826,12 @@ and TcNonRecursiveBinding declKind cenv env tpenv ty b = // TcAttribute* //------------------------------------------------------------------------ -and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = +and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = let (LongIdentWithDots(tycon, _)) = synAttr.TypeName - let arg = synAttr.ArgExpr - let targetIndicator = synAttr.Target + let arg = synAttr.ArgExpr + let targetIndicator = synAttr.Target let isAppliedToGetterOrSetter = synAttr.AppliesToGetterAndSetter - let mAttr = synAttr.Range + let mAttr = synAttr.Range let (typath, tyid) = List.frontAndBack tycon let tpenv = emptyUnscopedTyparEnv @@ -10843,9 +10843,9 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = let tyid = mkSynId tyid.idRange n 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 + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with | Exception err -> raze(err) - | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv (SynType.App(SynType.LongIdent(LongIdentWithDots(tycon, [])), None, [], [], None, false, mAttr)) ) + | _ -> 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))) let ad = env.eAccessRights @@ -10887,7 +10887,7 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = AttribBoolArg(_allowMultiple) AttribBoolArg(inherited)], _, _, _, _)) -> (validOn, inherited) - | Some _ -> + | Some _ -> warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) (validOnDefault, inheritedDefault) | _ -> @@ -10902,10 +10902,10 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = | Some id when id.idText = "property" -> AttributeTargets.Property | Some id when id.idText = "method" -> AttributeTargets.Method | Some id when id.idText = "param" -> AttributeTargets.Parameter - | Some id when id.idText = "type" -> AttributeTargets.TyconDecl - | Some id when id.idText = "constructor" -> AttributeTargets.Constructor - | Some id when id.idText = "event" -> AttributeTargets.Event - | Some id -> + | Some id when id.idText = "type" -> AttributeTargets.TyconDecl + | Some id when id.idText = "constructor" -> AttributeTargets.Constructor + | Some id when id.idText = "event" -> AttributeTargets.Event + | Some id -> errorR(Error(FSComp.SR.tcUnrecognizedAttributeTarget(), id.idRange)) possibleTgts | _ -> possibleTgts @@ -10927,7 +10927,7 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = let meths = minfos |> List.map (fun minfo -> minfo, None) let afterResolution = ForNewConstructors cenv.tcSink env tyid.idRange methodName minfos let (expr, attributeAssignedNamedItems, _), _ = - TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (NewInferenceType ()) [] + TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (NewInferenceType ()) [] UnifyTypes cenv env mAttr ty (tyOfExpr cenv.g expr) @@ -10950,12 +10950,12 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = CheckILFieldAttributes cenv.g finfo m id.idText, false, finfo.FieldType(cenv.amap, m) | Item.RecdField rfinfo when not rfinfo.IsStatic -> - CheckRecdFieldInfoAttributes cenv.g rfinfo m |> CommitOperationResult + CheckRecdFieldInfoAttributes cenv.g rfinfo m |> CommitOperationResult CheckRecdFieldInfoAccessible cenv.amap m ad rfinfo // This uses the F# backend name mangling of fields.... - let nm = ComputeFieldName rfinfo.Tycon rfinfo.RecdField + let nm = ComputeFieldName rfinfo.Tycon rfinfo.RecdField nm, false, rfinfo.FieldType - | _ -> + | _ -> errorR(Error(FSComp.SR.tcPropertyOrFieldNotFoundInAttribute(), m)) id.idText, false, cenv.g.unit_ty let propNameItem = Item.SetterArg(id, setterItem) @@ -10973,7 +10973,7 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = 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 + 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) | _ -> @@ -11039,9 +11039,9 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds // Generalize the bindings... (((fun x -> x), env, tpenv), checkedBinds) ||> List.fold (fun (buildExpr, env, tpenv) tbinfo -> let (CheckedBindingInfo(inlineFlag, attrs, doc, tcPatPhase2, flex, nameToPrelimValSchemeMap, rhsExpr, _, tauTy, m, spBind, _, konst, isFixed)) = tbinfo - let enclosingDeclaredTypars = [] + let enclosingDeclaredTypars = [] let (ExplicitTyparInfo(_, declaredTypars, canInferTypars)) = flex - let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars + let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars let generalizedTypars, prelimValSchemes2 = let canInferTypars = GeneralizationHelpers. ComputeCanInferExtraGeneralizableTypars (containerInfo.ParentRef, canInferTypars, None) @@ -11056,7 +11056,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv, denv, m, freeInEnv, canInferTypars, canConstrain, inlineFlag, Some rhsExpr, allDeclaredTypars, maxInferredTypars, tauTy, false) - let prelimValSchemes2 = GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars nameToPrelimValSchemeMap + let prelimValSchemes2 = GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars nameToPrelimValSchemeMap generalizedTypars, prelimValSchemes2 @@ -11076,7 +11076,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds | (TPat_wild _ | TPat_const (Const.Unit, _)) when not isUse && not isFixed && isNil generalizedTypars -> let mkSequentialBind (tm, tmty) = (mkSequential SequencePointsAtSeq m rhsExpr tm, tmty) - (buildExpr >> mkSequentialBind , env, tpenv) + (buildExpr >> mkSequentialBind, env, tpenv) | _ -> // nice: don't introduce awful temporary for r.h.s. in the 99% case where we know what we're binding it to @@ -11089,7 +11089,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds v, pat //Op (LValueOp (LByrefGet,x),[],[],C:\GitHub\dsyme\visualfsharp\a.fs (15,42--15,43) IsSynthetic=false) - | _ when inlineFlag.MustInline -> + | _ when inlineFlag.MustInline -> error(Error(FSComp.SR.tcInvalidInlineSpecification(), m)) | _ -> @@ -11106,7 +11106,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds tmp, checkedPat - // Add the bind "let patternInputTmp = rhsExpr" to the bodyExpr we get from mkPatBind + // Add the bind "let patternInputTmp = rhsExpr" to the bodyExpr we get from mkPatBind let mkRhsBind (bodyExpr, bodyExprTy) = let letExpr = mkLet spBind m patternInputTmp rhsExpr bodyExpr letExpr, bodyExprTy @@ -11133,7 +11133,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds let envInner = AddLocalValMap cenv.tcSink scopem prelimRecValues env - ((buildExpr >> mkCleanup >> mkPatBind >> mkRhsBind), envInner, tpenv)) + ((buildExpr >> mkCleanup >> mkPatBind >> mkRhsBind), envInner, tpenv)) /// Return binds corresponding to the linearised let-bindings. /// This reveals the bound items, e.g. when the lets occur in incremental object defns. @@ -11149,8 +11149,8 @@ and TcLetBindings cenv env containerInfo declKind tpenv (binds, bindsm, scopem) let unite = mkUnit cenv.g bindsm let expr, _ = mkf (unite, cenv.g.unit_ty) let rec stripLets acc = function - | Expr.Let (bind, body, m, _) -> stripLets (TMDefLet(bind, m) :: acc) body - | Expr.Sequential (e1, e2, NormalSeq, _, m) -> stripLets (TMDefDo(e1, m) :: acc) e2 + | Expr.Let (bind, body, m, _) -> stripLets (TMDefLet(bind, m) :: acc) body + | Expr.Sequential (e1, e2, NormalSeq, _, m) -> stripLets (TMDefDo(e1, m) :: acc) e2 | Expr.Const (Const.Unit, _, _) -> List.rev acc | _ -> failwith "TcLetBindings: let sequence is non linear. Maybe a LHS pattern was not linearised?" let binds = stripLets [] expr @@ -11404,7 +11404,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl match memberFlags.MemberKind with // Explicit struct or class constructor - | MemberKind.Constructor -> + | MemberKind.Constructor -> // A fairly adhoc place to put this check if tcref.IsStructOrEnumTycon && (match valSynInfo with SynValInfo([[]], _) -> true | _ -> false) then errorR(Error(FSComp.SR.tcStructsCannotHaveConstructorWithNoArguments(), mBinding)) @@ -11600,7 +11600,7 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv // Do the type annotations give the full and complete generic type? // If so, generic recursion can be used when using this type. - let isComplete = ComputeIsComplete enclosingDeclaredTypars declaredTypars ty + let isComplete = ComputeIsComplete enclosingDeclaredTypars declaredTypars ty // NOTE: The type scheme here is normally not 'complete'!!!! The type is more or less just a type variable at this point. // NOTE: toparity, type and typars get fixed-up after inference @@ -11626,7 +11626,7 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv // Suppress hover tip for "get" and "set" at property definitions, where toolId <> bindingId match toolIdOpt with - | Some tid when not tid.idRange.IsSynthetic && tid.idRange <> bindingId.idRange -> + | Some tid when not tid.idRange.IsSynthetic && tid.idRange <> bindingId.idRange -> let item = Item.Value (mkLocalValRef vspec) CallNameResolutionSink cenv.tcSink (tid.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.RelatedText, env.DisplayEnv, env.eAccessRights) | _ -> () @@ -11684,7 +11684,7 @@ and TcLetrecBinding let allDeclaredTypars = enclosingDeclaredTypars @ rbind.RecBindingInfo.DeclaredTypars // Notes on FSharp 1.0, 3187: - // - Progressively collect the "eligible for early generalization" set of bindings -- DONE + // - Progressively collect the "eligible for early generalization" set of bindings -- DONE // - After checking each binding, check this set to find generalizable bindings // - The only reason we can't generalize is if a binding refers to type variables to which // additional constraints may be applied as part of checking a later binding @@ -11769,7 +11769,7 @@ and TcIncrementalLetRecGeneralization cenv scopem // to type variables free in later bindings. Look for ones whose type doesn't involve any of the other types let newGeneralizedRecBinds, preGeneralizationRecBinds, tpenv = - //printfn "\n---------------------\nConsidering early generalization after type checking binding %s" vspec.DisplayName + //printfn "\n---------------------\nConsidering early generalization after type checking binding %s" vspec.DisplayName // Get the type variables free in bindings that have not yet been checked. // @@ -11829,14 +11829,14 @@ and TcIncrementalLetRecGeneralization cenv scopem //printfn "(failed generalization test 1 for binding for %s)" pgrbind.RecBindingInfo.Val.DisplayName // Any declared type parameters in an type are always generalizable - let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) + let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) if freeInBinding.IsEmpty then true else //printfn "(failed generalization test 2 for binding for %s)" pgrbind.RecBindingInfo.Val.DisplayName // Any declared method parameters can always be generalized - let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.RecBindingInfo.DeclaredTypars)) + let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.RecBindingInfo.DeclaredTypars)) if freeInBinding.IsEmpty then true else @@ -11844,7 +11844,7 @@ and TcIncrementalLetRecGeneralization cenv scopem // Type variables free in the non-recursive environment do not stop us generalizing the binding, // since they can't be generalized anyway - let freeInBinding = Zset.diff freeInBinding freeInEnv + let freeInBinding = Zset.diff freeInBinding freeInEnv if freeInBinding.IsEmpty then true else @@ -11892,8 +11892,8 @@ and TcIncrementalLetRecGeneralization cenv scopem freeInEnv else let freeInBinding = (freeInType CollectAllNoCaching pgrbind.RecBindingInfo.Val.TauType).FreeTypars - let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) - let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.RecBindingInfo.DeclaredTypars)) + let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) + let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.RecBindingInfo.DeclaredTypars)) Zset.union freeInBinding freeInEnv) // Process the bindings marked for transition from PreGeneralization --> PostGeneralization @@ -11925,7 +11925,7 @@ and TcIncrementalLetRecGeneralization cenv scopem //------------------------------------------------------------------------- /// Compute the type variables which may be generalized and perform the generalization -and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgrbind: PreGeneralizationRecursiveBinding) = +and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgrbind: PreGeneralizationRecursiveBinding) = let freeInEnv = Zset.diff freeInEnv (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) @@ -12083,7 +12083,7 @@ and FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock (bind: PostBind | Some _ -> #endif match PartitionValTyparsForApparentEnclosingType cenv.g vspec with - | Some(parentTypars, memberParentTypars, _, _, _) -> + | Some(parentTypars, memberParentTypars, _, _, _) -> ignore(SignatureConformance.Checker(cenv.g, cenv.amap, denv, SignatureRepackageInfo.Empty, false).CheckTypars vspec.Range TypeEquivEnv.Empty memberParentTypars parentTypars) | None -> errorR(Error(FSComp.SR.tcMemberIsNotSufficientlyGeneric(), vspec.Range)) @@ -12106,7 +12106,7 @@ and FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock (bind: PostBind and unionGeneralizedTypars typarSets = List.foldBack (ListSet.unionFavourRight typarEq) typarSets [] -and TcLetrec overridesOK cenv env tpenv (binds, bindsm, scopem) = +and TcLetrec overridesOK cenv env tpenv (binds, bindsm, scopem) = // Create prelimRecValues for the recursive items (includes type info from LHS of bindings) *) let binds = binds |> List.map (fun (RecDefnBindingInfo(a, b, c, bind)) -> NormalizedRecBindingDefn(a, b, c, BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env bind)) @@ -12115,7 +12115,7 @@ and TcLetrec overridesOK cenv env tpenv (binds, bindsm, scopem) = let envRec = AddLocalVals cenv.tcSink scopem prelimRecValues env // Typecheck bindings - let uncheckedRecBindsTable = uncheckedRecBinds |> List.map (fun rbind -> rbind.RecBindingInfo.Val.Stamp, rbind) |> Map.ofList + let uncheckedRecBindsTable = uncheckedRecBinds |> List.map (fun rbind -> rbind.RecBindingInfo.Val.Stamp, rbind) |> Map.ofList let (_, generalizedRecBinds, preGeneralizationRecBinds, tpenv, _) = ((env, [], [], tpenv, uncheckedRecBindsTable), uncheckedRecBinds) ||> List.fold (TcLetrecBinding (cenv, envRec, scopem, [], None)) @@ -12276,7 +12276,7 @@ module TcRecdUnionAndEnumDeclarations = begin if isIncrClass && (not zeroInit || not isMutable) then errorR(Error(FSComp.SR.tcUninitializedValFieldsMustBeMutable(), m)) if isStatic && (not zeroInit || not isMutable || vis <> Some SynAccess.Private ) then errorR(Error(FSComp.SR.tcStaticValFieldsMustBeMutableAndPrivate(), m)) let konst = if zeroInit then Some Const.Zero else None - let rfspec = MakeRecdFieldSpec cenv env parent (isStatic, konst, ty', attrsForProperty, attrsForField, id, nameGenerated, isMutable, isVolatile, xmldoc, vis, m) + let rfspec = MakeRecdFieldSpec cenv env parent (isStatic, konst, ty', attrsForProperty, attrsForField, id, nameGenerated, isMutable, isVolatile, xmldoc, vis, m) match parent with | Parent tcref when useGenuineField tcref.Deref rfspec -> // Recheck the attributes for errors if the definition only generates a field @@ -12333,7 +12333,7 @@ module TcRecdUnionAndEnumDeclarations = begin else seen.Add(f.Name, sf) - let TcUnionCaseDecl cenv env parent thisTy tpenv (UnionCase (synAttrs, id, args, xmldoc, vis, m)) = + let TcUnionCaseDecl cenv env parent thisTy tpenv (UnionCase (synAttrs, id, args, xmldoc, vis, m)) = let attrs = TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs // the attributes of a union case decl get attached to the generated "static factory" method let vis, _ = ComputeAccessAndCompPath env None m vis None parent let vis = CombineReprAccess parent vis @@ -12385,7 +12385,7 @@ module TcRecdUnionAndEnumDeclarations = begin let TcEnumDecls cenv env parent thisTy enumCases = let fieldTy = NewInferenceType () - let enumCases' = enumCases |> List.map (TcEnumDecl cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element" + let enumCases' = enumCases |> List.map (TcEnumDecl cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element" fieldTy, enumCases' end @@ -12397,7 +12397,7 @@ end let PublishInterface cenv denv (tcref: TyconRef) m compgen ty' = if not (isInterfaceTy cenv.g ty') then errorR(Error(FSComp.SR.tcTypeIsNotInterfaceType1(NicePrint.minimalStringOfType denv ty'), m)) let tcaug = tcref.TypeContents - if tcref.HasInterface cenv.g ty' then + if tcref.HasInterface cenv.g ty' then errorR(Error(FSComp.SR.tcDuplicateSpecOfInterface(), m)) tcaug.tcaug_interfaces <- (ty', compgen, m) :: tcaug.tcaug_interfaces @@ -12413,7 +12413,7 @@ let TcAndPublishMemberSpec cenv env containerInfo declKind tpenv memb = [], tpenv -let TcTyconMemberSpecs cenv env containerInfo declKind tpenv (augSpfn: SynMemberSigs) = +let TcTyconMemberSpecs cenv env containerInfo declKind tpenv (augSpfn: SynMemberSigs) = let members, tpenv = List.mapFold (TcAndPublishMemberSpec cenv env containerInfo declKind) tpenv augSpfn List.concat members, tpenv @@ -12432,7 +12432,7 @@ let TcModuleOrNamespaceLidAndPermitAutoResolve tcSink env amap (longId: Ident li | Result res -> Result res | Exception err -> raze err -let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = +let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = let modrefs = ForceRaise (TcModuleOrNamespaceLidAndPermitAutoResolve tcSink env amap longId) // validate opened namespace names @@ -12476,7 +12476,7 @@ let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = // Bug FSharp 1.0 3133: 'open Lexing'. Skip this warning if we successfully resolved to at least a module name if not (modrefs |> List.exists (fun (_, modref, _) -> modref.IsModule && not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs))) then modrefs |> List.iter (fun (_, modref, _) -> - if IsPartiallyQualifiedNamespace modref then + if IsPartiallyQualifiedNamespace modref then errorR(Error(FSComp.SR.tcOpenUsedWithPartiallyQualifiedPath(fullDisplayTextOfModRef modref), m))) let modrefs = List.map p23 modrefs @@ -12578,14 +12578,14 @@ module IncrClassChecking = let ctorTy = mkFunTy argty objTy // REVIEW: no attributes can currently be specified for the implicit constructor let attribs = TcAttributes cenv env (AttributeTargets.Constructor ||| AttributeTargets.Method) attrs - let memberFlags = CtorMemberFlags + let memberFlags = CtorMemberFlags - let synArgInfos = List.map (SynInfo.InferSynArgInfoFromSimplePat []) spats + let synArgInfos = List.map (SynInfo.InferSynArgInfoFromSimplePat []) spats let valSynData = SynValInfo([synArgInfos], SynInfo.unnamedRetVal) - let id = ident ("new", m) + let id = ident ("new", m) CheckForNonAbstractInterface ModuleOrMemberBinding tcref memberFlags id.idRange - let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, false, attribs, [], memberFlags, valSynData, id, false) + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, false, attribs, [], memberFlags, valSynData, id, false) let partialValReprInfo = TranslateTopValSynInfo m (TcAttributes cenv env) valSynData let prelimTyschemeG = TypeScheme(copyOfTyconTypars, ctorTy) let isComplete = ComputeIsComplete copyOfTyconTypars [] ctorTy @@ -12605,7 +12605,7 @@ module IncrClassChecking = let valSynData = SynValInfo([[]], SynInfo.unnamedRetVal) let id = ident ("cctor", m) CheckForNonAbstractInterface ModuleOrMemberBinding tcref ClassCtorMemberFlags id.idRange - let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, false, [(*no attributes*)], [], ClassCtorMemberFlags, valSynData, id, false) + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, false, [(*no attributes*)], [], ClassCtorMemberFlags, valSynData, id, false) let partialValReprInfo = TranslateTopValSynInfo m (TcAttributes cenv env) valSynData let prelimTyschemeG = TypeScheme(copyOfTyconTypars, cctorTy) let topValInfo = InferGenericArityFromTyScheme prelimTyschemeG partialValReprInfo @@ -12616,23 +12616,23 @@ module IncrClassChecking = 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 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) thisVal - {TyconRef = tcref - InstanceCtorDeclaredTypars = copyOfTyconTypars - StaticCtorValInfo = cctorValInfo - InstanceCtorArgs = ctorArgs - InstanceCtorVal = ctorVal - InstanceCtorValScheme = ctorValScheme - InstanceCtorBaseValOpt = baseValOpt - InstanceCtorSafeThisValOpt = safeThisValOpt - InstanceCtorSafeInitInfo = safeInitInfo - InstanceCtorThisVal = thisVal + {TyconRef = tcref + InstanceCtorDeclaredTypars = copyOfTyconTypars + StaticCtorValInfo = cctorValInfo + InstanceCtorArgs = ctorArgs + InstanceCtorVal = ctorVal + InstanceCtorValScheme = ctorValScheme + InstanceCtorBaseValOpt = baseValOpt + InstanceCtorSafeThisValOpt = safeThisValOpt + InstanceCtorSafeInitInfo = safeInitInfo + InstanceCtorThisVal = thisVal // For generating names of local fields - NameGenerator = NiceNameGenerator() + NameGenerator = NiceNameGenerator() } @@ -12646,8 +12646,8 @@ module IncrClassChecking = /// Field specifications added to a tcref must be in terms of the tcrefs formal typars. let private MakeIncrClassField(g, cpath, formalTyparInst: TyparInst, v: Val, isStatic, rfref: RecdFieldRef) = let name = rfref.FieldName - let id = ident (name, v.Range) - let ty = v.Type |> instType formalTyparInst + let id = ident (name, v.Range) + let ty = v.Type |> instType formalTyparInst let taccess = TAccess [cpath] let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute v.Attribs @@ -12781,7 +12781,7 @@ module IncrClassChecking = 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 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) @@ -12803,7 +12803,7 @@ module IncrClassChecking = member localRep.IsValWithRepresentation (v: Val) = localRep.ValsWithRepresentation.Contains(v) - member localRep.IsValRepresentedAsLocalVar (v: Val) = + member localRep.IsValRepresentedAsLocalVar (v: Val) = match localRep.LookupRepr v with | InVar false -> true | _ -> false @@ -12811,7 +12811,7 @@ module IncrClassChecking = member localRep.IsValRepresentedAsMethod (v: Val) = localRep.IsValWithRepresentation(v) && match localRep.LookupRepr(v) with - | InMethod _ -> true + | InMethod _ -> true | _ -> false /// Make the elaborated expression that represents a use of a @@ -12879,13 +12879,13 @@ module IncrClassChecking = /// Used as part of processing "let" bindings in a type definition. member localRep.PublishIncrClassFields (cenv, denv, cpath, ctorInfo: IncrClassCtorLhs, safeStaticInitInfo) = let tcref = ctorInfo.TyconRef - let rfspecs = + let rfspecs = [ for KeyValue(v, repr) in localRep.ValReprs do match repr with | InField(isStatic, _, rfref) -> // Instance fields for structs are published earlier because the full set of fields is determined syntactically from the implicit // constructor arguments. This is important for the "default value" and "does it have an implicit default constructor" - // semantic conditions for structs - see bug FSharp 1.0 5304. + // semantic conditions for structs - see bug FSharp 1.0 5304. if isStatic || not tcref.IsFSharpStructOrEnumTycon then let ctorDeclaredTypars = ctorInfo.GetNormalizedInstanceCtorDeclaredTypars cenv denv ctorInfo.TyconRef.Range @@ -12938,13 +12938,13 @@ module IncrClassChecking = 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) + | 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) + | Expr.Op(TOp.LValueOp (LAddrOf readonly, ValDeref v), [], [], m) when localRep.IsValWithRepresentation(v) -> Some (localRep.MakeValueGetAddress readonly thisValOpt thisTyInst safeStaticInitInfo v m) @@ -12980,7 +12980,7 @@ module IncrClassChecking = let denv = env.DisplayEnv - let thisVal = ctorInfo.InstanceCtorThisVal + let thisVal = ctorInfo.InstanceCtorThisVal let m = thisVal.Range let ctorDeclaredTypars = ctorInfo.GetNormalizedInstanceCtorDeclaredTypars cenv denv m @@ -13039,7 +13039,7 @@ module IncrClassChecking = else unionFreeVars staticForcedFieldVars (freeInExpr CollectLocalsNoCaching e) (staticForcedFieldVars, instanceForcedFieldVars))) - let staticForcedFieldVars = (staticForcedFieldVars, memberBinds) ||> accFreeInBindings + let staticForcedFieldVars = (staticForcedFieldVars, memberBinds) ||> accFreeInBindings let instanceForcedFieldVars = (instanceForcedFieldVars, memberBinds) ||> accFreeInBindings // Any references to static variables in the 'inherits' expression force those static variables to be represented as fields @@ -13096,7 +13096,7 @@ module IncrClassChecking = let m = match spBind, rhsExpr with // Don't generate big sequence points for functions in classes - | _, (Expr.Lambda _ | Expr.TyLambda _) -> v.Range + | _, (Expr.Lambda _ | Expr.TyLambda _) -> v.Range | SequencePointAtBinding m, _ -> m | _ -> v.Range let assignExpr = reps.MakeValueAssign (Some thisVal) thisTyInst NoSafeInitInfo v rhsExpr m @@ -13122,17 +13122,17 @@ module IncrClassChecking = match dec with | (IncrClassBindingGroup(binds, isStatic, isRec)) -> let actions, reps, methodBinds = - let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, ctorInfo, staticForcedFieldVars, instanceForcedFieldVars, bind)) // extend + let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, ctorInfo, staticForcedFieldVars, instanceForcedFieldVars, bind)) // extend if isRec then // Note: the recursive calls are made via members on the object // or via access to fields. This means the recursive loop is "broken", // and we can collapse to sequential bindings - let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // inscope before + let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // inscope before let actions, methodBinds = binds |> List.map (TransBind reps) |> List.unzip // since can occur in RHS of own defns actions, reps, methodBinds else - let actions, methodBinds = binds |> List.map (TransBind reps) |> List.unzip - let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // inscope after + let actions, methodBinds = binds |> List.map (TransBind reps) |> List.unzip + let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // inscope after actions, reps, methodBinds let methodBinds = List.concat methodBinds if isStatic then @@ -13158,7 +13158,7 @@ module IncrClassChecking = | Phase2CCtorJustAfterSuperInit -> let binders = [ match ctorInfo.InstanceCtorSafeThisValOpt with - | None -> () + | None -> () | Some v -> let setExpr = mkRefCellSet cenv.g m ctorInfo.InstanceCtorThisVal.Type (exprForVal m v) (exprForVal m ctorInfo.InstanceCtorThisVal) let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some(thisVal)) safeStaticInitInfo thisTyInst setExpr @@ -13242,7 +13242,7 @@ module IncrClassChecking = // This ref cell itself may be stored in a field of the object and accessed via arg0. // Likewise the incoming arguments will eventually be stored in fields and accessed via arg0. // - // As a result, the most natural way to implement this would be to simply capture arg0 if needed + // 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 // However, the rules of IL mean we are not actually allowed to capture arg0 @@ -13306,20 +13306,20 @@ module MutRecBindingChecking = /// Represents one element in a type definition, after the first phase type TyconBindingPhase2A = /// An entry corresponding to the definition of the implicit constructor for a class - | Phase2AIncrClassCtor of IncrClassCtorLhs + | Phase2AIncrClassCtor of IncrClassCtorLhs /// An 'inherit' declaration in an incremental class /// /// Phase2AInherit (ty, arg, baseValOpt, m) - | Phase2AInherit of SynType * SynExpr * Val option * range + | Phase2AInherit of SynType * SynExpr * Val option * range /// A set of value or function definitions in an incremental class /// /// Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m) | Phase2AIncrClassBindings of TyconRef * Ast.SynBinding list * bool * bool * range /// A 'member' definition in a class - | Phase2AMember of PreCheckingRecursiveBinding + | Phase2AMember of PreCheckingRecursiveBinding #if OPEN_IN_TYPE_DECLARATIONS /// A dummy declaration, should we ever support 'open' in type definitions - | Phase2AOpen of LongIdent * range + | Phase2AOpen of LongIdent * range #endif /// Indicates the super init has just been called, 'this' may now be published | Phase2AIncrClassCtorJustAfterSuperInit @@ -13331,15 +13331,15 @@ module MutRecBindingChecking = | TyconBindingsPhase2A of Tycon option * DeclKind * Val list * TyconRef * Typar list * TType * TyconBindingPhase2A list /// The collected syntactic input definitions for a recursive group of type or type-extension definitions - type MutRecDefnsPhase2AData = MutRecShape list + type MutRecDefnsPhase2AData = MutRecShape list /// Represents one element in a type definition, after the second phase type TyconBindingPhase2B = - | Phase2BIncrClassCtor of IncrClassCtorLhs * Tast.Binding option - | Phase2BInherit of Expr * Val option + | Phase2BIncrClassCtor of IncrClassCtorLhs * Tast.Binding option + | Phase2BInherit of Expr * Val option /// A set of value of function definitions in a class definition with an implicit constructor. | Phase2BIncrClassBindings of IncrClassBindingGroup list - | Phase2BMember of int + | Phase2BMember of int /// An intermediate definition that represent the point in an implicit class definition where /// the super type has been initialized. | Phase2BIncrClassCtorJustAfterSuperInit @@ -13354,10 +13354,10 @@ module MutRecBindingChecking = /// Represents one element in a type definition, after the third phase type TyconBindingPhase2C = - | Phase2CIncrClassCtor of IncrClassCtorLhs * Tast.Binding option - | Phase2CInherit of Expr * Val option + | Phase2CIncrClassCtor of IncrClassCtorLhs * Tast.Binding option + | Phase2CInherit of Expr * Val option | Phase2CIncrClassBindings of IncrClassBindingGroup list - | Phase2CMember of PreInitializationGraphEliminationBinding + | Phase2CMember of PreInitializationGraphEliminationBinding // Indicates the last 'field' has been initialized, only 'do' comes after | Phase2CIncrClassCtorJustAfterSuperInit | Phase2CIncrClassCtorJustAfterLastLet @@ -13374,18 +13374,18 @@ module MutRecBindingChecking = // The basic iteration over the declarations in a single type definition // State: - // tpenv: floating type parameter environment - // recBindIdx: index of the recursive binding - // prelimRecValuesRev: accumulation of prelim value entries - // uncheckedBindsRev: accumulation of unchecked bindings + // tpenv: floating type parameter environment + // recBindIdx: index of the recursive binding + // prelimRecValuesRev: accumulation of prelim value entries + // uncheckedBindsRev: accumulation of unchecked bindings let (defnsAs: MutRecDefnsPhase2AData), (tpenv, _, uncheckedBindsRev) = let initialOuterState = (tpenv, 0, ([]: PreCheckingRecursiveBinding list)) (initialOuterState, envMutRec, mutRecDefns) |||> MutRecShapes.mapFoldWithEnv (fun outerState envForDecls defn -> let (tpenv, recBindIdx, uncheckedBindsRev) = outerState match defn with - | MutRecShape.Module _ -> failwith "unreachable" - | MutRecShape.Open x -> MutRecShape.Open x, outerState - | MutRecShape.ModuleAbbrev x -> MutRecShape.ModuleAbbrev x, outerState + | MutRecShape.Module _ -> failwith "unreachable" + | MutRecShape.Open x -> MutRecShape.Open x, outerState + | MutRecShape.ModuleAbbrev x -> MutRecShape.ModuleAbbrev x, outerState | MutRecShape.Lets recBinds -> let normRecDefns = [ for (RecDefnBindingInfo(a, b, c, bind)) in recBinds do @@ -13492,7 +13492,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 ] @@ -13532,7 +13532,7 @@ module MutRecBindingChecking = let afterRev = restRev |> List.takeWhile isAfter let beforeRev = restRev |> List.skipWhile isAfter - [ yield! List.rev beforeRev + [ yield! List.rev beforeRev yield Phase2AIncrClassCtorJustAfterLastLet yield! List.rev afterRev ] b1 :: rest @@ -13554,7 +13554,7 @@ module MutRecBindingChecking = let (defnsBs: MutRecDefnsPhase2BData), (tpenv, generalizedRecBinds, preGeneralizationRecBinds, _, _) = - let uncheckedRecBindsTable = uncheckedRecBinds |> List.map (fun rbind -> rbind.RecBindingInfo.Val.Stamp, rbind) |> Map.ofList + let uncheckedRecBindsTable = uncheckedRecBinds |> List.map (fun rbind -> rbind.RecBindingInfo.Val.Stamp, rbind) |> Map.ofList // Loop through the types being defined... // @@ -13581,14 +13581,14 @@ module MutRecBindingChecking = match defnsA with | MutRecShape.Module _ -> failwith "unreachable" - | MutRecShape.Open x -> MutRecShape.Open x, outerState - | MutRecShape.ModuleAbbrev x -> MutRecShape.ModuleAbbrev x, outerState + | MutRecShape.Open x -> MutRecShape.Open x, outerState + | MutRecShape.ModuleAbbrev x -> MutRecShape.ModuleAbbrev x, outerState | MutRecShape.Lets binds -> let defnBs, (tpenv, _, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) = let initialInnerState = (tpenv, envForDecls, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) - (initialInnerState, binds) ||> List.mapFold (fun innerState rbind -> + (initialInnerState, binds) ||> List.mapFold (fun innerState rbind -> let (tpenv, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) = innerState @@ -13608,7 +13608,7 @@ module MutRecBindingChecking = let envForTycon = if isExtrinsic then envForTycon else AddLocalTyconRefs true cenv.g cenv.amap tcref.Range [tcref] envForTycon // Set up the environment so use-before-definition warnings are given, at least // until we reach a Phase2AIncrClassCtorJustAfterSuperInit. - let envForTycon = { envForTycon with eCtorInfo = Some (InitialImplicitCtorInfo()) } + let envForTycon = { envForTycon with eCtorInfo = Some (InitialImplicitCtorInfo()) } let reqdThisValTyOpt = Some thisTy @@ -13623,7 +13623,7 @@ module MutRecBindingChecking = let defnBs, (tpenv, _, _, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) = let initialInnerState = (tpenv, envForTycon, envForTycon, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) - (initialInnerState, defnAs) ||> List.mapFold (fun innerState defnA -> + (initialInnerState, defnAs) ||> List.mapFold (fun innerState defnA -> let (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) = innerState @@ -13636,8 +13636,8 @@ module MutRecBindingChecking = let envStatic = AddDeclaredTypars CheckForDuplicateTypars incrClassCtorLhs.InstanceCtorDeclaredTypars envStatic let envInstance = match incrClassCtorLhs.InstanceCtorSafeThisValOpt with Some v -> AddLocalVal cenv.tcSink scopem v envInstance | None -> envInstance let envInstance = List.foldBack AddLocalValPrimitive incrClassCtorLhs.InstanceCtorArgs envInstance - let envNonRec = match incrClassCtorLhs.InstanceCtorSafeThisValOpt with Some v -> AddLocalVal cenv.tcSink scopem v envNonRec | None -> envNonRec - let envNonRec = List.foldBack AddLocalValPrimitive incrClassCtorLhs.InstanceCtorArgs envNonRec + let envNonRec = match incrClassCtorLhs.InstanceCtorSafeThisValOpt with Some v -> AddLocalVal cenv.tcSink scopem v envNonRec | None -> envNonRec + let envNonRec = List.foldBack AddLocalValPrimitive incrClassCtorLhs.InstanceCtorArgs envNonRec let safeThisValBindOpt = TcLetrecComputeCtorSafeThisValBind cenv incrClassCtorLhs.InstanceCtorSafeThisValOpt let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) @@ -13649,7 +13649,7 @@ module MutRecBindingChecking = let baseTy = baseTy |> convertToTypeWithMetadataIfPossible cenv.g let inheritsExpr, tpenv = TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg m let envInstance = match baseValOpt with Some baseVal -> AddLocalVal cenv.tcSink scopem baseVal envInstance | None -> envInstance - let envNonRec = match baseValOpt with Some baseVal -> AddLocalVal cenv.tcSink scopem baseVal envNonRec | None -> envNonRec + let envNonRec = match baseValOpt with Some baseVal -> AddLocalVal cenv.tcSink scopem baseVal envNonRec | None -> envNonRec let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BInherit (inheritsExpr, baseValOpt), innerState @@ -13693,7 +13693,7 @@ module MutRecBindingChecking = | _ -> 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) + let envInstance = (if isStatic then (binds, envInstance) ||> List.foldBack (fun b e -> AddLocalVal cenv.tcSink scopem b.Var e) else env) let envStatic = (if isStatic then env else envStatic) let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BIncrClassBindings bindRs, innerState @@ -13704,7 +13704,7 @@ module MutRecBindingChecking = | Phase2AIncrClassCtorJustAfterLastLet -> let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) - Phase2BIncrClassCtorJustAfterLastLet , innerState + Phase2BIncrClassCtorJustAfterLastLet, innerState #if OPEN_IN_TYPE_DECLARATIONS @@ -13730,7 +13730,7 @@ module MutRecBindingChecking = // Type variables derived from the type definition (or implicit constructor) are always generalizable (we check their generalizability later). // Note they may be solved to be equi-recursive. - let extraGeneralizableTypars = copyOfTyconTypars + let extraGeneralizableTypars = copyOfTyconTypars // Inside the incremental class syntax we assert the type of the 'this' variable to be precisely the same type as the // this variable for the implicit class constructor. For static members, we assert the type variables associated @@ -13783,7 +13783,7 @@ module MutRecBindingChecking = | Phase2BInherit (inheritsExpr, basevOpt) -> Phase2CInherit (inheritsExpr, basevOpt) - | Phase2BIncrClassBindings bindRs -> + | Phase2BIncrClassBindings bindRs -> Phase2CIncrClassBindings bindRs | Phase2BIncrClassCtorJustAfterSuperInit -> @@ -13792,11 +13792,11 @@ module MutRecBindingChecking = | Phase2BIncrClassCtorJustAfterLastLet -> Phase2CIncrClassCtorJustAfterLastLet - | Phase2BMember idx -> + | Phase2BMember idx -> // Phase2C: Fixup member bindings let generalizedBinding = generalizedBindingsMap.[idx] let vxbind = TcLetrecAdjustMemberForSpecialVals cenv generalizedBinding - let pgbrind = FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock vxbind + let pgbrind = FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock vxbind Phase2CMember pgbrind) TyconBindingsPhase2C(tyconOpt, tcref, defnCs)) @@ -13805,7 +13805,7 @@ module MutRecBindingChecking = [ for idx in bindIdxs do let generalizedBinding = generalizedBindingsMap.[idx] let vxbind = TcLetrecAdjustMemberForSpecialVals cenv generalizedBinding - yield FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock vxbind ]) + yield FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock vxbind ]) // --- Extract field bindings from let-bindings @@ -13850,7 +13850,7 @@ module MutRecBindingChecking = | _ -> false) if needsSafeStaticInit && hasStaticBindings then - let rfield = MakeSafeInitField cenv.g envForDecls tcref.Range true + let rfield = MakeSafeInitField cenv.g envForDecls tcref.Range true SafeInitField(mkRecdFieldRef tcref rfield.Name, rfield) else NoSafeInitInfo @@ -13877,7 +13877,7 @@ module MutRecBindingChecking = // Compute the cpath used when creating the hidden fields let cpath = envForTycon.eAccessPath - let localDecs = + let localDecs = defnCs |> List.filter (function | Phase2CIncrClassBindings _ | Phase2CIncrClassCtorJustAfterSuperInit @@ -13886,7 +13886,7 @@ module MutRecBindingChecking = let memberBindsWithFixups = defnCs |> List.choose (function Phase2CMember pgrbind -> Some pgrbind | _ -> None) // Extend localDecs with "let safeThisVal = ref null" if there is a safeThisVal - let localDecs = + let localDecs = match safeThisValBindOpt with | None -> localDecs | Some bind -> Phase2CIncrClassBindings [IncrClassBindingGroup([bind], false, false)] :: localDecs @@ -13898,7 +13898,7 @@ module MutRecBindingChecking = [ for localDec in localDecs do match localDec with | Phase2CIncrClassBindings(binds) -> yield Phase2CBindings binds - | Phase2CIncrClassCtorJustAfterSuperInit -> yield Phase2CCtorJustAfterSuperInit + | Phase2CIncrClassCtorJustAfterSuperInit -> yield Phase2CCtorJustAfterSuperInit | Phase2CIncrClassCtorJustAfterLastLet -> yield Phase2CCtorJustAfterLastLet | _ -> () ] let memberBinds = memberBindsWithFixups |> List.map (fun x -> x.Binding) @@ -13916,7 +13916,7 @@ module MutRecBindingChecking = | Some(cctorBodyLambdaExpr) -> [ (let _, cctorVal, cctorValScheme = incrClassCtorLhs.StaticCtorValInfo.Force() let cctorValueExprBinding = TBind(cctorVal, cctorBodyLambdaExpr, NoSequencePointAtStickyBinding) - let rbind = { ValScheme = cctorValScheme; Binding = cctorValueExprBinding } + let rbind = { ValScheme = cctorValScheme; Binding = cctorValueExprBinding } FixupLetrecBind cenv envForDecls.DisplayEnv generalizedTyparsForRecursiveBlock rbind) ] ) // Publish the fields of the representation to the type @@ -13981,11 +13981,11 @@ module MutRecBindingChecking = /// Compute the active environments within each nested module. let TcMutRecDefns_ComputeEnvs getTyconOpt getVals (cenv: cenv) report scopem m envInitial mutRecShape = (envInitial, mutRecShape) ||> MutRecShapes.computeEnvs - (fun envAbove (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec)) -> MakeInnerEnvWithAcc envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind) + (fun envAbove (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec)) -> MakeInnerEnvWithAcc envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind) (fun envAbove decls -> // Collect the type definitions, exception definitions, modules and "open" declarations - let tycons = decls |> List.choose (function MutRecShape.Tycon d -> getTyconOpt d | _ -> None) + let tycons = decls |> List.choose (function MutRecShape.Tycon d -> getTyconOpt d | _ -> None) let mspecs = decls |> List.choose (function MutRecShape.Module (MutRecDefnsPhase2DataForModule (_, mspec), _) -> Some mspec | _ -> None) let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (mp, m)) -> Some (mp, m) | _ -> None) @@ -13993,18 +13993,18 @@ module MutRecBindingChecking = let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsExceptionDecl) // Add the type definitions, exceptions, modules and "open" declarations. - // The order here is sensitive. The things added first will be resolved in an environment - // where not everything has been added. The things added last will be preferred in name + // The order here is sensitive. The things added first will be resolved in an environment + // where not everything has been added. The things added last will be preferred in name // resolution. // // 'open' declarations ('open M') may refer to modules being defined ('M') and so must be - // processed in an environment where 'M' is present. However, in later processing the names of + // processed in an environment where 'M' is present. However, in later processing the names of // modules being defined ('M') take precedence over those coming from 'open' declarations. // So add the names of the modules being defined to the environment twice - once to allow // the processing of 'open M', and once to allow the correct name resolution of 'M'. // // Module abbreviations being defined ('module M = A.B.C') are not available for use in 'open' - // declarations. So + // declarations. So // namespace rec N = // open M // module M = FSharp.Core.Operators @@ -14034,7 +14034,7 @@ module MutRecBindingChecking = // Phase2A: create member prelimRecValues for "recursive" items, i.e. ctor val and member vals // Phase2A: also processes their arg patterns - collecting type assertions - let (defnsAs, uncheckedRecBinds, tpenv) = TcMutRecBindings_Phase2A_CreateRecursiveValuesAndCheckArgumentPatterns cenv tpenv (envMutRecPrelimWithReprs, mutRecDefns) + let (defnsAs, uncheckedRecBinds, tpenv) = TcMutRecBindings_Phase2A_CreateRecursiveValuesAndCheckArgumentPatterns cenv tpenv (envMutRecPrelimWithReprs, mutRecDefns) // Now basic member values are created we can compute the final attributes (i.e. in the case where attributes refer to constructors being defined) mutRecDefns |> MutRecShapes.iterTycons (fun (MutRecDefnsPhase2InfoForTycon(_, _, _, _, _, fixupFinalAttrs)) -> @@ -14049,7 +14049,7 @@ module MutRecBindingChecking = (envInitial, MutRecShapes.dropEnvs defnsAs) ||> TcMutRecDefns_ComputeEnvs (fun (TyconBindingsPhase2A(tyconOpt, _, _, _, _, _, _)) -> tyconOpt) - (fun binds -> [ for bind in binds -> bind.RecBindingInfo.Val ]) + (fun binds -> [ for bind in binds -> bind.RecBindingInfo.Val ]) cenv false scopem scopem ||> MutRecShapes.extendEnvs (fun envForDecls decls -> @@ -14064,7 +14064,7 @@ module MutRecBindingChecking = [ for defnB in defnAs do match defnB with | Phase2AIncrClassCtor (incrClassCtorLhs) -> yield incrClassCtorLhs.InstanceCtorVal - | _ -> () ]) + | _ -> () ]) let envForDeclsUpdated = envForDecls @@ -14090,14 +14090,14 @@ module MutRecBindingChecking = for defnA in defnAs do match defnA with | Phase2AMember rbind -> yield! rbind.RecBindingInfo.EnclosingDeclaredTypars - | _ -> () ]) + | _ -> () ]) // Now check they don't escape the overall scope of the recursive set of types if not (isNil allExtraGeneralizableTypars) then let freeInInitialEnv = GeneralizationHelpers.ComputeUngeneralizableTypars envInitial for extraTypar in allExtraGeneralizableTypars do if Zset.memberOf freeInInitialEnv extraTypar then - let ty = mkTyparTy extraTypar + let ty = mkTyparTy extraTypar error(Error(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyStringOfTy denv ty), extraTypar.Range)) // Solve any type variables in any part of the overall type signature of the class whose @@ -14164,7 +14164,7 @@ module MutRecBindingChecking = let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: TcEnv) (mutRecDefns: MutRecDefnsPhase2Data) = 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 [], cenv.g.exn_ty else generalizeTyconRef tcref @@ -14174,7 +14174,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: let ity' = let envinner = AddDeclaredTypars CheckForDuplicateTypars declaredTyconTypars envForTycon - TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner emptyUnscopedTyparEnv ity |> fst + TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner emptyUnscopedTyparEnv ity |> fst if not (isInterfaceTy cenv.g ity') then errorR(Error(FSComp.SR.tcTypeIsNotInterfaceType0(), ity.Range)) if not (tcref.HasInterface cenv.g ity') then @@ -14195,10 +14195,10 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: | _ -> []) - let interfaceMembersFromTypeDefn tyconMembersData (ity', defn, _) implTySet = + let interfaceMembersFromTypeDefn tyconMembersData (ity', defn, _) implTySet = let (MutRecDefnsPhase2DataForTycon(_, parent, declKind, tcref, baseValOpt, safeInitInfo, declaredTyconTypars, _, _, newslotsOK, _)) = tyconMembersData let containerInfo = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, Some(ity', implTySet), baseValOpt, safeInitInfo, declaredTyconTypars))) - defn |> List.choose (fun mem -> + defn |> List.choose (fun mem -> match mem with | SynMemberDefn.Member(_, m) -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, mem, m)) | SynMemberDefn.AutoProperty(_, _, _, _, _, _, _, _, _, _, m) -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, mem, m)) @@ -14218,13 +14218,13 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, memb, memb.Range)) // Interfaces exist in the member list - handled above in interfaceMembersFromTypeDefn - | SynMemberDefn.Interface _ -> None + | SynMemberDefn.Interface _ -> None // The following should have been List.unzip out already in SplitTyconDefn | SynMemberDefn.AbstractSlot _ | SynMemberDefn.ValField _ - | SynMemberDefn.Inherit _ -> error(InternalError("Unexpected declaration element", memb.Range)) - | SynMemberDefn.NestedType _ -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), memb.Range))) + | SynMemberDefn.Inherit _ -> error(InternalError("Unexpected declaration element", memb.Range)) + | SynMemberDefn.NestedType _ -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), memb.Range))) let tpenv = emptyUnscopedTyparEnv @@ -14252,7 +14252,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: (envMutRec, mutRecDefns) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls tyconData -> let (MutRecDefnsPhase2DataForTycon(tyconOpt, _, declKind, tcref, _, _, declaredTyconTypars, _, _, _, fixupFinalAttrs)) = tyconData let obinds = tyconBindingsOfTypeDefn tyconData - let ibinds = + let ibinds = let intfTypes = interfacesFromTypeDefn envForDecls tyconData let slotImplSets = DispatchSlotChecking.GetSlotImplSets cenv.infoReader envForDecls.DisplayEnv false (List.map (fun (ity, _, m) -> (ity, m)) intfTypes) (intfTypes, slotImplSets) ||> List.map2 (interfaceMembersFromTypeDefn tyconData) |> List.concat @@ -14380,7 +14380,7 @@ module AddAugmentationDeclarations = let vspec1, vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation cenv.g tcref tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) if not tycon.IsExceptionDecl then - PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy cenv.g.system_GenericIEquatable_tcref [ty]) + PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy cenv.g.system_GenericIEquatable_tcref [ty]) PublishValueDefn cenv env ModuleOrMemberBinding vspec1 PublishValueDefn cenv env ModuleOrMemberBinding vspec2 AugmentWithHashCompare.MakeBindingsForEqualsAugmentation cenv.g tycon @@ -14435,7 +14435,7 @@ module TyconConstraintInference = match ty with // Look for array, UIntPtr and IntPtr types | SpecialComparableHeadType g tinst -> - tinst |> List.forall (checkIfFieldTypeSupportsComparison tycon) + tinst |> List.forall (checkIfFieldTypeSupportsComparison tycon) // Otherwise it's a nominal type | _ -> @@ -14446,7 +14446,7 @@ module TyconConstraintInference = (if initialAssumedTycons.Contains tcref.Stamp then assumedTycons.Contains tcref.Stamp else - ExistsSameHeadTypeInHierarchy g cenv.amap range0 ty g.mk_IComparable_ty || + ExistsSameHeadTypeInHierarchy g cenv.amap range0 ty g.mk_IComparable_ty || ExistsSameHeadTypeInHierarchy g cenv.amap range0 ty g.mk_IStructuralComparable_ty) && // Check it isn't ruled out by the user @@ -14455,7 +14455,7 @@ module TyconConstraintInference = // Check the structural dependencies (tinst, tcref.TyparsNoRange) ||> List.lengthsEqAndForall2 (fun ty tp -> if tp.ComparisonConditionalOn || assumedTypars.Contains tp.Stamp then - checkIfFieldTypeSupportsComparison tycon ty + checkIfFieldTypeSupportsComparison tycon ty else true) | _ -> @@ -14524,7 +14524,7 @@ module TyconConstraintInference = uneliminatedTycons /// Infer 'equality' constraints from type definitions - let InferSetOfTyconsSupportingEquatable cenv (denv: DisplayEnv) (tyconsWithStructuralTypes:(Tycon * _) list) = + let InferSetOfTyconsSupportingEquatable cenv (denv: DisplayEnv) (tyconsWithStructuralTypes:(Tycon * _) list) = let g = cenv.g let tab = tyconsWithStructuralTypes |> List.map (fun (tycon, c) -> tycon.Stamp, (tycon, c)) |> Map.ofList @@ -14582,7 +14582,7 @@ module TyconConstraintInference = // Check the structural dependencies (tinst, tcref.TyparsNoRange) ||> List.lengthsEqAndForall2 (fun ty tp -> if tp.EqualityConditionalOn || assumedTypars.Contains tp.Stamp then - checkIfFieldTypeSupportsEquality tycon ty + checkIfFieldTypeSupportsEquality tycon ty else true) | _ -> @@ -14661,13 +14661,13 @@ let ComputeModuleName (longPath: Ident list) = if longPath.Length <> 1 then error(Error(FSComp.SR.tcInvalidModuleName(), (List.head longPath).idRange)) longPath.Head -let CheckForDuplicateConcreteType env nm m = +let CheckForDuplicateConcreteType env nm m = let curr = GetCurrAccumulatedModuleOrNamespaceType env if Map.containsKey nm curr.AllEntitiesByCompiledAndLogicalMangledNames then // Use 'error' instead of 'errorR' here to avoid cascading errors - see bug 1177 in FSharp 1.0 error (Duplicate(FSComp.SR.tcTypeExceptionOrModule(), nm, m)) -let CheckForDuplicateModule env nm m = +let CheckForDuplicateModule env nm m = let curr = GetCurrAccumulatedModuleOrNamespaceType env if curr.ModulesAndNamespacesByDemangledName.ContainsKey(nm) then errorR (Duplicate(FSComp.SR.tcTypeOrModule(), nm, m)) @@ -14705,7 +14705,7 @@ module TcExceptionDeclarations = if not (isNil args') then errorR (Error(FSComp.SR.tcExceptionAbbreviationsShouldNotHaveArgumentList(), m)) TExnAbbrevRepr exnc - | Item.CtorGroup(_, meths) , [] -> + | Item.CtorGroup(_, meths), [] -> // REVIEW: check this really is an exception type match args' with | [] -> () @@ -14759,7 +14759,7 @@ module TcExceptionDeclarations = let TcExnDefn cenv envInitial parent (SynExceptionDefn(core, aug, m), scopem) = let binds1, exnc = TcExnDefnCore cenv envInitial parent core - let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons cenv.g cenv.amap scopem [exnc] envInitial) exnc + let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons cenv.g cenv.amap scopem [exnc] envInitial) exnc let defns = [MutRecShape.Tycon(MutRecDefnsPhase2DataForTycon(Some exnc, parent, ModuleOrMemberBinding, mkLocalEntityRef exnc, None, NoSafeInitInfo, [], aug, m, NoNewSlots, (fun () -> ())))] let binds2, envFinal = TcMutRecDefns_Phase2 cenv envInitial m scopem None envMutRec defns @@ -14770,7 +14770,7 @@ module TcExceptionDeclarations = let TcExnSignature cenv envInitial parent tpenv (SynExceptionSig(core, aug, _), scopem) = let binds, exnc = TcExnDefnCore cenv envInitial parent core - let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons cenv.g cenv.amap scopem [exnc] envInitial) exnc + let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons cenv.g cenv.amap scopem [exnc] envInitial) exnc let ecref = mkLocalEntityRef exnc let vals, _ = TcTyconMemberSpecs cenv envMutRec (ContainerInfo(parent, Some(MemberOrValContainerInfo(ecref, None, None, NoSafeInitInfo, [])))) ModuleOrMemberBinding tpenv aug binds, vals, ecref, envMutRec @@ -14803,11 +14803,11 @@ module EstablishTypeDefinitionCores = mkSynId id.idRange (if erasedArity = 0 then id.idText else id.idText + "`" + string erasedArity) let private GetTyconAttribs g attrs = - let hasClassAttr = HasFSharpAttribute g g.attrib_ClassAttribute attrs + let hasClassAttr = HasFSharpAttribute g g.attrib_ClassAttribute attrs let hasAbstractClassAttr = HasFSharpAttribute g g.attrib_AbstractClassAttribute attrs - let hasInterfaceAttr = HasFSharpAttribute g g.attrib_InterfaceAttribute attrs - let hasStructAttr = HasFSharpAttribute g g.attrib_StructAttribute attrs - let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs + let hasInterfaceAttr = HasFSharpAttribute g g.attrib_InterfaceAttribute attrs + let hasStructAttr = HasFSharpAttribute g g.attrib_StructAttribute attrs + let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs (hasClassAttr, hasAbstractClassAttr, hasInterfaceAttr, hasStructAttr, hasMeasureAttr) //------------------------------------------------------------------------- @@ -14831,7 +14831,7 @@ module EstablishTypeDefinitionCores = else TyconInterface | k -> if hasClassAttr && not (match k with TyconClass -> true | _ -> false) || - hasMeasureAttr && not (match k with TyconClass | TyconAbbrev | TyconHiddenRepr -> true | _ -> false) || + hasMeasureAttr && not (match k with TyconClass | TyconAbbrev | TyconHiddenRepr -> true | _ -> false) || hasInterfaceAttr && not (match k with TyconInterface -> true | _ -> false) || hasStructAttr && not (match k with TyconStruct | TyconRecord | TyconUnion -> true | _ -> false) then error(Error(FSComp.SR.tcKindOfTypeSpecifiedDoesNotMatchDefinition(), m)) @@ -14874,11 +14874,11 @@ module EstablishTypeDefinitionCores = errorR(Error(FSComp.SR.tcIllegalFormForExplicitTypeDeclaration(), m)) for argTys in curriedArgTys do for (argty, _) in argTys do - yield (argty , m) + yield (argty, m) | SynTypeDefnSimpleRepr.General (_, _, _, fields, _, _, implicitCtorSynPats, _) when tycon.IsFSharpStructOrEnumTycon -> // for structs for (Field(_, isStatic, _, ty, _, _, _, m)) in fields do - if not isStatic then + if not isStatic then let ty', _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty yield (ty', m) @@ -14913,7 +14913,7 @@ module EstablishTypeDefinitionCores = [ for d in compDecls do match d with | MutRecShape.Tycon (MutRecDefnsPhase1DataForTycon(ComponentInfo(_, typars, _, ids, _, _, _, _), _, _, _, _, isAtOriginalTyconDefn), _) -> - if isAtOriginalTyconDefn && (TcTyparDecls cenv env typars |> List.forall (fun p -> p.Kind = TyparKind.Measure)) then + if isAtOriginalTyconDefn && (TcTyparDecls cenv env typars |> List.forall (fun p -> p.Kind = TyparKind.Measure)) then yield (List.last ids).idText | _ -> () ] |> set @@ -14963,7 +14963,7 @@ module EstablishTypeDefinitionCores = let innerTypeNames = TypeNamesInMutRecDecls cenv envForDecls decls MutRecDefnsPhase2DataForModule (mtypeAcc, mspec), (innerParent, innerTypeNames, envForDecls) - /// Establish 'type C < T1... TN > = ...' including + /// Establish 'type C < T1... TN > = ...' including /// - computing the mangled name for C /// but /// - we don't yet 'properly' establish constraints on type parameters @@ -15044,10 +15044,10 @@ module EstablishTypeDefinitionCores = let repr = match synTyconRepr with - | SynTypeDefnSimpleRepr.Exception _ -> TNoRepr + | SynTypeDefnSimpleRepr.Exception _ -> TNoRepr | SynTypeDefnSimpleRepr.None m -> // Run InferTyconKind to raise errors on inconsistent attribute sets - InferTyconKind cenv.g (TyconHiddenRepr, attrs, [], [], inSig, true, m) |> ignore + InferTyconKind cenv.g (TyconHiddenRepr, attrs, [], [], inSig, true, m) |> ignore if not inSig && not hasMeasureAttr then errorR(Error(FSComp.SR.tcTypeRequiresDefinition(), m)) if hasMeasureAttr then @@ -15064,7 +15064,7 @@ module EstablishTypeDefinitionCores = // Note: the table of union cases is initially empty MakeUnionRepr [] - | SynTypeDefnSimpleRepr.TypeAbbrev _ -> + | SynTypeDefnSimpleRepr.TypeAbbrev _ -> // Run InferTyconKind to raise errors on inconsistent attribute sets InferTyconKind cenv.g (TyconAbbrev, attrs, [], [], inSig, true, m) |> ignore TNoRepr @@ -15078,7 +15078,7 @@ module EstablishTypeDefinitionCores = // Run InferTyconKind to raise errors on inconsistent attribute sets InferTyconKind cenv.g (TyconRecord, attrs, [], [], inSig, true, m) |> ignore // Note: the table of record fields is initially empty - TRecdRepr (MakeRecdFieldsTable []) + TRecdRepr (MakeRecdFieldsTable []) | SynTypeDefnSimpleRepr.General (kind, _, slotsigs, fields, isConcrete, _, _, _) -> let kind = InferTyconKind cenv.g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) @@ -15088,10 +15088,10 @@ module EstablishTypeDefinitionCores = | _ -> let kind = match kind with - | TyconClass -> TTyconClass - | TyconInterface -> TTyconInterface - | TyconDelegate _ -> TTyconDelegate (MakeSlotSig("Invoke", cenv.g.unit_ty, [], [], [], None)) - | TyconStruct -> TTyconStruct + | TyconClass -> TTyconClass + | TyconInterface -> TTyconInterface + | TyconDelegate _ -> TTyconDelegate (MakeSlotSig("Invoke", cenv.g.unit_ty, [], [], [], None)) + | TyconStruct -> TTyconStruct | _ -> error(InternalError("should have inferred tycon kind", m)) let repr = { fsobjmodel_kind=kind @@ -15141,7 +15141,7 @@ module EstablishTypeDefinitionCores = let optGeneratedTypePath = Some (tcref.CompilationPath.MangledPath @ [ tcref.LogicalName ]) let _hasNoArgs, providedTypeAfterStaticArguments, checkTypeName = TcProvidedTypeAppToStaticConstantArgs cenv envinner optGeneratedTypePath tpenv tcrefBeforeStaticArguments args m let isGenerated = providedTypeAfterStaticArguments.PUntaint((fun st -> not st.IsErased), m) - if isGenerated then + if isGenerated then Some (tcrefBeforeStaticArguments, providedTypeAfterStaticArguments, checkTypeName, args, m) else None // The provided type (after ApplyStaticArguments) must also be marked 'IsErased=false' @@ -15289,8 +15289,8 @@ module EstablishTypeDefinitionCores = /// Establish any type abbreviations /// /// e.g. for - /// type B<'a when 'a: C> = DDD of C - /// and C = B + /// type B<'a when 'a: C> = DDD of C + /// and C = B /// /// we establish /// @@ -15376,7 +15376,7 @@ module EstablishTypeDefinitionCores = // Publish the immediately declared interfaces. let tyconWithImplementsL = - (envMutRec, mutRecDefns) ||> MutRecShapes.mapTyconsWithEnv (fun envinner (origInfo, tyconAndAttrsOpt) -> + (envMutRec, mutRecDefns) ||> MutRecShapes.mapTyconsWithEnv (fun envinner (origInfo, tyconAndAttrsOpt) -> match origInfo, tyconAndAttrsOpt with | (typeDefCore, _, _), Some (tycon, (attrs, _)) -> let (MutRecDefnsPhase1DataForTycon(_, synTyconRepr, explicitImplements, _, _, _)) = typeDefCore @@ -15453,7 +15453,7 @@ module EstablishTypeDefinitionCores = errorR (Error(FSComp.SR.tcStructsInterfacesEnumsDelegatesMayNotInheritFromOtherTypes(), m)) CheckSuperType cenv ty m if isTyparTy cenv.g ty then - if firstPass then + if firstPass then errorR(Error(FSComp.SR.tcCannotInheritFromVariableType(), m)) Some cenv.g.obj_ty // a "super" that is a variable type causes grief later else @@ -15627,14 +15627,14 @@ module EstablishTypeDefinitionCores = errorR (Error(FSComp.SR.tcAbbreviatedTypesCannotBeSealed(), m)) noAbstractClassAttributeCheck() noAllowNullLiteralAttributeCheck() - if hasMeasureableAttr then + if hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type let theTypeAbbrev, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv rhsType TMeasureableRepr theTypeAbbrev, None, NoSafeInitInfo // If we already computed a representation, e.g. for a generative type definition, then don't change it here. - elif (match tycon.TypeReprInfo with TNoRepr -> false | _ -> true) then - tycon.TypeReprInfo , None, NoSafeInitInfo + elif (match tycon.TypeReprInfo with TNoRepr -> false | _ -> true) then + tycon.TypeReprInfo, None, NoSafeInitInfo else TNoRepr, None, NoSafeInitInfo @@ -15662,7 +15662,7 @@ module EstablishTypeDefinitionCores = noAllowNullLiteralAttributeCheck() 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 + recdFields |> CheckDuplicates (fun f -> f.Id) "field" |> ignore writeFakeRecordFieldsToSink recdFields TRecdRepr (MakeRecdFieldsTable recdFields), None, NoSafeInitInfo @@ -15691,14 +15691,14 @@ module EstablishTypeDefinitionCores = let taccess = TAccess [envinner.eAccessPath] yield NewRecdField false None id false ty false false [(*no property attributes*)] [(*no field attributes *)] XmlDoc.Empty taccess (*compiler generated:*)true ] - (userFields @ implicitStructFields) |> CheckDuplicates (fun f -> f.Id) "field" |> ignore + (userFields @ implicitStructFields) |> CheckDuplicates (fun f -> f.Id) "field" |> ignore writeFakeRecordFieldsToSink userFields let superTy = tycon.TypeContents.tcaug_super let containerInfo = TyconContainerInfo(innerParent, thisTyconRef, thisTyconRef.Typars(m), NoSafeInitInfo) let kind = InferTyconKind cenv.g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) match kind with - | TyconHiddenRepr -> + | TyconHiddenRepr -> hiddenReprChecks(true) noAllowNullLiteralAttributeCheck() TNoRepr, None, NoSafeInitInfo @@ -15746,7 +15746,7 @@ module EstablishTypeDefinitionCores = noAbstractClassAttributeCheck() noFieldsCheck(userFields) let ty', _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv ty - let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv envinner) |> TranslatePartialArity []) ty' m + let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.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) @@ -15794,7 +15794,7 @@ module EstablishTypeDefinitionCores = TFSharpObjectRepr { fsobjmodel_kind=kind fsobjmodel_vslots= abstractSlots - fsobjmodel_rfields=MakeRecdFieldsTable (userFields @ implicitStructFields @ safeInitFields) } + fsobjmodel_rfields=MakeRecdFieldsTable (userFields @ implicitStructFields @ safeInitFields) } repr, baseValOpt, safeInitInfo | SynTypeDefnSimpleRepr.Enum (decls, m) -> @@ -15840,7 +15840,7 @@ module EstablishTypeDefinitionCores = let edgesFrom (tycon: Tycon) = - let rec accInAbbrevType ty acc = + let rec accInAbbrevType ty acc = match stripTyparEqns ty with | TType_anon (_,l) | TType_tuple (_, l) -> accInAbbrevTypes l acc @@ -15849,7 +15849,7 @@ module EstablishTypeDefinitionCores = let tycon2 = tc.Deref let acc = accInAbbrevTypes tinst acc // Record immediate recursive references - if ListSet.contains (===) tycon2 tycons then + if ListSet.contains (===) tycon2 tycons then (tycon, tycon2) :: acc // Expand the representation of abbreviations elif tc.IsTypeAbbrev then @@ -15869,9 +15869,9 @@ module EstablishTypeDefinitionCores = and accInMeasure ms acc = match stripUnitEqns ms with - | Measure.Con tc when ListSet.contains (===) tc.Deref tycons -> + | Measure.Con tc when ListSet.contains (===) tc.Deref tycons -> (tycon, tc.Deref) :: acc - | Measure.Con tc when tc.IsTypeAbbrev -> + | Measure.Con tc when tc.IsTypeAbbrev -> accInMeasure (reduceTyconRefAbbrevMeasureable tc) acc | Measure.Prod (ms1, ms2) -> accInMeasure ms1 (accInMeasure ms2 acc) | Measure.Inv ms -> accInMeasure ms acc @@ -15947,7 +15947,7 @@ module EstablishTypeDefinitionCores = acc // collect edges from an a struct field (which is struct-contained in tycon) - let rec accStructField (structTycon: Tycon) structTyInst (fspec: RecdField) (doneTypes, acc) = + let rec accStructField (structTycon: Tycon) structTyInst (fspec: RecdField) (doneTypes, acc) = let fieldTy = actualTyOfRecdFieldForTycon structTycon structTyInst fspec accStructFieldType structTycon structTyInst fspec fieldTy (doneTypes, acc) @@ -15955,7 +15955,7 @@ module EstablishTypeDefinitionCores = and accStructFieldType structTycon structTyInst fspec fieldTy (doneTypes, acc) = let fieldTy = stripTyparEqns fieldTy match fieldTy with - | TType_app (tcref2 , tinst2) when tcref2.IsStructOrEnumTycon -> + | TType_app (tcref2, tinst2) when tcref2.IsStructOrEnumTycon -> // The field is a struct. // An edge (tycon, tycon2) should be recorded, unless it is the "static self-typed field" case. let tycon2 = tcref2.Deref @@ -15975,7 +15975,7 @@ module EstablishTypeDefinitionCores = else let acc = insertEdgeToTycon tycon2 acc // collect edge (tycon, tycon2), if tycon2 is initial. accStructInstanceFields fieldTy tycon2 tinst2 (doneTypes, acc) // recurse through struct field looking for more edges - | TType_app (tcref2 , tinst2) when tcref2.IsTypeAbbrev -> + | TType_app (tcref2, tinst2) when tcref2.IsTypeAbbrev -> // The field is a type abbreviation. Expand and repeat. accStructFieldType structTycon structTyInst fspec (reduceTyconRefAbbrev tcref2 tinst2) (doneTypes, acc) | _ -> @@ -15992,7 +15992,7 @@ module EstablishTypeDefinitionCores = let fspecs = if structTycon.IsUnionTycon then [ for uc in structTycon.UnionCasesArray do - for c in uc.FieldTable.FieldsByIndex do + for c in uc.FieldTable.FieldsByIndex do yield c] else structTycon.AllFieldsAsList @@ -16000,7 +16000,7 @@ module EstablishTypeDefinitionCores = let doneTypes, acc = List.foldBack (accStructField structTycon tinst) fspecs (doneTypes, acc) doneTypes, acc and accStructInstanceFields ty structTycon tinst (doneTypes, acc) = accStructFields false ty structTycon tinst (doneTypes, acc) - and accStructAllFields ty (structTycon: Tycon) tinst (doneTypes, acc) = accStructFields true ty structTycon tinst (doneTypes, acc) + and accStructAllFields ty (structTycon: Tycon) tinst (doneTypes, acc) = accStructFields true ty structTycon tinst (doneTypes, acc) let acc = [] let acc = @@ -16039,7 +16039,7 @@ module EstablishTypeDefinitionCores = 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 + try TcTyparConstraints cenv NoNewTypars checkCxs ItemOccurence.UseInType envForTycon tpenv synTyconConstraints |> ignore with e -> errorRecovery e m | _ -> ()) @@ -16047,7 +16047,7 @@ module EstablishTypeDefinitionCores = let TcMutRecDefns_Phase1 mkLetInfo cenv envInitial parent typeNames inSig tpenv m scopem mutRecNSInfo (mutRecDefns: MutRecShapes) = // Phase1A - build Entity for type definitions, exception definitions and module definitions. - // Also for abbreviations of any of these. Augmentations are skipped in this phase. + // Also for abbreviations of any of these. Augmentations are skipped in this phase. let withEntities = mutRecDefns |> MutRecShapes.mapWithParent @@ -16084,7 +16084,7 @@ module EstablishTypeDefinitionCores = // Publish tycons (envTmp, withEnvs) ||> MutRecShapes.iterTyconsWithEnv - (fun envAbove (_, tyconOpt) -> + (fun envAbove (_, tyconOpt) -> tyconOpt |> Option.iter (fun tycon -> // recheck these in case type is a duplicate in a mutually recursive set CheckForDuplicateConcreteType envAbove tycon.LogicalName tycon.Range @@ -16098,7 +16098,7 @@ module EstablishTypeDefinitionCores = // Add the types to the environment. This does not add the fields and union cases (because we haven't established them yet). // We re-add them to the original environment later on. We don't report them to the Language Service yet as we don't know if // they are well-formed (e.g. free of abbreviation cycles) - let envMutRecPrelim, withEnvs = (envInitial, withEntities) ||> MutRecBindingChecking.TcMutRecDefns_ComputeEnvs snd (fun _ -> []) cenv false scopem m + let envMutRecPrelim, withEnvs = (envInitial, withEntities) ||> MutRecBindingChecking.TcMutRecDefns_ComputeEnvs snd (fun _ -> []) cenv false scopem m // Phase 1B. Establish the kind of each type constructor // Here we run InferTyconKind and record partial information about the kind of the type constructor. @@ -16112,7 +16112,7 @@ module EstablishTypeDefinitionCores = origInfo, res) // Phase 1C. Establish the abbreviations (no constraint checking, because constraints not yet established) - (envMutRecPrelim, withAttrs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo, tyconAndAttrsOpt) -> + (envMutRecPrelim, withAttrs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo, tyconAndAttrsOpt) -> match origInfo, tyconAndAttrsOpt with | (typeDefCore, _, _), Some (tycon, (attrs, _)) -> TcTyconDefnCore_Phase1C_Phase1E_EstablishAbbreviations cenv envForDecls inSig tpenv FirstPass typeDefCore tycon attrs | _ -> ()) @@ -16122,7 +16122,7 @@ module EstablishTypeDefinitionCores = TcTyconDefnCore_CheckForCyclicAbbreviations tycons - // Phase 1D. Establish the super type and interfaces (no constraint checking, because constraints not yet established) + // Phase 1D. Establish the super type and interfaces (no constraint checking, because constraints not yet established) (envMutRecPrelim, withAttrs) |> TcTyconDefnCore_Phase1D_Phase1F_EstablishSuperTypesAndInterfaceTypes cenv tpenv inSig FirstPass // Interlude between Phase1D and Phase1E - Add the interface and member declarations for @@ -16153,7 +16153,7 @@ module EstablishTypeDefinitionCores = tyconOpt |> Option.iter (fun tycon -> tycon.Typars(m) |> List.iter (SetTyparRigid cenv.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) -> + (envMutRecPrelim, withAttrs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo, tyconAndAttrsOpt) -> match origInfo, tyconAndAttrsOpt with | (typeDefCore, _, _), Some (tycon, (attrs, _)) -> TcTyconDefnCore_Phase1C_Phase1E_EstablishAbbreviations cenv envForDecls inSig tpenv SecondPass typeDefCore tycon attrs | _ -> ()) @@ -16167,8 +16167,8 @@ module EstablishTypeDefinitionCores = let envMutRecPrelim, withAttrs = (envMutRecPrelim, withAttrs) ||> MutRecShapes.extendEnvs (fun envForDecls decls -> - let tycons = decls |> List.choose (function MutRecShape.Tycon (_, Some (tycon, _)) -> Some tycon | _ -> None) - let exns = tycons |> List.filter (fun tycon -> tycon.IsExceptionDecl) + let tycons = decls |> List.choose (function MutRecShape.Tycon (_, Some (tycon, _)) -> Some tycon | _ -> None) + let exns = tycons |> List.filter (fun tycon -> tycon.IsExceptionDecl) let envForDecls = (envForDecls, exns) ||> List.fold (AddLocalExnDefnAndReport cenv.tcSink scopem) envForDecls) @@ -16278,15 +16278,15 @@ module TcDeclarations = let private isAugmentationTyconDefnRepr = function (SynTypeDefnSimpleRepr.General(TyconAugmentation, _, _, _, _, _, _, _)) -> true | _ -> false - let private isAutoProperty = function SynMemberDefn.AutoProperty _ -> true | _ -> false - let private isMember = function SynMemberDefn.Member _ -> true | _ -> false - let private isImplicitCtor = function SynMemberDefn.ImplicitCtor _ -> true | _ -> false + let private isAutoProperty = function SynMemberDefn.AutoProperty _ -> true | _ -> false + let private isMember = function SynMemberDefn.Member _ -> true | _ -> false + let private isImplicitCtor = function SynMemberDefn.ImplicitCtor _ -> true | _ -> false let private isImplicitInherit = function SynMemberDefn.ImplicitInherit _ -> true | _ -> false - let private isAbstractSlot = function SynMemberDefn.AbstractSlot _ -> true | _ -> false - let private isInterface = function SynMemberDefn.Interface _ -> true | _ -> false - let private isInherit = function SynMemberDefn.Inherit _ -> true | _ -> false - let private isField = function SynMemberDefn.ValField (_, _) -> true | _ -> false - let private isTycon = function SynMemberDefn.NestedType _ -> true | _ -> false + let private isAbstractSlot = function SynMemberDefn.AbstractSlot _ -> true | _ -> false + let private isInterface = function SynMemberDefn.Interface _ -> true | _ -> false + let private isInherit = function SynMemberDefn.Inherit _ -> true | _ -> false + let private isField = function SynMemberDefn.ValField (_, _) -> true | _ -> false + let private isTycon = function SynMemberDefn.NestedType _ -> true | _ -> false let private allFalse ps x = List.forall (fun p -> not (p x)) ps @@ -16319,30 +16319,30 @@ module TcDeclarations = let _, ds = ds |> List.takeUntil (allFalse [isMember;isAbstractSlot;isInterface;isAutoProperty]) match ds with - | SynMemberDefn.Member (_, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have binding", m)) - | SynMemberDefn.AbstractSlot (_, _, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have slotsig", m)) - | SynMemberDefn.Interface (_, _, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have interface", m)) - | SynMemberDefn.ImplicitCtor (_, _, _, _, m) :: _ -> errorR(InternalError("implicit class construction with two implicit constructions", m)) + | SynMemberDefn.Member (_, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have binding", m)) + | SynMemberDefn.AbstractSlot (_, _, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have slotsig", m)) + | SynMemberDefn.Interface (_, _, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have interface", m)) + | SynMemberDefn.ImplicitCtor (_, _, _, _, m) :: _ -> errorR(InternalError("implicit class construction with two implicit constructions", m)) | SynMemberDefn.AutoProperty (_, _, _, _, _, _, _, _, _, _, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have auto property", m)) | SynMemberDefn.ImplicitInherit (_, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveOneInherit(), m)) - | SynMemberDefn.LetBindings (_, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveLocalBindingsBeforeMembers(), m)) - | SynMemberDefn.Inherit (_, _, m) :: _ -> errorR(Error(FSComp.SR.tcInheritDeclarationMissingArguments(), m)) - | SynMemberDefn.NestedType (_, _, m) :: _ -> errorR(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)) + | SynMemberDefn.LetBindings (_, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveLocalBindingsBeforeMembers(), m)) + | SynMemberDefn.Inherit (_, _, m) :: _ -> errorR(Error(FSComp.SR.tcInheritDeclarationMissingArguments(), m)) + | SynMemberDefn.NestedType (_, _, m) :: _ -> errorR(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)) | _ -> () | ds -> // Classic class construction let _, ds = List.takeUntil (allFalse [isMember;isAbstractSlot;isInterface;isInherit;isField;isTycon]) ds match ds with - | SynMemberDefn.Member (_, m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong", m)) - | SynMemberDefn.ImplicitCtor (_, _, _, _, m) :: _ -> errorR(InternalError("CheckMembersForm: implicit ctor line should be first", m)) + | SynMemberDefn.Member (_, m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong", m)) + | SynMemberDefn.ImplicitCtor (_, _, _, _, m) :: _ -> errorR(InternalError("CheckMembersForm: implicit ctor line should be first", m)) | SynMemberDefn.ImplicitInherit (_, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcInheritConstructionCallNotPartOfImplicitSequence(), m)) - | SynMemberDefn.AutoProperty(_, _, _, _, _, _, _, _, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcAutoPropertyRequiresImplicitConstructionSequence(), m)) + | SynMemberDefn.AutoProperty(_, _, _, _, _, _, _, _, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcAutoPropertyRequiresImplicitConstructionSequence(), m)) | SynMemberDefn.LetBindings (_, false, _, m) :: _ -> errorR(Error(FSComp.SR.tcLetAndDoRequiresImplicitConstructionSequence(), m)) - | SynMemberDefn.AbstractSlot (_, _, m) :: _ - | SynMemberDefn.Interface (_, _, m) :: _ - | SynMemberDefn.Inherit (_, _, m) :: _ - | SynMemberDefn.ValField (_, m) :: _ - | SynMemberDefn.NestedType (_, _, m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong", m)) + | SynMemberDefn.AbstractSlot (_, _, m) :: _ + | SynMemberDefn.Interface (_, _, m) :: _ + | SynMemberDefn.Inherit (_, _, m) :: _ + | SynMemberDefn.ValField (_, m) :: _ + | SynMemberDefn.NestedType (_, _, m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong", m)) | _ -> () @@ -16357,17 +16357,17 @@ 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) + 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 slotsigs = cspec |> List.choose (function SynMemberDefn.AbstractSlot (x, y, _) -> Some(x, y) | _ -> None) + let slotsigs = cspec |> List.choose (function SynMemberDefn.AbstractSlot (x, y, _) -> Some(x, y) | _ -> None) let members = - let membersIncludingAutoProps = + let membersIncludingAutoProps = cspec |> List.filter (fun memb -> match memb with | SynMemberDefn.Interface _ @@ -16377,7 +16377,7 @@ module TcDeclarations = | SynMemberDefn.AutoProperty _ | SynMemberDefn.Open _ | SynMemberDefn.ImplicitInherit _ -> true - | SynMemberDefn.NestedType (_, _, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)); false + | SynMemberDefn.NestedType (_, _, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)); false // covered above | SynMemberDefn.ValField _ | SynMemberDefn.Inherit _ @@ -16412,7 +16412,7 @@ module TcDeclarations = // Convert autoproperties to member bindings in the post-list let rec postAutoProps memb = match memb with - | SynMemberDefn.AutoProperty (attribs, isStatic, id, tyOpt, propKind, memberFlags, xmlDoc, access, _synExpr, mGetSetOpt, _mWholeAutoProp) -> + | SynMemberDefn.AutoProperty (attribs, isStatic, id, tyOpt, propKind, memberFlags, xmlDoc, access, _synExpr, mGetSetOpt, _mWholeAutoProp) -> let mMemberPortion = id.idRange // Only the keep the non-field-targeted attributes let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true) @@ -16485,7 +16485,7 @@ module TcDeclarations = let implicitCtorSynPats = members |> List.tryPick (function - | SynMemberDefn.ImplicitCtor (_, _, spats, _, _) -> Some spats + | SynMemberDefn.ImplicitCtor (_, _, spats, _, _) -> Some spats | _ -> None) // An ugly bit of code to pre-determine if a type has a nullary constructor, prior to establishing the @@ -16518,7 +16518,7 @@ module TcDeclarations = /// Bind a collection of mutually recursive definitions in an implementation file let TcMutRecDefinitions cenv envInitial parent typeNames tpenv m scopem mutRecNSInfo (mutRecDefns: MutRecDefnsInitialData) = - // Split the definitions into "core representations" and "members". The code to process core representations + // Split the definitions into "core representations" and "members". The code to process core representations // is shared between processing of signature files and implementation files. let mutRecDefnsAfterSplit = mutRecDefns |> MutRecShapes.mapTycons SplitTyconDefn @@ -16547,7 +16547,7 @@ module TcDeclarations = MutRecDefnsPhase2DataForTycon(tyconOpt, innerParent, declKind, tcref, baseValOpt, safeInitInfo, declaredTyconTypars, members, tyDeclRange, newslotsOK, fixupFinalAttrs)) // By now we've established the full contents of type definitions apart from their - // members and any fields determined by implicit construction. We know the kinds and + // members and any fields determined by implicit construction. We know the kinds and // representations of types and have established them as valid. // // We now reconstruct the active environments all over again - this will add the union cases and fields. @@ -16558,11 +16558,11 @@ module TcDeclarations = (envInitial, MutRecShapes.dropEnvs mutRecDefnsAfterPrep) ||> MutRecBindingChecking.TcMutRecDefns_ComputeEnvs (fun (MutRecDefnsPhase2DataForTycon(tyconOpt, _, _, _, _, _, _, _, _, _, _)) -> tyconOpt) - (fun _binds -> [ (* no values are available yet *) ]) + (fun _binds -> [ (* no values are available yet *) ]) cenv true scopem m // Check the members and decide on representations for types with implicit constructors. - let withBindings, envFinal = TcMutRecDefns_Phase2 cenv envInitial m scopem mutRecNSInfo envMutRecPrelimWithReprs withEnvs + let withBindings, envFinal = TcMutRecDefns_Phase2 cenv envInitial m scopem mutRecNSInfo envMutRecPrelimWithReprs withEnvs // Generate the hash/compare/equality bindings for all tycons. // @@ -16596,15 +16596,15 @@ 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 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 slotsigs = cspec |> List.choose (function SynMemberSig.Member (v, fl, _) when fl.IsDispatchSlot -> Some(v, fl) | _ -> None) - let members = cspec |> List.filter (function + 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 | SynMemberSig.Member (_, memberFlags, _) when not memberFlags.IsDispatchSlot -> true - | SynMemberSig.NestedType (_, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)); false + | SynMemberSig.NestedType (_, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)); false | _ -> false) let isConcrete = members |> List.exists (function @@ -16619,7 +16619,7 @@ module TcDeclarations = memberFlags.MemberKind=MemberKind.Constructor && // REVIEW: This is a syntactic approximation (match valSpfn.SynType, valSpfn.SynInfo.ArgInfos with - | SynType.Fun (SynType.LongIdent (LongIdentWithDots([id], _)), _, _), [[_]] when id.idText = "unit" -> true + | SynType.Fun (SynType.LongIdent (LongIdentWithDots([id], _)), _, _), [[_]] when id.idText = "unit" -> true | _ -> false) | _ -> false) @@ -16680,7 +16680,7 @@ module TcDeclarations = MutRecBindingChecking.TcMutRecDefns_UpdateModuleContents mutRecNSInfo mutRecDefnsAfterCore // By now we've established the full contents of type definitions apart from their - // members and any fields determined by implicit construction. We know the kinds and + // members and any fields determined by implicit construction. We know the kinds and // representations of types and have established them as valid. // // We now reconstruct the active environments all over again - this will add the union cases and fields. @@ -16691,7 +16691,7 @@ module TcDeclarations = (envInitial, MutRecShapes.dropEnvs mutRecDefnsAfterCore) ||> MutRecBindingChecking.TcMutRecDefns_ComputeEnvs (fun (_, tyconOpt, _, _) -> tyconOpt) - (fun _binds -> [ (* no values are available yet *) ]) + (fun _binds -> [ (* no values are available yet *) ]) cenv true scopem m let mutRecDefnsAfterVals = TcMutRecSignatureDecls_Phase2 cenv scopem envMutRecPrelimWithReprs withEnvs @@ -16754,7 +16754,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS // Now typecheck the signature, accumulating and then recording the submodule description. let id = ident (modName, id.idRange) - let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) attribs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) + let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) attribs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) let! (mtyp, _) = TcModuleOrNamespaceSignatureElementsNonMutRec cenv (Parent (mkLocalModRef mspec)) env (id, modKind, mdefs, m, xml) @@ -17033,7 +17033,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem if letrec then let scopem = unionRanges m scopem let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(containerInfo, NoNewSlots, ModuleOrMemberBinding, bind)) - let binds, env, _ = TcLetrec WarnOnOverrides cenv env tpenv (binds, m, scopem) + let binds, env, _ = TcLetrec WarnOnOverrides cenv env tpenv (binds, m, scopem) return ((fun e -> TMDefRec(true, [], binds |> List.map ModuleOrNamespaceBinding.Binding, m) :: e), []), env, env else let binds, env, _ = TcLetBindings cenv env containerInfo ModuleOrMemberBinding tpenv (binds, m, scopem) @@ -17093,7 +17093,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // // In this case the envAtEnd is the environment at the end of this module, which doesn't contain the module definition itself // but does contain the results of all the 'open' declarations and so on. - let envAtEnd = (if isContinuingModule then envAtEnd else env) + let envAtEnd = (if isContinuingModule then envAtEnd else env) return ((fun modDefs -> modDefn :: modDefs), topAttrsNew), env, envAtEnd @@ -17181,7 +17181,7 @@ and TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, let! firstDef', env', envAtEnd' = TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef // tail recursive - return! TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ( (firstDef' :: defsSoFar), env', envAtEnd') otherDefs + return! TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ( (firstDef' :: defsSoFar), env', envAtEnd') otherDefs | [] -> return List.rev defsSoFar, envAtEnd } @@ -17241,7 +17241,7 @@ and TcModuleOrNamespaceElementsMutRec cenv parent typeNames endm envInitial mutR | SynModuleDecl.DoExpr _ -> failwith "unreachable: SynModuleDecl.DoExpr - ElimModuleDoBinding" - | (SynModuleDecl.NamespaceFragment _ as d) -> error(Error(FSComp.SR.tcUnsupportedMutRecDecl(), d.Range))) + | (SynModuleDecl.NamespaceFragment _ as d) -> error(Error(FSComp.SR.tcUnsupportedMutRecDecl(), d.Range))) loop (match parent with ParentNone -> true | Parent _ -> false) [] defs @@ -17311,16 +17311,16 @@ and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo defs = //-------------------------------------------------------------------------- -let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env (p, root) = +let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env (p, root) = let warn() = warning(Error(FSComp.SR.tcAttributeAutoOpenWasIgnored(p, ccu.AssemblyName), scopem)) env let p = splitNamespace p if isNil p then warn() else let h, t = List.frontAndBack p - let modref = mkNonLocalTyconRef (mkNonLocalEntityRef ccu (Array.ofList h)) t + let modref = mkNonLocalTyconRef (mkNonLocalEntityRef ccu (Array.ofList h)) t match modref.TryDeref with - | ValueNone -> warn() + | ValueNone -> warn() | ValueSome _ -> let openDecl = OpenDeclaration.Create ([], [modref], scopem, false) OpenModulesOrNamespaces TcResultsSink.NoSink g amap scopem root env [modref] openDecl @@ -17332,7 +17332,7 @@ let AddCcuToTcEnv(g, amap, scopem, env, assemblyName, ccu, autoOpens, internalsV // See https://fslang.uservoice.com/forums/245727-f-language/suggestions/6107641-make-microsoft-prefix-optional-when-using-core-f // "Microsoft" is opened by default in FSharp.Core let autoOpens = - let autoOpens = autoOpens |> List.map (fun p -> (p, false)) + let autoOpens = autoOpens |> List.map (fun p -> (p, false)) if ccuEq ccu g.fslibCcu then // Auto open 'Microsoft' in FSharp.Core.dll. Even when using old versions of FSharp.Core.dll that do // not have this attribute. The 'true' means 'treat all namespaces so revealed as "roots" accessible via @@ -17360,17 +17360,17 @@ type ConditionalDefines = type TopAttribs = { mainMethodAttrs: Attribs netModuleAttrs: Attribs - assemblyAttrs: Attribs } + assemblyAttrs: Attribs } let EmptyTopAttrs = { mainMethodAttrs=[] netModuleAttrs=[] - assemblyAttrs =[] } + assemblyAttrs =[] } let CombineTopAttrs topAttrs1 topAttrs2 = { mainMethodAttrs = topAttrs1.mainMethodAttrs @ topAttrs2.mainMethodAttrs - netModuleAttrs = topAttrs1.netModuleAttrs @ topAttrs2.netModuleAttrs - assemblyAttrs = topAttrs1.assemblyAttrs @ topAttrs2.assemblyAttrs } + netModuleAttrs = topAttrs1.netModuleAttrs @ topAttrs2.netModuleAttrs + assemblyAttrs = topAttrs1.assemblyAttrs @ topAttrs2.assemblyAttrs } let rec IterTyconsOfModuleOrNamespaceType f (mty: ModuleOrNamespaceType) = mty.AllEntities |> QueueList.iter (fun tycon -> f tycon) @@ -17462,11 +17462,11 @@ let CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig im raise (ReportedError None) // Compute the remapping from implementation to signature - let remapInfo , _ = ComputeRemappingFromInferredSignatureToExplicitSignature cenv.g implFileTypePriorToSig sigFileType + let remapInfo, _ = ComputeRemappingFromInferredSignatureToExplicitSignature cenv.g implFileTypePriorToSig sigFileType let aenv = { TypeEquivEnv.Empty with EquivTycons = TyconRefMap.OfList remapInfo.RepackagedEntities } - if not (SignatureConformance.Checker(cenv.g, cenv.amap, denv, remapInfo, true).CheckSignature aenv (mkLocalModRef implFileSpecPriorToSig) sigFileType) then ( + if not (SignatureConformance.Checker(cenv.g, cenv.amap, denv, remapInfo, true).CheckSignature aenv (mkLocalModRef implFileSpecPriorToSig) sigFileType) then ( // We can just raise 'ReportedError' since CheckModuleOrNamespace raises its own error raise (ReportedError None) ) @@ -17501,8 +17501,8 @@ let TypeCheckOneImplFile // REVIEW: consider checking if '_others' is empty let netModuleAttrs, _others = others |> List.partition (fun (possTargets, _) -> possTargets &&& AttributeTargets.Module <> enum 0) { mainMethodAttrs = List.map snd mainMethodAttrs - netModuleAttrs = List.map snd netModuleAttrs - assemblyAttrs = List.map snd assemblyAttrs} + netModuleAttrs = List.map snd netModuleAttrs + assemblyAttrs = List.map snd assemblyAttrs} let denvAtEnd = envAtEnd.DisplayEnv let m = qualNameOfFile.Range @@ -17565,7 +17565,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 @@ -17585,7 +17585,7 @@ let TypeCheckOneImplFile /// Check an entire signature file -let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput(_, qualNameOfFile, _, _, sigFileFrags)) = +let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput(_, qualNameOfFile, _, _, sigFileFrags)) = eventually { let cenv = cenv.Create (g, false, niceNameGen, amap, topCcu, true, false, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring) let envinner, mtypeAcc = MakeInitialEnv tcEnv diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index 2d07a2b4177..05c016d3cfa 100755 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -31,14 +31,14 @@ let rec TypeDefinitelySubsumesTypeNoCoercion ndeep g amap m ty1 ty2 = let ty1 = stripTyEqns g ty1 let ty2 = stripTyEqns g ty2 match ty1, ty2 with - | TType_app (tc1, l1) , TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> + | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> List.lengthsEqAndForall2 (typeEquiv g) l1 l2 - | TType_ucase (tc1, l1) , TType_ucase (tc2, l2) when g.unionCaseRefEq tc1 tc2 -> + | TType_ucase (tc1, l1), TType_ucase (tc2, l2) when g.unionCaseRefEq tc1 tc2 -> List.lengthsEqAndForall2 (typeEquiv g) l1 l2 - | TType_tuple (tupInfo1, l1) , TType_tuple (tupInfo2, l2) -> + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 && List.lengthsEqAndForall2 (typeEquiv g) l1 l2 - | TType_fun (d1, r1) , TType_fun (d2, r2) -> + | TType_fun (d1, r1), TType_fun (d2, r2) -> typeEquiv g d1 d2 && typeEquiv g r1 r2 | TType_measure measure1, TType_measure measure2 -> measureEquiv g measure1 measure2 @@ -67,14 +67,14 @@ let rec TypesFeasiblyEquiv ndeep g amap m ty1 ty2 = let ty2 = stripTyEqns g ty2 match ty1, ty2 with // QUERY: should these be false for non-equal rigid typars? warn-if-not-rigid typars? - | TType_var _ , _ + | TType_var _, _ | _, TType_var _ -> true - | TType_app (tc1, l1) , TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> + | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 - | TType_tuple (tupInfo1, l1) , TType_tuple (tupInfo2, l2) -> + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 && List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 - | TType_fun (d1, r1) , TType_fun (d2, r2) -> + | TType_fun (d1, r1), TType_fun (d2, r2) -> (TypesFeasiblyEquiv ndeep g amap m) d1 d2 && (TypesFeasiblyEquiv ndeep g amap m) r1 r2 | TType_measure _, TType_measure _ -> true @@ -89,14 +89,14 @@ let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 = let ty2 = stripTyEqns g ty2 match ty1, ty2 with // QUERY: should these be false for non-equal rigid typars? warn-if-not-rigid typars? - | TType_var _ , _ | _, TType_var _ -> true + | TType_var _, _ | _, TType_var _ -> true - | TType_app (tc1, l1) , TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> + | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 - | TType_tuple (tupInfo1, l1) , TType_tuple (tupInfo2, l2) -> + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 && List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 - | TType_fun (d1, r1) , TType_fun (d2, r2) -> + | TType_fun (d1, r1), TType_fun (d2, r2) -> (TypesFeasiblyEquiv ndeep g amap m) d1 d2 && (TypesFeasiblyEquiv ndeep g amap m) r1 r2 | TType_measure _, TType_measure _ -> true diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index b4819ad5392..a5068dae2d6 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -526,7 +526,7 @@ and | MeasurePower of measureType: SynType * SynRationalConst * range: range /// F# syntax: 1, "abc" etc, used in parameters to type providers - /// For the dimensionless units i.e. 1 , and static parameters to provided types + /// For the dimensionless units i.e. 1, and static parameters to provided types | StaticConstant of constant: SynConst * range: range /// F# syntax: const expr, used in static parameters to type providers @@ -716,10 +716,10 @@ and /// F# syntax: expr.[expr, ..., expr] <- expr | DotIndexedSet of objectExpr: SynExpr * indexExprs: SynIndexerArg list * valueExpr: SynExpr * leftOfSetRange: range * dotRange: range * range: range - /// F# syntax: Type.Items(e1) <- e2 , rarely used named-property-setter notation, e.g. Foo.Bar.Chars(3) <- 'a' + /// 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 @@ -1312,10 +1312,10 @@ and /// A type abbreviation, "type X = A.B.C" | TypeAbbrev of ParserDetail * SynType * range: range - /// An abstract definition , "type X" + /// An abstract definition, "type X" | None of range: range - /// An exception definition , "exception E = ..." + /// An exception definition, "exception E = ..." | Exception of SynExceptionDefnRepr member this.Range = diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index ecc94eef7fd..f88d7789ee5 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -1510,7 +1510,7 @@ module StaticLinker = let access = (if isNested then ILTypeDefAccess.Nested ILMemberAccess.Public else ILTypeDefAccess.Public) let tdefs = mkILTypeDefs (List.map buildRelocatedGeneratedType ch) - mkILSimpleClass ilGlobals (ilTgtTyRef.Name, access, emptyILMethods, emptyILFields, tdefs , emptyILProperties, emptyILEvents, emptyILCustomAttrs, ILTypeInit.OnAny) + mkILSimpleClass ilGlobals (ilTgtTyRef.Name, access, emptyILMethods, emptyILFields, tdefs, emptyILProperties, emptyILEvents, emptyILCustomAttrs, ILTypeInit.OnAny) [ for (ProviderGeneratedType(_, ilTgtTyRef, _) as node) in tcImports.ProviderGeneratedTypeRoots do yield (ilTgtTyRef, buildRelocatedGeneratedType node) ] @@ -2000,7 +2000,7 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, // data structures involved here are so large we can't take the risk. Args(ctok, tcConfig, tcImports, frameworkTcImports, tcGlobals, errorLogger, generatedCcu, outfile, typedAssembly, topAttrs, pdbFile, assemblyName, - assemVerFromAttrib, signingInfo ,exiter) + assemVerFromAttrib, signingInfo,exiter) /// Phase 2a: encode signature data, optimize, encode optimization data diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index e3c60242137..b5341a5d64b 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -696,8 +696,8 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s Some (FSIstrings.SR.fsiHelp())) ]); PrivateOptions( - [ CompilerOption("?" , tagNone, OptionHelp (fun blocks -> displayHelpFsi tcConfigB blocks), None, None); // "Short form of --help"); - CompilerOption("help" , tagNone, OptionHelp (fun blocks -> displayHelpFsi tcConfigB blocks), None, None); // "Short form of --help"); + [ CompilerOption("?", tagNone, OptionHelp (fun blocks -> displayHelpFsi tcConfigB blocks), None, None); // "Short form of --help"); + CompilerOption("help", tagNone, OptionHelp (fun blocks -> displayHelpFsi tcConfigB blocks), None, None); // "Short form of --help"); CompilerOption("full-help", tagNone, OptionHelp (fun blocks -> displayHelpFsi tcConfigB blocks), None, None); // "Short form of --help"); ]); PublicOptions(FSComp.SR.optsHelpBannerAdvanced(), @@ -1977,9 +1977,9 @@ type internal FsiInteractionProcessor let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option) = let action,nextAction,istate = match action with - | None -> None ,None,istate + | None -> None,None,istate | Some (IHash _) -> action,None,istate - | Some (IDefns ([],_)) -> None ,None,istate + | Some (IDefns ([],_)) -> None,None,istate | Some (IDefns (SynModuleDecl.HashDirective(hash,mh)::defs,m)) -> Some (IHash(hash,mh)),Some (IDefns(defs,m)),istate @@ -1989,7 +1989,7 @@ type internal FsiInteractionProcessor // only add automatic debugger breaks before 'let' or 'do' expressions with sequence points match def with | SynModuleDecl.DoExpr (SequencePointInfoForBinding.SequencePointAtBinding _, _, _) - | SynModuleDecl.Let (_, SynBinding.Binding(_, _, _, _, _, _, _, _ ,_ ,_ ,_ , SequencePointInfoForBinding.SequencePointAtBinding _) :: _, _) -> true + | SynModuleDecl.Let (_, SynBinding.Binding(_, _, _, _, _, _, _, _,_,_,_, SequencePointInfoForBinding.SequencePointAtBinding _) :: _, _) -> true | _ -> false let defsA = Seq.takeWhile (isDefHash >> not) defs |> Seq.toList let defsB = Seq.skipWhile (isDefHash >> not) defs |> Seq.toList diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs index 02eaf804773..2fa02f41025 100644 --- a/src/fsharp/layout.fs +++ b/src/fsharp/layout.fs @@ -58,8 +58,8 @@ let mkNode l r joint = //-------------------------------------------------------------------------- let wordL (str:TaggedText) = Leaf (false, str, false) -let sepL (str:TaggedText) = Leaf (true , str, true) -let rightL (str:TaggedText) = Leaf (true , str, false) +let sepL (str:TaggedText) = Leaf (true, str, true) +let rightL (str:TaggedText) = Leaf (true, str, false) let leftL (str:TaggedText) = Leaf (false, str, true) module TaggedTextOps = @@ -361,13 +361,13 @@ let squashTo maxWidth layout = let breaks, r, pos, offsetr = fit breaks (pos, r) let breaks, broken = popBreak breaks if broken then - breaks, Node (jl, l, jm, r, jr, Broken indent) , pos, indent + offsetr + breaks, Node (jl, l, jm, r, jr, Broken indent), pos, indent + offsetr else breaks, Node (jl, l, jm, r, jr, Breakable indent), pos, offsetl + mid + offsetr else (* actually no saving so no break *) let breaks, r, pos, offsetr = fit breaks (pos, r) - breaks, Node (jl, l, jm, r, jr, Breakable indent) , pos, offsetl + mid + offsetr + breaks, Node (jl, l, jm, r, jr, Breakable indent), pos, offsetl + mid + offsetr (*printf "\nDone: pos=%d offset=%d" pos offset*) breaks, layout, pos, offset let breaks = breaks0 () diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index aef3d2d8d05..1a7afd753f8 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -1218,7 +1218,7 @@ moduleDefn: /* 'type' definitions */ | opt_attributes opt_declVisibility typeKeyword tyconDefn tyconDefnList { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) - let (TypeDefn(ComponentInfo(cas ,a,cs,b,c,d,d2,d3),e,f,g)) = $4 + let (TypeDefn(ComponentInfo(cas,a,cs,b,c,d,d2,d3),e,f,g)) = $4 let tc = (TypeDefn(ComponentInfo($1@cas,a,cs,b,c,d,d2,d3),e,f,g)) let types = tc :: $5 [ SynModuleDecl.Types(types, (rhs parseState 3, types) ||> unionRangeWithListBy (fun t -> t.Range) ) ] } @@ -1288,7 +1288,7 @@ namedModuleDefnBlock: // System.DateTime.Now // module M2 = // Microsoft.FSharp.Core.List - // The second is a module abbreviation , the first a module containing a single expression. + // The second is a module abbreviation, the first a module containing a single expression. // The resolution is in favour of the module abbreviation, i.e. anything of the form // module M2 = ID.ID.ID.ID // will be taken as a module abbreviation, regardles of the identifiers themselves. @@ -2493,7 +2493,7 @@ cPrototype: let bindingId = SynPat.LongIdent (LongIdentWithDots([nm],[]), None, Some noInferredTypars, SynConstructorArgs.Pats [SynPat.Tuple(false,args,argsm)], vis, nmm) let binding = mkSynBinding (xmlDoc, bindingId) - (vis, false, false, mBindLhs, NoSequencePointAtInvisibleBinding, Some rty ,rhsExpr, mRhs, [], attrs, None) + (vis, false, false, mBindLhs, NoSequencePointAtInvisibleBinding, Some rty, rhsExpr, mRhs, [], attrs, None) [], [binding]) } /* A list of arguments in an 'extern' DllImport function definition */ @@ -3038,7 +3038,7 @@ declExpr: | hardwhiteLetBindings OBLOCKSEP typedSeqExprBlock %prec expr_let { let hwlb,m = $1 - mkLocalBindings (unionRanges m $3.Range ,hwlb,$3) } + mkLocalBindings (unionRanges m $3.Range, hwlb, $3) } | hardwhiteLetBindings OBLOCKSEP error %prec expr_let { let hwlb,m = $1 @@ -4727,7 +4727,7 @@ measureTypeExpr: typar: | QUOTE ident { let id = mkSynId (lhs parseState) ($2).idText - Typar(id ,NoStaticReq,false) } + Typar(id, NoStaticReq,false) } | staticallyKnownHeadTypar { $1 } diff --git a/src/fsharp/range.fs b/src/fsharp/range.fs index 84419892a78..2bf3f17f613 100755 --- a/src/fsharp/range.fs +++ b/src/fsharp/range.fs @@ -325,7 +325,7 @@ let rangeCmdArgs = rangeN "commandLineArgs" 0 let trimRangeToLine (r:range) = let startL, startC = r.StartLine, r.StartColumn - let endL , _endC = r.EndLine, r.EndColumn + let endL, _endC = r.EndLine, r.EndColumn if endL <= startL then r else diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 836a4f288bd..d061f3f75ee 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -529,7 +529,7 @@ module internal IncrementalBuild = match found with | VectorResult rv -> if rv.Size <> expectedWidth then - actionFunc (ResizeResultAction(ve.Id , expectedWidth)) acc + actionFunc (ResizeResultAction(ve.Id, expectedWidth)) acc else acc | _ -> acc | None -> acc @@ -1286,7 +1286,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput try IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed filename) - let input = ParseOneInputFile(tcConfig, lexResourceManager, [], filename , isLastCompiland, errorLogger, (*retryLocked*)true) + let input = ParseOneInputFile(tcConfig, lexResourceManager, [], filename, isLastCompiland, errorLogger, (*retryLocked*)true) fileParsed.Trigger (filename) input, sourceRange, filename, errorLogger.GetErrors () diff --git a/src/fsharp/service/ServiceInterfaceStubGenerator.fs b/src/fsharp/service/ServiceInterfaceStubGenerator.fs index d2ec593838a..e4a2bc7e029 100644 --- a/src/fsharp/service/ServiceInterfaceStubGenerator.fs +++ b/src/fsharp/service/ServiceInterfaceStubGenerator.fs @@ -124,7 +124,7 @@ type internal InterfaceData = sprintf "- %s" s let rec (|TypeIdent|_|) = function - | SynType.Var(SynTypar.Typar(s, req , _), _) -> + | SynType.Var(SynTypar.Typar(s, req, _), _) -> match req with | NoStaticReq -> Some ("'" + s.idText) @@ -240,16 +240,18 @@ module internal InterfaceStubGenerator = name :: acc, allNames) ([], namesWithIndices) List.rev argsSoFar' :: argsSoFar, namesWithIndices) ([], Map.ofList [ ctx.ObjectIdent, Set.empty ]) - args - |> List.rev - |> List.map (function - | [] -> unit - | [arg] when arg = unit -> unit - | [arg] when not v.IsMember || isItemIndexer -> arg - | args when isItemIndexer -> String.concat tupSep args - | args -> bracket (String.concat tupSep args)) - |> String.concat argSep - , namesWithIndices + let argText = + args + |> List.rev + |> List.map (function + | [] -> unit + | [arg] when arg = unit -> unit + | [arg] when not v.IsMember || isItemIndexer -> arg + | args when isItemIndexer -> String.concat tupSep args + | args -> bracket (String.concat tupSep args)) + |> String.concat argSep + + argText, namesWithIndices [] type internal MemberInfo = @@ -307,11 +309,12 @@ module internal InterfaceStubGenerator = "", Map.ofList [ctx.ObjectIdent, Set.empty] | _ -> formatArgsUsage ctx verboseMode v argInfos - if String.IsNullOrWhiteSpace(args) then "" - elif args.StartsWithOrdinal("(") then args - elif v.CurriedParameterGroups.Count > 1 && (not verboseMode) then " " + args - else sprintf "(%s)" args - , namesWithIndices + let argText = + if String.IsNullOrWhiteSpace(args) then "" + elif args.StartsWithOrdinal("(") then args + elif v.CurriedParameterGroups.Count > 1 && (not verboseMode) then " " + args + else sprintf "(%s)" args + argText, namesWithIndices let preprocess (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = let buildUsage argInfos = diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index e751049ebfc..3932fbf4b60 100755 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -227,7 +227,7 @@ module internal TokenClassifications = | QUOTE | UNDERSCORE | INFIX_AT_HAT_OP _ - -> (FSharpTokenColorKind.Identifier , FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) + -> (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) | LESS _ -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.ParamStart) // for type provider static arguments diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index 1e6b98ebdc4..0f465a28037 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -1134,7 +1134,7 @@ module UntypedParseImpl = Some (id.idRange.End, findSetters arg) | (SynExpr.App (_, false, SynExpr.TypeApp(SynExpr.Ident id, _, _, _, mGreaterThan, _, _), arg, _)) -> // A<_>() - Some (endOfClosingTokenOrIdent mGreaterThan id , findSetters arg) + Some (endOfClosingTokenOrIdent mGreaterThan id, findSetters arg) | (SynExpr.App (_, false, SynExpr.LongIdent(_, lid, _, _), arg, _)) -> // A.B() Some (endOfLastIdent lid, findSetters arg) diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 3f89cebafd5..7adcdfbee4e 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -1051,7 +1051,7 @@ and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = match d, uc.V with | RecdOrClass r1, RecdOrClass r2 -> recdFieldRefOrder.Compare(r1, r2) = 0 | Union (u1, n1), Union (u2, n2) -> cenv.g.unionCaseRefEq u1 u2 && n1 = n2 - | AnonField (anonInfo1, _, _, _) , AnonField (anonInfo2, _, _, _) -> x.Name = uc.Name && anonInfoEquiv anonInfo1 anonInfo2 + | AnonField (anonInfo1, _, _, _), AnonField (anonInfo2, _, _, _) -> x.Name = uc.Name && anonInfoEquiv anonInfo1 anonInfo2 | _ -> false | _ -> false diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 08851f56464..687c81ce145 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. //------------------------------------------------------------------------- // Defines the typed abstract syntax trees used throughout the F# compiler. @@ -45,7 +45,7 @@ type Stamp = int64 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) +// ++GLOBAL MUTABLE STATE (concurrency safe by locking inside NiceNameGenerator) let globalNng = NiceNameGenerator() /// A global generator of stable compiler generated names @@ -88,7 +88,7 @@ type ValRecursiveScopeInfo = /// The normal value for this flag when the value is not within its recursive scope | ValNotInRecScope -type ValMutability = +type ValMutability = | Immutable | Mutable @@ -343,7 +343,7 @@ type TyparFlags(flags: int32) = member x.IsCompilerGenerated = (flags &&& 0b00000000000000100) <> 0x0 /// Indicates if the type variable has a static "head type" requirement, i.e. ^a variables used in FSharp.Core and member constraints. - member x.StaticReq = + member x.StaticReq = match (flags &&& 0b00000000000001000) with | 0b00000000000000000 -> NoStaticReq | 0b00000000000001000 -> HeadTypeStaticReq @@ -361,7 +361,7 @@ type TyparFlags(flags: int32) = | _ -> failwith "unreachable" /// Indicates whether a type variable can be instantiated by types or units-of-measure. - member x.Kind = + member x.Kind = match (flags &&& 0b00001000100000000) with | 0b00000000000000000 -> TyparKind.Type | 0b00000000100000000 -> TyparKind.Measure @@ -373,7 +373,7 @@ type TyparFlags(flags: int32) = (flags &&& 0b00000001000000000) <> 0x0 /// Indicates if a type parameter is needed at runtime and may not be eliminated - member x.DynamicReq = + member x.DynamicReq = match (flags &&& 0b00000010000000000) with | 0b00000000000000000 -> TyparDynamicReq.No | 0b00000010000000000 -> TyparDynamicReq.Yes @@ -394,7 +394,7 @@ type TyparFlags(flags: int32) = TyparFlags(flags &&& ~~~0b00010000000000000) /// Get the flags as included in the F# binary metadata. We pickle this as int64 to allow for future expansion - member x.PickledBits = flags + member x.PickledBits = flags /// Encode entity flags into a bit field. We leave lots of space to allow for future expansion. [] @@ -513,13 +513,13 @@ let ComputeDefinitionLocationOfProvidedItem (p: Tainted<#IProvidedCustomAttribut // Coordinates from type provider are 1-based for lines and columns // Coordinates internally in the F# compiler are 1-based for lines and 0-based for columns let pos = Range.mkPos line (max 0 (column - 1)) - Range.mkRange filePath pos pos |> Some + Range.mkRange filePath pos pos |> Some #endif /// A public path records where a construct lives within the global namespace /// of a CCU. -type PublicPath = +type PublicPath = | PubPath of string[] member x.EnclosingPath = let (PubPath(pp)) = x @@ -597,7 +597,7 @@ type EntityOptionalData = } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "EntityOptionalData(...)" @@ -605,7 +605,7 @@ and /// Represents a type definition, exception definition, module definition or [] Entity = { /// The declared type parameters of the type - // MUTABILITY; used only during creation and remapping of tycons + // MUTABILITY; used only during creation and remapping of tycons mutable entity_typars: LazyWithContext mutable entity_flags: EntityFlags @@ -638,7 +638,7 @@ and /// Represents a type definition, exception definition, module definition or /// This field is used when the 'tycon' is really a module definition. It holds statically nested type definitions and nested modules // - // MUTABILITY: only used during creation and remapping of tycons and + // MUTABILITY: only used during creation and remapping of tycons and // when compiling fslib to fixup compiler forward references to internal items mutable entity_modul_contents: MaybeLazy @@ -737,8 +737,8 @@ and /// Represents a type definition, exception definition, module definition or match x.TypeReprInfo with | TProvidedTypeExtensionPoint info -> match ComputeDefinitionLocationOfProvidedItem info.ProvidedType with - | Some range -> range - | None -> x.entity_range + | Some range -> range + | None -> x.entity_range | _ -> #endif x.entity_range @@ -754,7 +754,7 @@ and /// Represents a type definition, exception definition, module definition or | Some { entity_other_range = Some (r, false) } -> r | _ -> x.Range - member x.SetOtherRange m = + member x.SetOtherRange m = match x.entity_opt_data with | Some optData -> optData.entity_other_range <- Some m | _ -> x.entity_opt_data <- Some { Entity.NewEmptyEntityOptData() with entity_other_range = Some m } @@ -935,7 +935,7 @@ and /// Represents a type definition, exception definition, module definition or member x.AllFieldTable = match x.TypeReprInfo with | TRecdRepr x | TFSharpObjectRepr {fsobjmodel_rfields=x} -> x - | _ -> + | _ -> match x.ExceptionInfo with | TExnFresh x -> x | _ -> @@ -970,13 +970,13 @@ and /// Represents a type definition, exception definition, module definition or member x.GetFieldByName n = x.AllFieldTable.FieldByName n /// Indicate if this is a type whose r.h.s. is known to be a union type definition. - member x.IsUnionTycon = match x.TypeReprInfo with | TUnionRepr _ -> true | _ -> false + member x.IsUnionTycon = match x.TypeReprInfo with | TUnionRepr _ -> true | _ -> false /// Get the union cases and other union-type information for a type, if any member x.UnionTypeInfo = match x.TypeReprInfo with | TUnionRepr x -> ValueSome x - | _ -> ValueNone + | _ -> ValueNone /// Get the union cases for a type, if any member x.UnionCasesArray = @@ -990,7 +990,7 @@ and /// Represents a type definition, exception definition, module definition or /// Get a union case of a type by name member x.GetUnionCaseByName n = match x.UnionTypeInfo with - | ValueSome x -> NameMap.tryFind n x.CasesTable.CasesByName + | ValueSome x -> NameMap.tryFind n x.CasesTable.CasesByName | ValueNone -> None @@ -1011,22 +1011,22 @@ and /// Represents a type definition, exception definition, module definition or entity_opt_data = Unchecked.defaultof<_>} /// Create a new entity with the given backing data. Only used during unpickling of F# metadata. - static member New _reason (data: Entity) : Entity = data + static member New _reason (data: Entity) : Entity = data /// Link an entity based on empty, unlinked data to the given data. Only used during unpickling of F# metadata. member x.Link (tg: EntityData) = - x.entity_typars <- tg.entity_typars - x.entity_flags <- tg.entity_flags - x.entity_stamp <- tg.entity_stamp - x.entity_logical_name <- tg.entity_logical_name - x.entity_range <- tg.entity_range - x.entity_attribs <- tg.entity_attribs - x.entity_tycon_repr <- tg.entity_tycon_repr - x.entity_tycon_tcaug <- tg.entity_tycon_tcaug - x.entity_modul_contents <- tg.entity_modul_contents - x.entity_pubpath <- tg.entity_pubpath - x.entity_cpath <- tg.entity_cpath - x.entity_il_repr_cache <- tg.entity_il_repr_cache + x.entity_typars <- tg.entity_typars + x.entity_flags <- tg.entity_flags + x.entity_stamp <- tg.entity_stamp + x.entity_logical_name <- tg.entity_logical_name + x.entity_range <- tg.entity_range + x.entity_attribs <- tg.entity_attribs + x.entity_tycon_repr <- tg.entity_tycon_repr + x.entity_tycon_tcaug <- tg.entity_tycon_tcaug + x.entity_modul_contents <- tg.entity_modul_contents + x.entity_pubpath <- tg.entity_pubpath + x.entity_cpath <- tg.entity_cpath + x.entity_il_repr_cache <- tg.entity_il_repr_cache match tg.entity_opt_data with | Some tg -> x.entity_opt_data <- @@ -1049,68 +1049,68 @@ and /// Represents a type definition, exception definition, module definition or member x.FSharpObjectModelTypeInfo = match x.TypeReprInfo with | TFSharpObjectRepr x -> x - | _ -> failwith "not an F# object model type definition" + | _ -> failwith "not an F# object model type definition" /// Indicate if this is a type definition backed by Abstract IL metadata. - member x.IsILTycon = match x.TypeReprInfo with | TILObjectRepr _ -> true | _ -> false + member x.IsILTycon = match x.TypeReprInfo with | TILObjectRepr _ -> true | _ -> false /// Get the Abstract IL scope, nesting and metadata for this /// type definition, assuming it is backed by Abstract IL metadata. - member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr data -> data | _ -> failwith "not a .NET type definition" + member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr data -> data | _ -> failwith "not a .NET type definition" /// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata. member x.ILTyconRawMetadata = let (TILObjectReprData(_, _, td)) = x.ILTyconInfo in td /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition. - member x.IsRecordTycon = match x.TypeReprInfo with | TRecdRepr _ -> true | _ -> false + member x.IsRecordTycon = match x.TypeReprInfo with | TRecdRepr _ -> true | _ -> false /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition that is a value type. member x.IsStructRecordOrUnionTycon = match x.TypeReprInfo with TRecdRepr _ | TUnionRepr _ -> x.entity_flags.IsStructRecordOrUnionType | _ -> false /// The on-demand analysis about whether the entity has the IsByRefLike attribute - member x.TryIsByRefLike = x.entity_flags.TryIsByRefLike + member x.TryIsByRefLike = x.entity_flags.TryIsByRefLike /// Set the on-demand analysis about whether the entity has the IsByRefLike attribute - member x.SetIsByRefLike b = x.entity_flags <- x.entity_flags.WithIsByRefLike b + member x.SetIsByRefLike b = x.entity_flags <- x.entity_flags.WithIsByRefLike b /// 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 = x.entity_flags.TryIsReadOnly + member x.TryIsReadOnly = x.entity_flags.TryIsReadOnly /// Set the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct - member x.SetIsReadOnly b = x.entity_flags <- x.entity_flags.WithIsReadOnly b + member x.SetIsReadOnly b = x.entity_flags <- x.entity_flags.WithIsReadOnly b /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition - member x.IsFSharpObjectModelTycon = match x.TypeReprInfo with | TFSharpObjectRepr _ -> true | _ -> false + member x.IsFSharpObjectModelTycon = match x.TypeReprInfo with | TFSharpObjectRepr _ -> true | _ -> false /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll which uses /// an assembly-code representation for the type, e.g. the primitive array type constructor. - member x.IsAsmReprTycon = match x.TypeReprInfo with | TAsmRepr _ -> true | _ -> false + member x.IsAsmReprTycon = match x.TypeReprInfo with | TAsmRepr _ -> true | _ -> false /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll like 'float<_>' which /// defines a measure type with a relation to an existing non-measure type as a representation. - member x.IsMeasureableReprTycon = match x.TypeReprInfo with | TMeasureableRepr _ -> true | _ -> false + member x.IsMeasureableReprTycon = match x.TypeReprInfo with | TMeasureableRepr _ -> true | _ -> false /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature, /// which in F# is called a 'unknown representation' type). - member x.IsHiddenReprTycon = match x.TypeAbbrev, x.TypeReprInfo with | None, TNoRepr -> true | _ -> false + member x.IsHiddenReprTycon = match x.TypeAbbrev, x.TypeReprInfo with | None, TNoRepr -> true | _ -> false /// Indicates if this is an F#-defined interface type definition member x.IsFSharpInterfaceTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconInterface -> true | _ -> false /// Indicates if this is an F#-defined delegate type definition - member x.IsFSharpDelegateTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconDelegate _ -> true | _ -> false + member x.IsFSharpDelegateTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconDelegate _ -> true | _ -> false /// Indicates if this is an F#-defined enum type definition - member x.IsFSharpEnumTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconEnum -> true | _ -> false + member x.IsFSharpEnumTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconEnum -> true | _ -> false /// Indicates if this is an F#-defined class type definition - member x.IsFSharpClassTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconClass -> true | _ -> false + member x.IsFSharpClassTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconClass -> true | _ -> false /// Indicates if this is a .NET-defined enum type definition - member x.IsILEnumTycon = x.IsILTycon && x.ILTyconRawMetadata.IsEnum + member x.IsILEnumTycon = x.IsILTycon && x.ILTyconRawMetadata.IsEnum /// Indicates if this is an enum type definition - member x.IsEnumTycon = + member x.IsEnumTycon = #if !NO_EXTENSIONTYPING match x.TypeReprInfo with | TProvidedTypeExtensionPoint info -> info.IsEnum @@ -1120,23 +1120,23 @@ and /// Represents a type definition, exception definition, module definition or x.IsILEnumTycon || x.IsFSharpEnumTycon - /// Indicates if this is an F#-defined struct or enum type definition , i.e. a value type definition + /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition member x.IsFSharpStructOrEnumTycon = match x.TypeReprInfo with | TRecdRepr _ -> x.IsStructRecordOrUnionTycon | TUnionRepr _ -> x.IsStructRecordOrUnionTycon | TFSharpObjectRepr info -> match info.fsobjmodel_kind with - | TTyconClass | TTyconInterface | TTyconDelegate _ -> false + | TTyconClass | TTyconInterface | TTyconDelegate _ -> false | TTyconStruct | TTyconEnum -> true | _ -> false - /// Indicates if this is a .NET-defined struct or enum type definition , i.e. a value type definition + /// Indicates if this is a .NET-defined struct or enum type definition, i.e. a value type definition member x.IsILStructOrEnumTycon = x.IsILTycon && x.ILTyconRawMetadata.IsStructOrEnum - /// Indicates if this is a struct or enum type definition , i.e. a value type definition + /// Indicates if this is a struct or enum type definition, i.e. a value type definition member x.IsStructOrEnumTycon = #if !NO_EXTENSIONTYPING match x.TypeReprInfo with @@ -1214,9 +1214,9 @@ and /// Represents a type definition, exception definition, module definition or | _ -> #endif let ilTypeRefForCompilationPath (CompPath(sref, p)) item = - let rec top racc p = + let rec top racc p = match p with - | [] -> ILTypeRef.Create(sref, [], textOfPath (List.rev (item::racc))) + | [] -> ILTypeRef.Create(sref, [], textOfPath (List.rev (item::racc))) | (h, istype)::t -> match istype with | FSharpModuleWithSuffix | ModuleOrType -> @@ -1244,7 +1244,7 @@ and /// Represents a type definition, exception definition, module definition or let ilTypeOpt = match x.TyparsNoRange with | [] -> Some (mkILTy boxity (mkILTySpec (ilTypeRef, []))) - | _ -> None + | _ -> None CompiledTypeRepr.ILAsmNamed (ilTypeRef, boxity, ilTypeOpt)) /// Gets the data indicating the compiled representation of a named type or module in terms of Abstract IL data structures. @@ -1264,10 +1264,10 @@ and /// Represents a type definition, exception definition, module definition or member x.SetAttribs attribs = x.entity_attribs <- attribs /// Sets the structness of a record or union type definition - member x.SetIsStructRecordOrUnion b = let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) + member x.SetIsStructRecordOrUnion b = let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = x.LogicalName @@ -1339,13 +1339,13 @@ and mutable tcaug_abstract: bool } - member tcaug.SetCompare x = tcaug.tcaug_compare <- Some x + member tcaug.SetCompare x = tcaug.tcaug_compare <- Some x - member tcaug.SetCompareWith x = tcaug.tcaug_compare_withc <- Some x + member tcaug.SetCompareWith x = tcaug.tcaug_compare_withc <- Some x - member tcaug.SetEquals x = tcaug.tcaug_equals <- Some x + member tcaug.SetEquals x = tcaug.tcaug_equals <- Some x - member tcaug.SetHashAndEqualsWith x = tcaug.tcaug_hash_and_equals_withc <- Some x + member tcaug.SetHashAndEqualsWith x = tcaug.tcaug_hash_and_equals_withc <- Some x member tcaug.SetHasObjectGetHashCode b = tcaug.tcaug_hasObjectGetHashCode <- b @@ -1363,7 +1363,7 @@ and tcaug_abstract=false } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TyconAugmentation(...)" @@ -1373,22 +1373,22 @@ and TyconRepresentation = /// Indicates the type is a class, struct, enum, delegate or interface - | TFSharpObjectRepr of TyconObjModelData + | TFSharpObjectRepr of TyconObjModelData /// Indicates the type is a record - | TRecdRepr of TyconRecdFields + | TRecdRepr of TyconRecdFields /// Indicates the type is a discriminated union - | TUnionRepr of TyconUnionData + | TUnionRepr of TyconUnionData /// Indicates the type is a type from a .NET assembly without F# metadata. - | TILObjectRepr of TILObjectReprData + | TILObjectRepr of TILObjectReprData /// Indicates the type is implemented as IL assembly code using the given closed Abstract IL type - | TAsmRepr of ILType + | TAsmRepr of ILType /// Indicates the type is parameterized on a measure (e.g. float<_>) but erases to some other type (e.g. float) - | TMeasureableRepr of TType + | TMeasureableRepr of TType #if !NO_EXTENSIONTYPING /// TProvidedTypeExtensionPoint @@ -1413,7 +1413,7 @@ and | TNoRepr //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -1424,7 +1424,7 @@ and | TILObjectReprData of ILScopeRef * ILTypeDef list * ILTypeDef [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TILObjectReprData(...)" @@ -1441,20 +1441,20 @@ and /// The underlying System.Type (wrapped as a ProvidedType to make sure we don't call random things on /// System.Type, and wrapped as Tainted to make sure we track which provider this came from, for reporting /// error messages) - ProvidedType: Tainted + ProvidedType: Tainted /// The base type of the type. We use it to compute the compiled representation of the type for erased types. /// Reading is delayed, since it does an import on the underlying type LazyBaseType: LazyWithContext /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsClass: bool + IsClass: bool /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsSealed: bool + IsSealed: bool /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsInterface: bool + IsInterface: bool /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. IsStructOrEnum: bool @@ -1483,7 +1483,7 @@ and else failwith "expect erased type" [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TProvidedTypeInfo(...)" @@ -1508,7 +1508,7 @@ and member x.IsValueType = match x with - | TTyconClass | TTyconInterface | TTyconDelegate _ -> false + | TTyconClass | TTyconInterface | TTyconDelegate _ -> false | TTyconStruct | TTyconEnum -> true and @@ -1524,7 +1524,7 @@ and fsobjmodel_rfields: TyconRecdFields } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TyconObjModelData(...)" @@ -1550,7 +1550,7 @@ and member x.TrueInstanceFieldsAsList = x.AllFieldsAsList |> List.filter (fun f -> not f.IsStatic && not f.IsCompilerGenerated) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TyconRecdFields(...)" @@ -1569,7 +1569,7 @@ and member x.UnionCasesAsList = x.CasesByIndex |> Array.toList [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TyconUnionCases(...)" @@ -1585,7 +1585,7 @@ and member x.UnionCasesAsList = x.CasesTable.CasesByIndex |> Array.toList [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TyconUnionData(...)" @@ -1649,7 +1649,7 @@ and member uc.IsNullary = (uc.FieldTable.FieldsByIndex.Length = 0) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "UnionCase(" + x.DisplayName + ")" @@ -1756,20 +1756,20 @@ and /// The default initialization info, for static literals member v.LiteralValue = - match v.rfield_const with + match v.rfield_const with | None -> None | Some Const.Zero -> None | Some k -> Some k /// Indicates if the field is zero-initialized member v.IsZeroInit = - match v.rfield_const with + match v.rfield_const with | None -> false | Some Const.Zero -> true | _ -> false [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = x.Name @@ -1790,7 +1790,7 @@ and // %+A formatting is used, so this is not needed //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -1865,35 +1865,35 @@ and [] member mtyp.ActivePatternElemRefLookupTable = activePatternElemRefCache /// Get a list of types defined within this module, namespace or type. - member mtyp.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList + member mtyp.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList /// Get a list of F# exception definitions defined within this module, namespace or type. - member mtyp.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList + member mtyp.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList /// Get a list of module and namespace definitions defined within this module, namespace or type. member mtyp.ModuleAndNamespaceDefinitions = entities |> Seq.filter (fun x -> x.IsModuleOrNamespace) |> Seq.toList /// Get a list of type and exception definitions defined within this module, namespace or type. - member mtyp.TypeAndExceptionDefinitions = entities |> Seq.filter (fun x -> not x.IsModuleOrNamespace) |> Seq.toList + member mtyp.TypeAndExceptionDefinitions = entities |> Seq.filter (fun x -> not x.IsModuleOrNamespace) |> Seq.toList /// Get a table of types defined within this module, namespace or type. The /// table is indexed by both name and generic arity. This means that for generic /// types "List`1", the entry (List, 1) will be present. member mtyp.TypesByDemangledNameAndArity m = cacheOptRef tyconsByDemangledNameAndArityCache (fun () -> - LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc: Tycon) -> KeyTyconByDemangledNameAndArity tc.LogicalName (tc.Typars m) tc) |> List.toArray)) + LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc: Tycon) -> KeyTyconByDemangledNameAndArity tc.LogicalName (tc.Typars m) tc) |> List.toArray)) /// Get a table of types defined within this module, namespace or type. The /// table is indexed by both name and, for generic types, also by mangled name. member mtyp.TypesByAccessNames = cacheOptRef tyconsByAccessNamesCache (fun () -> - LayeredMultiMap.Empty.AddAndMarkAsCollapsible (mtyp.TypeAndExceptionDefinitions |> List.toArray |> Array.collect (fun (tc: Tycon) -> KeyTyconByAccessNames tc.LogicalName tc))) + LayeredMultiMap.Empty.AddAndMarkAsCollapsible (mtyp.TypeAndExceptionDefinitions |> List.toArray |> Array.collect (fun (tc: Tycon) -> KeyTyconByAccessNames tc.LogicalName tc))) // REVIEW: we can remove this lookup and use AllEntitiedByMangledName instead? member mtyp.TypesByMangledName = let addTyconByMangledName (x: Tycon) tab = NameMap.add x.LogicalName x tab cacheOptRef tyconsByMangledNameCache (fun () -> - List.foldBack addTyconByMangledName mtyp.TypeAndExceptionDefinitions Map.empty) + List.foldBack addTyconByMangledName mtyp.TypeAndExceptionDefinitions Map.empty) /// Get a table of entities indexed by both logical and compiled names member mtyp.AllEntitiesByCompiledAndLogicalMangledNames: NameMap = @@ -1905,12 +1905,12 @@ and [] else NameMap.add name2 x tab cacheOptRef allEntitiesByMangledNameCache (fun () -> - QueueList.foldBack addEntityByMangledName entities Map.empty) + QueueList.foldBack addEntityByMangledName entities Map.empty) /// Get a table of entities indexed by both logical name member mtyp.AllEntitiesByLogicalMangledName: NameMap = let addEntityByMangledName (x: Entity) tab = NameMap.add x.LogicalName x tab - QueueList.foldBack addEntityByMangledName entities Map.empty + QueueList.foldBack addEntityByMangledName entities Map.empty /// Get a table of values and members indexed by partial linkage key, which includes name, the mangled name of the parent type (if any), /// and the method argument count (if any). @@ -1958,7 +1958,7 @@ and [] member mtyp.ExceptionDefinitionsByDemangledName = let add (tycon: Tycon) acc = NameMap.add tycon.LogicalName tycon acc cacheOptRef exconsByDemangledNameCache (fun () -> - List.foldBack add mtyp.ExceptionDefinitions Map.empty) + List.foldBack add mtyp.ExceptionDefinitions Map.empty) /// Get a table of nested module and namespace fragments indexed by demangled name (so 'ListModule' becomes 'List') member mtyp.ModulesAndNamespacesByDemangledName = @@ -1967,10 +1967,10 @@ and [] NameMap.add entity.DemangledModuleOrNamespaceName entity acc else acc cacheOptRef modulesByDemangledNameCache (fun () -> - QueueList.foldBack add entities Map.empty) + QueueList.foldBack add entities Map.empty) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "ModuleOrNamespaceType(...)" @@ -2099,7 +2099,7 @@ and | TAccess of CompilationPath list [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "Accessibility(...)" @@ -2122,7 +2122,7 @@ and } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override __.ToString() = sprintf "TyparOptionalData(...)" @@ -2156,22 +2156,22 @@ and mutable typar_opt_data: TyparOptionalData option } /// The name of the type parameter - member x.Name = x.typar_id.idText + member x.Name = x.typar_id.idText /// The range of the identifier for the type parameter definition - member x.Range = x.typar_id.idRange + member x.Range = x.typar_id.idRange /// The identifier for a type parameter definition - member x.Id = x.typar_id + member x.Id = x.typar_id /// The unique stamp of the type parameter - member x.Stamp = x.typar_stamp + member x.Stamp = x.typar_stamp /// The inferred equivalence for the type inference variable, if any. - member x.Solution = x.typar_solution + member x.Solution = x.typar_solution /// The inferred constraints for the type inference variable, if any - member x.Constraints = + member x.Constraints = match x.typar_opt_data with | Some optData -> optData.typar_constraints | _ -> [] @@ -2181,10 +2181,10 @@ and /// Indicates if the type variable can be solved or given new constraints. The status of a type variable /// generally always evolves towards being either rigid or solved. - member x.Rigidity = x.typar_flags.Rigidity + member x.Rigidity = x.typar_flags.Rigidity /// Indicates if a type parameter is needed at runtime and may not be eliminated - member x.DynamicReq = x.typar_flags.DynamicReq + member x.DynamicReq = x.typar_flags.DynamicReq /// Indicates that whether or not a generic type definition satisfies the equality constraint is dependent on whether this type variable satisfies the equality constraint. member x.EqualityConditionalOn = x.typar_flags.EqualityConditionalOn @@ -2193,30 +2193,30 @@ and member x.ComparisonConditionalOn = x.typar_flags.ComparisonConditionalOn /// Indicates if the type variable has a static "head type" requirement, i.e. ^a variables used in FSharp.Core and member constraints. - member x.StaticReq = x.typar_flags.StaticReq + member x.StaticReq = x.typar_flags.StaticReq /// Indicates if the type inference variable was generated after an error when type checking expressions or patterns - member x.IsFromError = x.typar_flags.IsFromError + member x.IsFromError = x.typar_flags.IsFromError /// Indicates that whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning) - member x.IsCompatFlex = x.typar_flags.IsCompatFlex + 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 + member x.Kind = x.typar_flags.Kind /// Indicates whether a type variable is erased in compiled .NET IL code, i.e. whether it is a unit-of-measure variable - member x.IsErased = match x.Kind with TyparKind.Type -> false | _ -> true + member x.IsErased = match x.Kind with TyparKind.Type -> false | _ -> true /// The declared attributes of the type parameter. Empty for type inference variables and parameters from .NET - member x.Attribs = + member x.Attribs = match x.typar_opt_data with | Some optData -> optData.typar_attribs | _ -> [] - member x.SetAttribs attribs = + member x.SetAttribs attribs = match attribs, x.typar_opt_data with | [], None -> () | [], Some { typar_il_name = None; typar_xmldoc = XmlDoc [||]; typar_constraints = [] } -> @@ -2224,17 +2224,17 @@ and | _, Some optData -> optData.typar_attribs <- attribs | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs } - member x.XmlDoc = + member x.XmlDoc = match x.typar_opt_data with | Some optData -> optData.typar_xmldoc | _ -> XmlDoc.Empty - member x.ILName = + member x.ILName = match x.typar_opt_data with | Some optData -> optData.typar_il_name | _ -> None - member x.SetILName il_name = + member x.SetILName il_name = match x.typar_opt_data with | Some optData -> optData.typar_il_name <- il_name | _ -> x.typar_opt_data <- Some { typar_il_name = il_name; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = [] } @@ -2253,7 +2253,7 @@ and /// Creates a type variable that contains empty data, and is not yet linked. Only used during unpickling of F# metadata. - static member NewUnlinked() : Typar = + static member NewUnlinked() : Typar = { typar_id = Unchecked.defaultof<_> typar_flags = Unchecked.defaultof<_> typar_stamp = -1L @@ -2299,25 +2299,25 @@ and member x.SetIdent id = x.typar_id <- id /// Sets the rigidity of a type variable - member x.SetRigidity b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetRigidity b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable is compiler generated - member x.SetCompilerGenerated b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetCompilerGenerated b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable has a static requirement - member x.SetStaticReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, b, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetStaticReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, b, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable is required at runtime - member x.SetDynamicReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b , flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetDynamicReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether the equality constraint of a type definition depends on this type variable - member x.SetEqualityDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b , flags.ComparisonConditionalOn) + member x.SetEqualityDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b, flags.ComparisonConditionalOn) /// Sets whether the comparison constraint of a type definition depends on this type variable member x.SetComparisonDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = x.Name @@ -2325,13 +2325,13 @@ and [] TyparConstraint = /// Indicates a constraint that a type is a subtype of the given type - | CoercesTo of TType * range + | CoercesTo of TType * range /// Indicates a default value for an inference type variable should it be neither generalized nor solved - | DefaultsTo of int * TType * range + | DefaultsTo of int * TType * range /// Indicates a constraint that a type has a 'null' value - | SupportsNull of range + | SupportsNull of range /// Indicates a constraint that a type has a member with the given signature | MayResolveMember of TraitConstraintInfo * range @@ -2339,35 +2339,35 @@ and /// Indicates a constraint that a type is a non-Nullable value type /// These are part of .NET's model of generic constraints, and in order to /// generate verifiable code we must attach them to F# generalized type variables as well. - | IsNonNullableStruct of range + | IsNonNullableStruct of range /// Indicates a constraint that a type is a reference type - | IsReferenceType of range + | IsReferenceType of range /// Indicates a constraint that a type is a simple choice between one of the given ground types. Only arises from 'printf' format strings. See format.fs - | SimpleChoice of TTypes * range + | SimpleChoice of TTypes * range /// Indicates a constraint that a type has a parameterless constructor | RequiresDefaultConstructor of range /// Indicates a constraint that a type is an enum with the given underlying - | IsEnum of TType * range + | IsEnum of TType * range /// Indicates a constraint that a type implements IComparable, with special rules for some known structural container types - | SupportsComparison of range + | SupportsComparison of range /// Indicates a constraint that a type does not have the Equality(false) attribute, or is not a structural type with this attribute, with special rules for some known structural container types - | SupportsEquality of range + | SupportsEquality of range /// Indicates a constraint that a type is a delegate from the given tuple of args to the given return type - | IsDelegate of TType * TType * range + | IsDelegate of TType * TType * range /// Indicates a constraint that a type is .NET unmanaged type - | IsUnmanaged of range + | IsUnmanaged of range // %+A formatting is used, so this is not needed //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -2394,7 +2394,7 @@ and and set v = (let (TTrait(_, _, _, _, _, sln)) = x in sln.Value <- v) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TTrait(" + x.MemberName + ")" @@ -2406,16 +2406,16 @@ and /// FSMethSln(ty, vref, minst) /// /// Indicates a trait is solved by an F# method. - /// ty -- the type and its instantiation - /// vref -- the method that solves the trait constraint + /// ty -- the type and its instantiation + /// vref -- the method that solves the trait constraint /// minst -- the generic method instantiation | FSMethSln of TType * ValRef * TypeInst /// FSRecdFieldSln(tinst, rfref, isSetProp) /// /// Indicates a trait is solved by an F# record field. - /// tinst -- the instantiation of the declaring type - /// rfref -- the reference to the record field + /// tinst -- the instantiation of the declaring type + /// rfref -- the reference to the record field /// isSetProp -- indicates if this is a set of a record field | FSRecdFieldSln of TypeInst * RecdFieldRef * bool @@ -2425,10 +2425,10 @@ and /// ILMethSln(ty, extOpt, ilMethodRef, minst) /// /// Indicates a trait is solved by a .NET method. - /// ty -- the type and its instantiation - /// extOpt -- information about an extension member, if any + /// ty -- the type and its instantiation + /// extOpt -- information about an extension member, if any /// ilMethodRef -- the method that solves the trait constraint - /// minst -- the generic method instantiation + /// minst -- the generic method instantiation | ILMethSln of TType * ILTypeRef option * ILMethodRef * TypeInst /// ClosedExprSln(expr) @@ -2441,7 +2441,7 @@ and // %+A formatting is used, so this is not needed //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -2461,7 +2461,7 @@ and [] TotalArgCount: int } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "ValLinkagePartialKey(" + x.LogicalName + ")" @@ -2478,7 +2478,7 @@ and member x.TypeForLinkage = typeForLinkage [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "ValLinkageFullKey(" + partialKey.LogicalName + ")" @@ -2536,7 +2536,7 @@ and } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "ValOptionalData(...)" @@ -2574,13 +2574,13 @@ and [] val_attribs = [] } /// Range of the definition (implementation) of the value, used by Visual Studio - member x.DefinitionRange = + member x.DefinitionRange = match x.val_opt_data with | Some { val_other_range = Some(m, true) } -> m | _ -> x.val_range /// Range of the definition (signature) of the value, used by Visual Studio - member x.SigRange = + member x.SigRange = match x.val_opt_data with | Some { val_other_range = Some(m, false) } -> m | _ -> x.val_range @@ -2596,19 +2596,19 @@ and [] /// May be a type variable or type containing type variables during type inference. // // Note: this data is mutated during inference by adjustAllUsesOfRecValue when we replace the inferred type with a schema. - member x.Type = x.val_type + member x.Type = x.val_type /// How visible is this value, function or member? - member x.Accessibility = + member x.Accessibility = match x.val_opt_data with | Some optData -> optData.val_access - | _ -> TAccess [] + | _ -> TAccess [] /// The value of a value or member marked with [] - member x.LiteralValue = + member x.LiteralValue = match x.val_opt_data with | Some optData -> optData.val_const - | _ -> None + | _ -> None /// Records the "extra information" for a value compiled as a method. /// @@ -2628,9 +2628,9 @@ and [] member x.ValReprInfo: ValReprInfo option = match x.val_opt_data with | Some optData -> optData.val_repr_info - | _ -> None + | _ -> None - member x.Id = ident(x.LogicalName, x.Range) + member x.Id = ident(x.LogicalName, x.Range) /// Is this represented as a "top level" static binding (i.e. a static field, static member, /// instance member), rather than an "inner" binding that may result in a closure. @@ -2640,7 +2640,7 @@ and [] /// binding to be IsCompiledAsTopLevel. Second, even immediately after type checking we expect /// some non-module, non-member bindings to be marked IsCompiledAsTopLevel, e.g. 'y' in /// 'let x = let y = 1 in y + y' (NOTE: check this, don't take it as gospel) - member x.IsCompiledAsTopLevel = x.ValReprInfo.IsSome + member x.IsCompiledAsTopLevel = x.ValReprInfo.IsSome /// The partial information used to index the methods of all those in a ModuleOrNamespace. member x.GetLinkagePartialKey() : ValLinkagePartialKey = @@ -2657,37 +2657,37 @@ and [] ValLinkageFullKey(key, (if x.IsMember then Some x.Type else None)) /// Is this a member definition or module definition? - member x.IsMemberOrModuleBinding = x.val_flags.IsMemberOrModuleBinding + member x.IsMemberOrModuleBinding = x.val_flags.IsMemberOrModuleBinding /// Indicates if this is an F#-defined extension member - member x.IsExtensionMember = x.val_flags.IsExtensionMember + member x.IsExtensionMember = x.val_flags.IsExtensionMember /// The quotation expression associated with a value given the [] tag - member x.ReflectedDefinition = + member x.ReflectedDefinition = match x.val_opt_data with | Some optData -> optData.val_defn - | _ -> None + | _ -> None /// Is this a member, if so some more data about the member. /// /// Note, the value may still be (a) an extension member or (b) and abstract slot without /// a true body. These cases are often causes of bugs in the compiler. - member x.MemberInfo = + member x.MemberInfo = match x.val_opt_data with | Some optData -> optData.val_member_info - | _ -> None + | _ -> None /// Indicates if this is a member - member x.IsMember = x.MemberInfo.IsSome + member x.IsMember = x.MemberInfo.IsSome /// Indicates if this is a member, excluding extension members - member x.IsIntrinsicMember = x.IsMember && not x.IsExtensionMember + member x.IsIntrinsicMember = x.IsMember && not x.IsExtensionMember /// Indicates if this is an F#-defined value in a module, or an extension member, but excluding compiler generated bindings from optimizations - member x.IsModuleBinding = x.IsMemberOrModuleBinding && not x.IsMember + member x.IsModuleBinding = x.IsMemberOrModuleBinding && not x.IsMember /// Indicates if this is something compiled into a module, i.e. a user-defined value, an extension member or a compiler-generated value - member x.IsCompiledIntoModule = x.IsExtensionMember || x.IsModuleBinding + member x.IsCompiledIntoModule = x.IsExtensionMember || x.IsModuleBinding /// Indicates if this is an F#-defined instance member. /// @@ -2696,25 +2696,25 @@ and [] member x.IsInstanceMember = x.IsMember && x.MemberInfo.Value.MemberFlags.IsInstance /// Indicates if this is an F#-defined 'new' constructor member - member x.IsConstructor = + member x.IsConstructor = match x.MemberInfo with | 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 = + member x.IsClassConstructor = match x.MemberInfo with | 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 = + member x.IsOverrideOrExplicitImpl = match x.MemberInfo with | Some(memberInfo) when memberInfo.MemberFlags.IsOverrideOrExplicitImpl -> true | _ -> false /// Indicates if this is declared 'mutable' - member x.IsMutable = (match x.val_flags.MutabilityInfo with Immutable -> false | Mutable -> true) + member x.IsMutable = (match x.val_flags.MutabilityInfo with Immutable -> false | Mutable -> true) /// Indicates if this is inferred to be a method or function that definitely makes no critical tailcalls? member x.MakesNoCriticalTailcalls = x.val_flags.MakesNoCriticalTailcalls @@ -2735,70 +2735,70 @@ and [] member x.PermitsExplicitTypeInstantiation = x.val_flags.PermitsExplicitTypeInstantiation /// Indicates if this is a member generated from the de-sugaring of 'let' function bindings in the implicit class syntax? - member x.IsIncrClassGeneratedMember = x.IsCompilerGenerated && x.val_flags.IsIncrClassSpecialMember + member x.IsIncrClassGeneratedMember = x.IsCompilerGenerated && x.val_flags.IsIncrClassSpecialMember /// Indicates if this is a constructor member generated from the de-sugaring of implicit constructor for a class type? member x.IsIncrClassConstructor = x.IsConstructor && x.val_flags.IsIncrClassSpecialMember /// Get the information about the value used during type inference - member x.RecursiveValInfo = x.val_flags.RecursiveValInfo + member x.RecursiveValInfo = x.val_flags.RecursiveValInfo /// Indicates if this is a 'base' or 'this' value? - member x.BaseOrThisInfo = x.val_flags.BaseOrThisInfo + member x.BaseOrThisInfo = x.val_flags.BaseOrThisInfo // Indicates if this value was declared to be a type function, e.g. "let f<'a> = typeof<'a>" - member x.IsTypeFunction = x.val_flags.IsTypeFunction + member x.IsTypeFunction = x.val_flags.IsTypeFunction /// Get the inline declaration on the value - member x.InlineInfo = x.val_flags.InlineInfo + member x.InlineInfo = x.val_flags.InlineInfo /// Indicates whether the inline declaration for the value indicate that the value must be inlined? - member x.MustInline = x.InlineInfo.MustInline + member x.MustInline = x.InlineInfo.MustInline /// Indicates whether this value was generated by the compiler. /// /// Note: this is true for the overrides generated by hash/compare augmentations - member x.IsCompilerGenerated = x.val_flags.IsCompilerGenerated + member x.IsCompilerGenerated = x.val_flags.IsCompilerGenerated /// Get the declared attributes for the value - member x.Attribs = + member x.Attribs = match x.val_opt_data with | Some optData -> optData.val_attribs - | _ -> [] + | _ -> [] /// Get the declared documentation for the value - member x.XmlDoc = + member x.XmlDoc = match x.val_opt_data with | Some optData -> optData.val_xmldoc - | _ -> XmlDoc.Empty + | _ -> XmlDoc.Empty ///Get the signature for the value's XML documentation member x.XmlDocSig with get() = match x.val_opt_data with | Some optData -> optData.val_xmldocsig - | _ -> String.Empty + | _ -> String.Empty 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 } + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_xmldocsig = v } /// The parent type or module, if any (None for expression bindings and parameters) - member x.DeclaringEntity = + member x.DeclaringEntity = match x.val_opt_data with | Some optData -> optData.val_declaring_entity - | _ -> ParentNone + | _ -> ParentNone /// Get the actual parent entity for the value (a module or a type), i.e. the entity under which the /// value will appear in compiled code. For extension members this is the module where the extension member /// is declared. member x.TopValDeclaringEntity = - match x.DeclaringEntity with + match x.DeclaringEntity with | Parent tcref -> tcref | ParentNone -> error(InternalError("TopValDeclaringEntity: does not have a parent", x.Range)) member x.HasDeclaringEntity = - match x.DeclaringEntity with + match x.DeclaringEntity with | Parent _ -> true | ParentNone -> false @@ -2833,8 +2833,8 @@ and [] // - in check.fs: as a boolean to detect public values for saving quotations // - in ilxgen.fs: as a boolean to detect public values for saving quotations // - in MakeExportRemapping, to build non-local references for values - member x.PublicPath = - match x.DeclaringEntity with + member x.PublicPath = + match x.DeclaringEntity with | Parent eref -> match eref.PublicPath with | None -> None @@ -2881,7 +2881,7 @@ and [] member x.ValCompiledName = match x.val_opt_data with | Some optData -> optData.val_compiled_name - | _ -> None + | _ -> None /// The name of the method in compiled code (with some exceptions where ilxgen.fs decides not to use a method impl) /// - If this is a property then this is 'get_Foo' or 'set_Foo' @@ -2907,7 +2907,7 @@ and [] // let dt = System.DateTime.Now - System.DateTime.Now // IsMemberOrModuleBinding = false, IsCompiledAsTopLevel = true, IsMember = false, CompilerGenerated=true // // However we don't need this for CompilerGenerated members such as the implementations of IComparable - if x.IsCompiledAsTopLevel && not x.IsMember && (x.IsCompilerGenerated || not x.IsMemberOrModuleBinding) then + if x.IsCompiledAsTopLevel && not x.IsMember && (x.IsCompilerGenerated || not x.IsMemberOrModuleBinding) then globalStableNameGenerator.GetUniqueCompilerGeneratedName(givenName, x.Range, x.Stamp) else givenName @@ -2916,7 +2916,7 @@ and [] /// - If this is a property then this is 'Foo' /// - If this is an implementation of an abstract slot then this is the name of the property implemented by the abstract slot member x.PropertyName = - let logicalName = x.LogicalName + let logicalName = x.LogicalName ChopPropertyName logicalName /// The name of the method. @@ -2941,58 +2941,58 @@ and [] member x.DisplayName = DemangleOperatorName x.CoreDisplayName - member x.SetValRec b = x.val_flags <- x.val_flags.WithRecursiveValInfo b + member x.SetValRec b = x.val_flags <- x.val_flags.WithRecursiveValInfo b - member x.SetIsMemberOrModuleBinding() = x.val_flags <- x.val_flags.WithIsMemberOrModuleBinding + member x.SetIsMemberOrModuleBinding() = x.val_flags <- x.val_flags.WithIsMemberOrModuleBinding - member x.SetMakesNoCriticalTailcalls() = x.val_flags <- x.val_flags.WithMakesNoCriticalTailcalls + member x.SetMakesNoCriticalTailcalls() = x.val_flags <- x.val_flags.WithMakesNoCriticalTailcalls - member x.SetHasBeenReferenced() = x.val_flags <- x.val_flags.WithHasBeenReferenced + member x.SetHasBeenReferenced() = x.val_flags <- x.val_flags.WithHasBeenReferenced member x.SetIsCompiledAsStaticPropertyWithoutField() = x.val_flags <- x.val_flags.WithIsCompiledAsStaticPropertyWithoutField - member x.SetIsFixed() = x.val_flags <- x.val_flags.WithIsFixed + member x.SetIsFixed() = x.val_flags <- x.val_flags.WithIsFixed - member x.SetValReprInfo info = + member x.SetValReprInfo info = match x.val_opt_data with | Some optData -> optData.val_repr_info <- info - | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_repr_info = info } + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_repr_info = info } - member x.SetType ty = x.val_type <- ty + member x.SetType ty = x.val_type <- ty - member x.SetOtherRange m = + member x.SetOtherRange m = match x.val_opt_data with | Some optData -> optData.val_other_range <- Some m - | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_other_range = Some m } + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_other_range = Some m } - member x.SetDeclaringEntity parent = + member x.SetDeclaringEntity parent = match x.val_opt_data with | Some optData -> optData.val_declaring_entity <- parent - | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_declaring_entity = parent } + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_declaring_entity = parent } - member x.SetAttribs attribs = + member x.SetAttribs attribs = match x.val_opt_data with | Some optData -> optData.val_attribs <- attribs - | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_attribs = attribs } + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_attribs = attribs } - member x.SetMemberInfo member_info = + member x.SetMemberInfo member_info = match x.val_opt_data with | Some optData -> optData.val_member_info <- Some member_info - | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_member_info = Some member_info } + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_member_info = Some member_info } - member x.SetValDefn val_defn = + member x.SetValDefn val_defn = match x.val_opt_data with | Some optData -> optData.val_defn <- Some val_defn - | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_defn = Some val_defn } + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_defn = Some val_defn } /// Create a new value with empty, unlinked data. Only used during unpickling of F# metadata. - static member NewUnlinked() : Val = - { val_logical_name = Unchecked.defaultof<_> - val_range = Unchecked.defaultof<_> - val_type = Unchecked.defaultof<_> - val_stamp = Unchecked.defaultof<_> - val_flags = Unchecked.defaultof<_> - val_opt_data = Unchecked.defaultof<_> } + static member NewUnlinked() : Val = + { val_logical_name = Unchecked.defaultof<_> + val_range = Unchecked.defaultof<_> + val_type = Unchecked.defaultof<_> + val_stamp = Unchecked.defaultof<_> + val_flags = Unchecked.defaultof<_> + val_opt_data = Unchecked.defaultof<_> } /// Create a new value with the given backing data. Only used during unpickling of F# metadata. @@ -3003,11 +3003,11 @@ and [] /// Set all the data on a value member x.SetData (tg: ValData) = - x.val_logical_name <- tg.val_logical_name - x.val_range <- tg.val_range - x.val_type <- tg.val_type - x.val_stamp <- tg.val_stamp - x.val_flags <- tg.val_flags + x.val_logical_name <- tg.val_logical_name + x.val_range <- tg.val_range + x.val_type <- tg.val_type + x.val_stamp <- tg.val_stamp + x.val_flags <- tg.val_flags match tg.val_opt_data with | Some tg -> x.val_opt_data <- @@ -3028,7 +3028,7 @@ and [] member x.IsLinked = match box x.val_logical_name with null -> false | _ -> true [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = x.LogicalName @@ -3043,13 +3043,13 @@ and /// Updated with the full implemented slotsig after interface implementation relation is checked mutable ImplementedSlotSigs: SlotSig list - /// Gets updated with 'true' if an abstract slot is implemented in the file being typechecked. Internal only. + /// Gets updated with 'true' if an abstract slot is implemented in the file being typechecked. Internal only. mutable IsImplemented: bool MemberFlags: MemberFlags } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "ValMemberInfo(...)" @@ -3077,18 +3077,18 @@ and and [] - ValPublicPath = + ValPublicPath = | ValPubPath of PublicPath * ValLinkageFullKey [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override __.ToString() = sprintf "ValPubPath(...)" /// Index into the namespace/module structure of a particular CCU and [] - NonLocalEntityRef = + NonLocalEntityRef = | NonLocalEntityRef of CcuThunk * string[] /// Try to find the entity corresponding to the given path in the given CCU @@ -3149,7 +3149,7 @@ and assert (j >= 0) assert (j <= path.Length - 1) let matched = - [ for resolver in resolvers do + [ for resolver in resolvers do let moduleOrNamespace = if j = 0 then null else path.[0..j-1] let typename = path.[j] let resolution = ExtensionTyping.TryLinkProvidedType(resolver, moduleOrNamespace, typename, m) @@ -3162,7 +3162,7 @@ and // Inject namespaces until we're an position j, and then inject the type. // Note: this is similar to code in CompileOps.fs let rec injectNamespacesFromIToJ (entity: Entity) k = - if k = j then + if k = j then let newEntity = Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m) entity.ModuleOrNamespaceType.AddProvidedTypeEntity(newEntity) newEntity @@ -3202,7 +3202,7 @@ and if ccu.IsUnresolvedReference then ValueNone else - match NonLocalEntityRef.TryDerefEntityPath(ccu, path, 0, ccu.Contents) with + match NonLocalEntityRef.TryDerefEntityPath(ccu, path, 0, ccu.Contents) with | ValueSome _ as r -> r | ValueNone -> // OK, the lookup failed. Check if we can redirect through a type forwarder on this assembly. @@ -3256,7 +3256,7 @@ and nleref.Deref.ModuleOrNamespaceType [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = x.DisplayName @@ -3379,79 +3379,79 @@ and member x.TypeReprInfo = x.Deref.TypeReprInfo /// The information about the r.h.s. of an F# exception definition, if any. - member x.ExceptionInfo = x.Deref.ExceptionInfo + member x.ExceptionInfo = x.Deref.ExceptionInfo /// Indicates if the entity represents an F# exception declaration. - member x.IsExceptionDecl = x.Deref.IsExceptionDecl + member x.IsExceptionDecl = x.Deref.IsExceptionDecl /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. /// /// Lazy because it may read metadata, must provide a context "range" in case error occurs reading metadata. - member x.Typars m = x.Deref.Typars m + member x.Typars m = x.Deref.Typars m /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. - member x.TyparsNoRange = x.Deref.TyparsNoRange + member x.TyparsNoRange = x.Deref.TyparsNoRange /// Indicates if this entity is an F# type abbreviation definition - member x.TypeAbbrev = x.Deref.TypeAbbrev + member x.TypeAbbrev = x.Deref.TypeAbbrev /// Indicates if this entity is an F# type abbreviation definition - member x.IsTypeAbbrev = x.Deref.IsTypeAbbrev + member x.IsTypeAbbrev = x.Deref.IsTypeAbbrev /// Get the value representing the accessibility of the r.h.s. of an F# type definition. member x.TypeReprAccessibility = x.Deref.TypeReprAccessibility /// Get the cache of the compiled ILTypeRef representation of this module or type. - member x.CompiledReprCache = x.Deref.CompiledReprCache + member x.CompiledReprCache = x.Deref.CompiledReprCache /// Get a blob of data indicating how this type is nested in other namespaces, modules or types. member x.PublicPath: PublicPath option = x.Deref.PublicPath /// Get the value representing the accessibility of an F# type definition or module. - member x.Accessibility = x.Deref.Accessibility + member x.Accessibility = x.Deref.Accessibility /// Indicates the type prefers the "tycon" syntax for display etc. - member x.IsPrefixDisplay = x.Deref.IsPrefixDisplay + member x.IsPrefixDisplay = x.Deref.IsPrefixDisplay /// Indicates the "tycon blob" is actually a module - member x.IsModuleOrNamespace = x.Deref.IsModuleOrNamespace + member x.IsModuleOrNamespace = x.Deref.IsModuleOrNamespace /// Indicates if the entity is a namespace - member x.IsNamespace = x.Deref.IsNamespace + member x.IsNamespace = x.Deref.IsNamespace /// Indicates if the entity is an F# module definition - member x.IsModule = x.Deref.IsModule + member x.IsModule = x.Deref.IsModule /// Get a blob of data indicating how this type is nested inside other namespaces, modules and types. - member x.CompilationPathOpt = x.Deref.CompilationPathOpt + member x.CompilationPathOpt = x.Deref.CompilationPathOpt #if !NO_EXTENSIONTYPING /// Indicates if the entity is a provided namespace fragment - member x.IsProvided = x.Deref.IsProvided + member x.IsProvided = x.Deref.IsProvided /// Indicates if the entity is a provided namespace fragment - member x.IsProvidedNamespace = x.Deref.IsProvidedNamespace + member x.IsProvidedNamespace = x.Deref.IsProvidedNamespace /// Indicates if the entity is an erased provided type definition - member x.IsProvidedErasedTycon = x.Deref.IsProvidedErasedTycon + member x.IsProvidedErasedTycon = x.Deref.IsProvidedErasedTycon /// Indicates if the entity is an erased provided type definition that incorporates a static instantiation (and therefore in some sense compiler generated) - member x.IsStaticInstantiationTycon = x.Deref.IsStaticInstantiationTycon + member x.IsStaticInstantiationTycon = x.Deref.IsStaticInstantiationTycon /// Indicates if the entity is a generated provided type definition, i.e. not erased. member x.IsProvidedGeneratedTycon = x.Deref.IsProvidedGeneratedTycon #endif /// Get a blob of data indicating how this type is nested inside other namespaces, modules and types. - member x.CompilationPath = x.Deref.CompilationPath + member x.CompilationPath = x.Deref.CompilationPath /// Get a table of fields for all the F#-defined record, struct and class fields in this type definition, including /// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions. - member x.AllFieldTable = x.Deref.AllFieldTable + member x.AllFieldTable = x.Deref.AllFieldTable /// Get an array of fields for all the F#-defined record, struct and class fields in this type definition, including /// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions. - member x.AllFieldsArray = x.Deref.AllFieldsArray + member x.AllFieldsArray = x.Deref.AllFieldsArray /// Get a list of fields for all the F#-defined record, struct and class fields in this type definition, including /// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions. @@ -3471,28 +3471,28 @@ and member x.AllInstanceFieldsAsList = x.Deref.AllInstanceFieldsAsList /// Get a field by index in definition order - member x.GetFieldByIndex n = x.Deref.GetFieldByIndex n + member x.GetFieldByIndex n = x.Deref.GetFieldByIndex n /// Get a field by name. - member x.GetFieldByName n = x.Deref.GetFieldByName n + member x.GetFieldByName n = x.Deref.GetFieldByName n /// Get the union cases and other union-type information for a type, if any - member x.UnionTypeInfo = x.Deref.UnionTypeInfo + member x.UnionTypeInfo = x.Deref.UnionTypeInfo /// Get the union cases for a type, if any - member x.UnionCasesArray = x.Deref.UnionCasesArray + member x.UnionCasesArray = x.Deref.UnionCasesArray /// Get the union cases for a type, if any, as a list - member x.UnionCasesAsList = x.Deref.UnionCasesAsList + member x.UnionCasesAsList = x.Deref.UnionCasesAsList /// Get a union case of a type by name - member x.GetUnionCaseByName n = x.Deref.GetUnionCaseByName n + member x.GetUnionCaseByName n = x.Deref.GetUnionCaseByName n /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. member x.FSharpObjectModelTypeInfo = x.Deref.FSharpObjectModelTypeInfo /// Gets the immediate interface definitions of an F# type definition. Further interfaces may be supported through class and interface inheritance. - member x.ImmediateInterfacesOfFSharpTycon = x.Deref.ImmediateInterfacesOfFSharpTycon + member x.ImmediateInterfacesOfFSharpTycon = x.Deref.ImmediateInterfacesOfFSharpTycon /// Gets the immediate interface types of an F# type definition. Further interfaces may be supported through class and interface inheritance. member x.ImmediateInterfaceTypesOfFSharpTycon = x.Deref.ImmediateInterfaceTypesOfFSharpTycon @@ -3505,19 +3505,19 @@ and /// Note: result is a indexed table, and for each name the results are in reverse declaration order member x.MembersOfFSharpTyconByName = x.Deref.MembersOfFSharpTyconByName - /// Indicates if this is a struct or enum type definition , i.e. a value type definition - member x.IsStructOrEnumTycon = x.Deref.IsStructOrEnumTycon + /// Indicates if this is a struct or enum type definition, i.e. a value type definition + member x.IsStructOrEnumTycon = x.Deref.IsStructOrEnumTycon /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll which uses /// an assembly-code representation for the type, e.g. the primitive array type constructor. - member x.IsAsmReprTycon = x.Deref.IsAsmReprTycon + member x.IsAsmReprTycon = x.Deref.IsAsmReprTycon /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll like 'float<_>' which /// defines a measure type with a relation to an existing non-measure type as a representation. - member x.IsMeasureableReprTycon = x.Deref.IsMeasureableReprTycon + member x.IsMeasureableReprTycon = x.Deref.IsMeasureableReprTycon /// Indicates if the entity is erased, either a measure definition, or an erased provided type definition - member x.IsErased = x.Deref.IsErased + member x.IsErased = x.Deref.IsErased /// Gets any implicit hash/equals (with comparer argument) methods added to an F# record, union or struct type definition. member x.GeneratedHashAndEqualsWithComparerValues = x.Deref.GeneratedHashAndEqualsWithComparerValues @@ -3532,60 +3532,60 @@ and member x.GeneratedHashAndEqualsValues = x.Deref.GeneratedHashAndEqualsValues /// Indicate if this is a type definition backed by Abstract IL metadata. - member x.IsILTycon = x.Deref.IsILTycon + member x.IsILTycon = x.Deref.IsILTycon /// Get the Abstract IL scope, nesting and metadata for this /// type definition, assuming it is backed by Abstract IL metadata. - member x.ILTyconInfo = x.Deref.ILTyconInfo + member x.ILTyconInfo = x.Deref.ILTyconInfo /// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata. - member x.ILTyconRawMetadata = x.Deref.ILTyconRawMetadata + member x.ILTyconRawMetadata = x.Deref.ILTyconRawMetadata /// Indicate if this is a type whose r.h.s. is known to be a union type definition. - member x.IsUnionTycon = x.Deref.IsUnionTycon + member x.IsUnionTycon = x.Deref.IsUnionTycon /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition. - member x.IsRecordTycon = x.Deref.IsRecordTycon + member x.IsRecordTycon = x.Deref.IsRecordTycon /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition member x.IsFSharpObjectModelTycon = x.Deref.IsFSharpObjectModelTycon /// The on-demand analysis about whether the entity has the IsByRefLike attribute - member x.TryIsByRefLike = x.Deref.TryIsByRefLike + member x.TryIsByRefLike = x.Deref.TryIsByRefLike /// Set the on-demand analysis about whether the entity has the IsByRefLike attribute - member x.SetIsByRefLike b = x.Deref.SetIsByRefLike b + member x.SetIsByRefLike b = x.Deref.SetIsByRefLike b /// The on-demand analysis about whether the entity has the IsByRefLike attribute - member x.TryIsReadOnly = x.Deref.TryIsReadOnly + member x.TryIsReadOnly = x.Deref.TryIsReadOnly /// Set the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct - member x.SetIsReadOnly b = x.Deref.SetIsReadOnly b + member x.SetIsReadOnly b = x.Deref.SetIsReadOnly b /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature, /// which in F# is called a 'unknown representation' type). - member x.IsHiddenReprTycon = x.Deref.IsHiddenReprTycon + member x.IsHiddenReprTycon = x.Deref.IsHiddenReprTycon /// Indicates if this is an F#-defined interface type definition - member x.IsFSharpInterfaceTycon = x.Deref.IsFSharpInterfaceTycon + member x.IsFSharpInterfaceTycon = x.Deref.IsFSharpInterfaceTycon /// Indicates if this is an F#-defined delegate type definition - member x.IsFSharpDelegateTycon = x.Deref.IsFSharpDelegateTycon + member x.IsFSharpDelegateTycon = x.Deref.IsFSharpDelegateTycon /// Indicates if this is an F#-defined enum type definition - member x.IsFSharpEnumTycon = x.Deref.IsFSharpEnumTycon + member x.IsFSharpEnumTycon = x.Deref.IsFSharpEnumTycon /// Indicates if this is a .NET-defined enum type definition - member x.IsILEnumTycon = x.Deref.IsILEnumTycon + member x.IsILEnumTycon = x.Deref.IsILEnumTycon /// Indicates if this is an enum type definition - member x.IsEnumTycon = x.Deref.IsEnumTycon + member x.IsEnumTycon = x.Deref.IsEnumTycon - /// Indicates if this is an F#-defined struct or enum type definition , i.e. a value type definition - member x.IsFSharpStructOrEnumTycon = x.Deref.IsFSharpStructOrEnumTycon + /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition + member x.IsFSharpStructOrEnumTycon = x.Deref.IsFSharpStructOrEnumTycon - /// Indicates if this is a .NET-defined struct or enum type definition , i.e. a value type definition - member x.IsILStructOrEnumTycon = x.Deref.IsILStructOrEnumTycon + /// Indicates if this is a .NET-defined struct or enum type definition, i.e. a value type definition + member x.IsILStructOrEnumTycon = x.Deref.IsILStructOrEnumTycon /// Indicates if we have pre-determined that a type definition has a default constructor. member x.PreEstablishedHasDefaultConstructor = x.Deref.PreEstablishedHasDefaultConstructor @@ -3593,18 +3593,18 @@ and /// Indicates if we have pre-determined that a type definition has a self-referential constructor using 'as x' member x.HasSelfReferentialConstructor = x.Deref.HasSelfReferentialConstructor - member x.UnionCasesAsRefList = x.UnionCasesAsList |> List.map x.MakeNestedUnionCaseRef + member x.UnionCasesAsRefList = x.UnionCasesAsList |> List.map x.MakeNestedUnionCaseRef member x.TrueInstanceFieldsAsRefList = x.TrueInstanceFieldsAsList |> List.map x.MakeNestedRecdFieldRef - member x.AllFieldAsRefList = x.AllFieldsAsList |> List.map x.MakeNestedRecdFieldRef + member x.AllFieldAsRefList = x.AllFieldsAsList |> List.map x.MakeNestedRecdFieldRef - member x.MakeNestedRecdFieldRef (rf: RecdField) = RFRef (x, rf.Name) + member x.MakeNestedRecdFieldRef (rf: RecdField) = RFRef (x, rf.Name) - member x.MakeNestedUnionCaseRef (uc: UnionCase) = UCRef (x, uc.Id.idText) + member x.MakeNestedUnionCaseRef (uc: UnionCase) = UCRef (x, uc.Id.idText) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = if x.IsLocalRef then @@ -3614,9 +3614,9 @@ and /// note: ModuleOrNamespaceRef and TyconRef are type equivalent -and ModuleOrNamespaceRef = EntityRef +and ModuleOrNamespaceRef = EntityRef -and TyconRef = EntityRef +and TyconRef = EntityRef /// References are either local or nonlocal and @@ -3640,7 +3640,7 @@ and if obj.ReferenceEquals(vr.binding, null) then let res = let nlr = vr.nlr - let e = nlr.EnclosingEntity.Deref + let e = nlr.EnclosingEntity.Deref let possible = e.ModuleOrNamespaceType.TryLinkVal(nlr.EnclosingEntity.nlr.Ccu, nlr.ItemKey) match possible with | ValueNone -> error (InternalUndefinedItemRef (FSComp.SR.tastUndefinedItemRefVal, e.DisplayNameWithStaticParameters, nlr.AssemblyName, sprintf "%+A" nlr.ItemKey.PartialKey)) @@ -3665,48 +3665,48 @@ and /// The type of the value. May be a TType_forall for a generic value. /// May be a type variable or type containing type variables during type inference. - member x.Type = x.Deref.Type + member x.Type = x.Deref.Type /// Get the type of the value including any generic type parameters - member x.TypeScheme = x.Deref.TypeScheme + member x.TypeScheme = x.Deref.TypeScheme /// Get the type of the value after removing any generic type parameters - member x.TauType = x.Deref.TauType + member x.TauType = x.Deref.TauType - member x.Typars = x.Deref.Typars + member x.Typars = x.Deref.Typars - member x.LogicalName = x.Deref.LogicalName + member x.LogicalName = x.Deref.LogicalName - member x.DisplayName = x.Deref.DisplayName + member x.DisplayName = x.Deref.DisplayName - member x.CoreDisplayName = x.Deref.CoreDisplayName + member x.CoreDisplayName = x.Deref.CoreDisplayName - member x.Range = x.Deref.Range + member x.Range = x.Deref.Range /// Get the value representing the accessibility of an F# type definition or module. - member x.Accessibility = x.Deref.Accessibility + member x.Accessibility = x.Deref.Accessibility /// The parent type or module, if any (None for expression bindings and parameters) - member x.DeclaringEntity = x.Deref.DeclaringEntity + member x.DeclaringEntity = x.Deref.DeclaringEntity /// Get the apparent parent entity for the value, i.e. the entity under with which the /// value is associated. For extension members this is the nominal type the member extends. /// For other values it is just the actual parent. - member x.ApparentEnclosingEntity = x.Deref.ApparentEnclosingEntity + member x.ApparentEnclosingEntity = x.Deref.ApparentEnclosingEntity - member x.DefinitionRange = x.Deref.DefinitionRange + member x.DefinitionRange = x.Deref.DefinitionRange - member x.SigRange = x.Deref.SigRange + member x.SigRange = x.Deref.SigRange /// The value of a value or member marked with [] - member x.LiteralValue = x.Deref.LiteralValue + member x.LiteralValue = x.Deref.LiteralValue - member x.Id = x.Deref.Id + member x.Id = x.Deref.Id /// Get the name of the value, assuming it is compiled as a property. /// - If this is a property then this is 'Foo' /// - If this is an implementation of an abstract slot then this is the name of the property implemented by the abstract slot - member x.PropertyName = x.Deref.PropertyName + member x.PropertyName = x.Deref.PropertyName /// Indicates whether this value represents a property getter. member x.IsPropertyGetterMethod = @@ -3721,61 +3721,61 @@ and | Some (memInfo: ValMemberInfo) -> memInfo.MemberFlags.MemberKind = MemberKind.PropertySet || memInfo.MemberFlags.MemberKind = MemberKind.PropertyGetSet /// A unique stamp within the context of this invocation of the compiler process - member x.Stamp = x.Deref.Stamp + member x.Stamp = x.Deref.Stamp /// Is this represented as a "top level" static binding (i.e. a static field, static member, /// instance member), rather than an "inner" binding that may result in a closure. - member x.IsCompiledAsTopLevel = x.Deref.IsCompiledAsTopLevel + member x.IsCompiledAsTopLevel = x.Deref.IsCompiledAsTopLevel /// Indicates if this member is an F#-defined dispatch slot. - member x.IsDispatchSlot = x.Deref.IsDispatchSlot + member x.IsDispatchSlot = x.Deref.IsDispatchSlot /// The name of the method in compiled code (with some exceptions where ilxgen.fs decides not to use a method impl) - member x.CompiledName = x.Deref.CompiledName + member x.CompiledName = x.Deref.CompiledName /// Get the public path to the value, if any? Should be set if and only if /// IsMemberOrModuleBinding is set. - member x.PublicPath = x.Deref.PublicPath + member x.PublicPath = x.Deref.PublicPath /// The quotation expression associated with a value given the [] tag - member x.ReflectedDefinition = x.Deref.ReflectedDefinition + member x.ReflectedDefinition = x.Deref.ReflectedDefinition /// Indicates if this is an F#-defined 'new' constructor member - member x.IsConstructor = x.Deref.IsConstructor + member x.IsConstructor = x.Deref.IsConstructor /// Indicates if this value was a member declared 'override' or an implementation of an interface slot - member x.IsOverrideOrExplicitImpl = x.Deref.IsOverrideOrExplicitImpl + member x.IsOverrideOrExplicitImpl = x.Deref.IsOverrideOrExplicitImpl /// Is this a member, if so some more data about the member. - member x.MemberInfo = x.Deref.MemberInfo + member x.MemberInfo = x.Deref.MemberInfo /// Indicates if this is a member - member x.IsMember = x.Deref.IsMember + member x.IsMember = x.Deref.IsMember /// Indicates if this is an F#-defined value in a module, or an extension member, but excluding compiler generated bindings from optimizations - member x.IsModuleBinding = x.Deref.IsModuleBinding + member x.IsModuleBinding = x.Deref.IsModuleBinding /// Indicates if this is an F#-defined instance member. /// /// Note, the value may still be (a) an extension member or (b) and abstract slot without /// a true body. These cases are often causes of bugs in the compiler. - member x.IsInstanceMember = x.Deref.IsInstanceMember + member x.IsInstanceMember = x.Deref.IsInstanceMember /// Indicates if this value is declared 'mutable' - member x.IsMutable = x.Deref.IsMutable + member x.IsMutable = x.Deref.IsMutable /// Indicates if this value allows the use of an explicit type instantiation (i.e. does it itself have explicit type arguments, /// or does it have a signature?) - member x.PermitsExplicitTypeInstantiation = x.Deref.PermitsExplicitTypeInstantiation + member x.PermitsExplicitTypeInstantiation = x.Deref.PermitsExplicitTypeInstantiation /// Indicates if this is inferred to be a method or function that definitely makes no critical tailcalls? - member x.MakesNoCriticalTailcalls = x.Deref.MakesNoCriticalTailcalls + member x.MakesNoCriticalTailcalls = x.Deref.MakesNoCriticalTailcalls /// Is this a member definition or module definition? - member x.IsMemberOrModuleBinding = x.Deref.IsMemberOrModuleBinding + member x.IsMemberOrModuleBinding = x.Deref.IsMemberOrModuleBinding /// Indicates if this is an F#-defined extension member - member x.IsExtensionMember = x.Deref.IsExtensionMember + member x.IsExtensionMember = x.Deref.IsExtensionMember /// Indicates if this is a constructor member generated from the de-sugaring of implicit constructor for a class type? member x.IsIncrClassConstructor = x.Deref.IsIncrClassConstructor @@ -3784,55 +3784,55 @@ and member x.IsIncrClassGeneratedMember = x.Deref.IsIncrClassGeneratedMember /// Get the information about a recursive value used during type inference - member x.RecursiveValInfo = x.Deref.RecursiveValInfo + member x.RecursiveValInfo = x.Deref.RecursiveValInfo /// Indicates if this is a 'base' or 'this' value? - member x.BaseOrThisInfo = x.Deref.BaseOrThisInfo + member x.BaseOrThisInfo = x.Deref.BaseOrThisInfo // Indicates if this value was declared to be a type function, e.g. "let f<'a> = typeof<'a>" - member x.IsTypeFunction = x.Deref.IsTypeFunction + member x.IsTypeFunction = x.Deref.IsTypeFunction /// Records the "extra information" for a value compiled as a method. /// /// This indicates the number of arguments in each position for a curried function. - member x.ValReprInfo = x.Deref.ValReprInfo + member x.ValReprInfo = x.Deref.ValReprInfo /// Get the inline declaration on the value - member x.InlineInfo = x.Deref.InlineInfo + member x.InlineInfo = x.Deref.InlineInfo /// Indicates whether the inline declaration for the value indicate that the value must be inlined? - member x.MustInline = x.Deref.MustInline + member x.MustInline = x.Deref.MustInline /// Indicates whether this value was generated by the compiler. /// /// Note: this is true for the overrides generated by hash/compare augmentations - member x.IsCompilerGenerated = x.Deref.IsCompilerGenerated + member x.IsCompilerGenerated = x.Deref.IsCompilerGenerated /// Get the declared attributes for the value - member x.Attribs = x.Deref.Attribs + member x.Attribs = x.Deref.Attribs /// Get the declared documentation for the value - member x.XmlDoc = x.Deref.XmlDoc + member x.XmlDoc = x.Deref.XmlDoc /// Get or set the signature for the value's XML documentation - member x.XmlDocSig = x.Deref.XmlDocSig + member x.XmlDocSig = x.Deref.XmlDocSig /// Get the actual parent entity for the value (a module or a type), i.e. the entity under which the /// value will appear in compiled code. For extension members this is the module where the extension member /// is declared. - member x.TopValDeclaringEntity = x.Deref.TopValDeclaringEntity + member x.TopValDeclaringEntity = x.Deref.TopValDeclaringEntity // Can be false for members after error recovery - member x.HasDeclaringEntity = x.Deref.HasDeclaringEntity + member x.HasDeclaringEntity = x.Deref.HasDeclaringEntity /// Get the apparent parent entity for a member - member x.MemberApparentEntity = x.Deref.MemberApparentEntity + member x.MemberApparentEntity = x.Deref.MemberApparentEntity /// Get the number of 'this'/'self' object arguments for the member. Instance extension members return '1'. - member x.NumObjArgs = x.Deref.NumObjArgs + member x.NumObjArgs = x.Deref.NumObjArgs [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = if x.IsLocalRef then x.ResolvedTarget.DisplayName @@ -3892,7 +3892,7 @@ and member x.FieldByIndex n = x.UnionCase.FieldTable.FieldByIndex n [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = x.CaseName @@ -3919,7 +3919,7 @@ and | None -> error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range)) /// Try to dereference the reference - member x.TryRecdField = x.TyconRef.TryDeref |> ValueOptionInternal.bind (fun tcref -> tcref.GetFieldByName x.FieldName |> ValueOptionInternal.ofOption) + member x.TryRecdField = x.TyconRef.TryDeref |> ValueOptionInternal.bind (fun tcref -> tcref.GetFieldByName x.FieldName |> ValueOptionInternal.ofOption) /// Get the attributes associated with the compiled property of the record field member x.PropertyAttribs = x.RecdField.PropertyAttribs @@ -3942,7 +3942,7 @@ and error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range)) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = x.FieldName @@ -3974,14 +3974,14 @@ and /// TType_fun(domainType, rangeType). /// /// Indicates the type is a function type - | TType_fun of TType * TType + | TType_fun of TType * TType /// TType_ucase(unionCaseRef, typeInstantiation) /// /// Indicates the type is a non-F#-visible type representing a "proof" that a union value belongs to a particular union case /// These types are not user-visible and will never appear as an inferred type. They are the types given to /// the temporaries arising out of pattern matching on union values. - | TType_ucase of UnionCaseRef * TypeInst + | TType_ucase of UnionCaseRef * TypeInst /// Indicates the type is a variable type, whether declared, generalized or an inference type parameter | TType_var of Typar @@ -3993,23 +3993,23 @@ and /// See https://github.com/Microsoft/visualfsharp/issues/2561 member x.GetAssemblyName() = match x with - | TType_forall (_tps, ty) -> ty.GetAssemblyName() - | TType_app (tcref, _tinst) -> tcref.CompilationPath.ILScopeRef.QualifiedName + | TType_forall (_tps, ty) -> ty.GetAssemblyName() + | TType_app (tcref, _tinst) -> tcref.CompilationPath.ILScopeRef.QualifiedName | TType_tuple (_tupInfo, _tinst) -> "" | TType_anon (anonInfo, _tinst) -> defaultArg anonInfo.Assembly.QualifiedName "" - | TType_fun (_d, _r) -> "" - | TType_measure _ms -> "" - | TType_var tp -> tp.Solution |> function Some sln -> sln.GetAssemblyName() | None -> "" - | TType_ucase (_uc, _tinst) -> + | TType_fun (_d, _r) -> "" + | TType_measure _ms -> "" + | TType_var tp -> tp.Solution |> function Some sln -> sln.GetAssemblyName() | None -> "" + | TType_ucase (_uc, _tinst) -> let (TILObjectReprData(scope, _nesting, _definition)) = _uc.Tycon.ILTyconInfo scope.QualifiedName [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = match x with - | TType_forall (_tps, ty) -> "forall ... " + ty.ToString() + | TType_forall (_tps, ty) -> "forall ... " + ty.ToString() | TType_app (tcref, tinst) -> tcref.DisplayName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") | TType_tuple (tupInfo, tinst) -> (match tupInfo with @@ -4036,7 +4036,7 @@ and [] AnonRecdTypeInfo = // Mutability for pickling/unpickling only { mutable Assembly: CcuThunk mutable TupInfo: TupInfo - mutable SortedIds: Ident[] + mutable SortedIds: Ident[] mutable Stamp: Stamp mutable SortedNames: string[] } @@ -4044,11 +4044,11 @@ and [] AnonRecdTypeInfo = static member Create(ccu: CcuThunk, tupInfo, ids: Ident[]) = let sortedIds = ids |> Array.sortBy (fun id -> id.idText) // Hash all the data to form a unique stamp - let stamp = + let stamp = sha1HashInt64 [| for c in ccu.AssemblyName do yield byte c; yield byte (int32 c >>> 8) match tupInfo with - | TupInfo.Const b -> yield (if b then 0uy else 1uy) + | TupInfo.Const b -> yield (if b then 0uy else 1uy) for id in sortedIds do for c in id.idText do yield byte c; yield byte (int32 c >>> 8) |] let sortedNames = Array.map textOfId sortedIds @@ -4056,7 +4056,7 @@ and [] AnonRecdTypeInfo = /// Get the ILTypeRef for the generated type implied by the anonymous type member x.ILTypeRef = - let ilTypeName = sprintf "<>f__AnonymousType%s%u`%d'" (match x.TupInfo with TupInfo.Const b -> if b then "1000" else "") (uint32 x.Stamp) x.SortedIds.Length + let ilTypeName = sprintf "<>f__AnonymousType%s%u`%d'" (match x.TupInfo with TupInfo.Const b -> if b then "1000" else "") (uint32 x.Stamp) x.SortedIds.Length mkILTyRef(x.Assembly.ILScopeRef, ilTypeName) static member NewUnlinked() : AnonRecdTypeInfo = @@ -4064,7 +4064,7 @@ and [] AnonRecdTypeInfo = TupInfo = Unchecked.defaultof<_> SortedIds = Unchecked.defaultof<_> Stamp = Unchecked.defaultof<_> - SortedNames = Unchecked.defaultof<_> } + SortedNames = Unchecked.defaultof<_> } member x.Link d = let sortedNames = Array.map textOfId d.SortedIds @@ -4103,7 +4103,7 @@ and // %+A formatting is used, so this is not needed //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -4159,32 +4159,32 @@ and TypeForwarders: CcuTypeForwarderTable } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = sprintf "CcuData(%A)" x.FileName /// Represents a table of .NET CLI type forwarders for an assembly and CcuTypeForwarderTable = Map> -and CcuReference = string // ILAssemblyRef +and CcuReference = string // ILAssemblyRef /// A relinkable handle to the contents of a compilation unit. Relinking is performed by mutation. // /// A compilation unit is, more or less, the new material created in one -/// invocation of the compiler. Due to static linking assemblies may hold more +/// invocation of the compiler. Due to static linking assemblies may hold more /// than one compilation unit (i.e. when two assemblies are merged into a compilation -/// the resulting assembly will contain 3 CUs). Compilation units are also created for referenced +/// the resulting assembly will contain 3 CUs). Compilation units are also created for referenced /// .NET assemblies. /// /// References to items such as type constructors are via /// cross-compilation-unit thunks, which directly reference the data structures that define -/// these modules. Thus, when saving out values to disk we only wish -/// to save out the "current" part of the term graph. When reading values +/// these modules. Thus, when saving out values to disk we only wish +/// to save out the "current" part of the term graph. When reading values /// back in we "fixup" the links to previously referenced modules. /// /// All non-local accesses to the data structures are mediated -/// by ccu-thunks. Ultimately, a ccu-thunk is either a (named) element of +/// by ccu-thunks. Ultimately, a ccu-thunk is either a (named) element of /// the data structure, or it is a delayed fixup, i.e. an invalid dangling /// reference that has not had an appropriate fixup applied. and @@ -4199,7 +4199,7 @@ and /// must be in the explicit references in the project. mutable orphanfixup: bool - name: CcuReference } + name: CcuReference } member ccu.Deref = if isNull (ccu.target :> obj) || ccu.orphanfixup then @@ -4219,23 +4219,23 @@ and with get() = ccu.Deref.UsesFSharp20PlusQuotations and set v = ccu.Deref.UsesFSharp20PlusQuotations <- v - member ccu.AssemblyName = ccu.name + member ccu.AssemblyName = ccu.name /// Holds the data indicating how this assembly/module is referenced from the code being compiled. - member ccu.ILScopeRef = ccu.Deref.ILScopeRef + member ccu.ILScopeRef = ccu.Deref.ILScopeRef /// A unique stamp for this DLL - member ccu.Stamp = ccu.Deref.Stamp + member ccu.Stamp = ccu.Deref.Stamp /// Holds the filename for the DLL, if any - member ccu.FileName = ccu.Deref.FileName + member ccu.FileName = ccu.Deref.FileName - /// Try to get the .NET Assembly, if known. May not be present for `IsFSharp` for in-memory cross-project references - member ccu.TryGetILModuleDef() = ccu.Deref.TryGetILModuleDef() + /// Try to get the .NET Assembly, if known. May not be present for `IsFSharp` for in-memory cross-project references + member ccu.TryGetILModuleDef() = ccu.Deref.TryGetILModuleDef() #if !NO_EXTENSIONTYPING /// Is the CCu an EST injected assembly - member ccu.IsProviderGenerated = ccu.Deref.IsProviderGenerated + member ccu.IsProviderGenerated = ccu.Deref.IsProviderGenerated /// Used to make 'forward' calls into the loader during linking member ccu.ImportProvidedType ty: TType = ccu.Deref.ImportProvidedType ty @@ -4243,20 +4243,20 @@ and #endif /// The fully qualified assembly reference string to refer to this assembly. This is persisted in quotations - member ccu.QualifiedName = ccu.Deref.QualifiedName + member ccu.QualifiedName = ccu.Deref.QualifiedName /// A hint as to where does the code for the CCU live (e.g what was the tcConfig.implicitIncludeDir at compilation time for this DLL?) member ccu.SourceCodeDirectory = ccu.Deref.SourceCodeDirectory /// Indicates that this DLL was compiled using the F# compiler and has F# metadata - member ccu.IsFSharp = ccu.Deref.IsFSharp + member ccu.IsFSharp = ccu.Deref.IsFSharp /// A handle to the full specification of the contents of the module contained in this ccu // NOTE: may contain transient state during typechecking - member ccu.Contents = ccu.Deref.Contents + member ccu.Contents = ccu.Deref.Contents /// The table of type forwarders for this assembly - member ccu.TypeForwarders: Map> = ccu.Deref.TypeForwarders + member ccu.TypeForwarders: Map> = ccu.Deref.TypeForwarders /// The table of modules and namespaces at the "root" of the assembly member ccu.RootModulesAndNamespaces = ccu.Contents.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions @@ -4268,13 +4268,13 @@ and static member Create(nm, x) = { target = x orphanfixup = false - name = nm } + name = nm } /// Create a CCU with the given name but where the contents have not yet been specified static member CreateDelayed(nm) = { target = Unchecked.defaultof<_> orphanfixup = false - name = nm } + name = nm } /// Fixup a CCU to have the given contents member x.Fixup(avail: CcuThunk) = @@ -4282,8 +4282,8 @@ and match box x.target with | null -> () | _ -> - // In the IDE we tolerate a double-fixup of FSHarp.Core when editing the FSharp.Core project itself - if x.AssemblyName <> "FSharp.Core" then + // In the IDE we tolerate a double-fixup of FSHarp.Core when editing the FSharp.Core project itself + if x.AssemblyName <> "FSharp.Core" then errorR(Failure("internal error: Fixup: the ccu thunk for assembly "+x.AssemblyName+" not delayed!")) assert (avail.AssemblyName = x.AssemblyName) @@ -4299,7 +4299,7 @@ and | _ -> errorR(Failure("internal error: FixupOrphaned: the ccu thunk for assembly "+x.AssemblyName+" not delayed!")) /// 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 = + member ccu.TryForward(nlpath: string[], item: string) : EntityRef option = ccu.EnsureDerefable(nlpath) let key = nlpath, item match ccu.TypeForwarders.TryGetValue key with @@ -4312,7 +4312,7 @@ and ccu.Deref.MemberSignatureEquality ty1 ty2 [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override ccu.ToString() = ccu.AssemblyName @@ -4327,7 +4327,7 @@ and | UnresolvedCcu of string [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = match x with ResolvedCcu ccu -> ccu.ToString() | UnresolvedCcu s -> "unresolved " + s @@ -4342,7 +4342,7 @@ and usesQuotations: bool } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override __.ToString() = "PickledCcuInfo(...)" @@ -4366,7 +4366,7 @@ and // %+A formatting is used, so this is not needed //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -4378,7 +4378,7 @@ and | Attrib of TyconRef * AttribKind * AttribExpr list * AttribNamedArg list * bool * AttributeTargets option * range [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() member x.TyconRef = (let (Attrib(tcref, _, _, _, _, _, _)) = x in tcref) @@ -4393,7 +4393,7 @@ and | AttribExpr of Expr * Expr [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = sprintf "AttribExpr(...)" @@ -4404,35 +4404,35 @@ and | AttribNamedArg of (string*TType*bool*AttribExpr) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = sprintf "AttribNamedArg(...)" /// Constants in expressions and [] Const = - | Bool of bool - | SByte of sbyte - | Byte of byte - | Int16 of int16 - | UInt16 of uint16 - | Int32 of int32 - | UInt32 of uint32 - | Int64 of int64 - | UInt64 of uint64 - | IntPtr of int64 - | UIntPtr of uint64 - | Single of single - | Double of double - | Char of char - | String of string - | Decimal of Decimal + | Bool of bool + | SByte of sbyte + | Byte of byte + | Int16 of int16 + | UInt16 of uint16 + | Int32 of int32 + | UInt32 of uint32 + | Int64 of int64 + | UInt64 of uint64 + | IntPtr of int64 + | UIntPtr of uint64 + | Single of single + | Double of double + | Char of char + | String of string + | Decimal of Decimal | Unit | Zero // null/zero-bit-pattern /// Decision trees. Pattern matching has been compiled down to -/// a decision tree by this point. The right-hand-sides (actions) of -/// a decision tree by this point. The right-hand-sides (actions) of +/// a decision tree by this point. The right-hand-sides (actions) of +/// a decision tree by this point. The right-hand-sides (actions) of /// the decision tree are labelled by integers that are unique for that /// particular tree. and @@ -4446,8 +4446,8 @@ and /// must be the address of the expression being tested. /// cases -- The list of tests and their subsequent decision trees /// default -- The default decision tree, if any - /// range -- (precise documentation needed) - | TDSwitch of Expr * DecisionTreeCase list * DecisionTree option * range + /// range -- (precise documentation needed) + | TDSwitch of Expr * DecisionTreeCase list * DecisionTree option * range /// TDSuccess(results, targets) /// @@ -4467,7 +4467,7 @@ and // %+A formatting is used, so this is not needed //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -4484,7 +4484,7 @@ and member x.CaseTree = let (TCase(_, d)) = x in d [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = sprintf "DecisionTreeCase(...)" @@ -4512,16 +4512,16 @@ and /// /// Run the active pattern and bind a successful result to a /// variable in the remaining tree. - /// activePatExpr -- The active pattern function being called, perhaps applied to some active pattern parameters. - /// activePatResTys -- The result types (case types) of the active pattern. + /// activePatExpr -- The active pattern function being called, perhaps applied to some active pattern parameters. + /// activePatResTys -- The result types (case types) of the active pattern. /// activePatIdentity -- The value and the types it is applied to. If there are any active pattern parameters then this is empty. - /// idx -- The case number of the active pattern which the test relates to. + /// idx -- The case number of the active pattern which the test relates to. /// activePatternInfo -- The extracted info for the active pattern. | ActivePatternCase of Expr * TTypes * (ValRef * TypeInst) option * int * ActivePatternInfo // %+A formatting is used, so this is not needed //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -4532,7 +4532,7 @@ and | TTarget of Vals * Expr * SequencePointInfoForTarget [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = sprintf "DecisionTreeTarget(...)" @@ -4546,16 +4546,16 @@ and | TBind of Val * Expr * SequencePointInfoForBinding /// The value being bound - member x.Var = (let (TBind(v, _, _)) = x in v) + member x.Var = (let (TBind(v, _, _)) = x in v) /// The expression the value is being bound to - member x.Expr = (let (TBind(_, e, _)) = x in e) + member x.Expr = (let (TBind(_, e, _)) = x in e) /// The information about whether to emit a sequence point for the binding member x.SequencePointInfo = (let (TBind(_, _, sp)) = x in sp) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = sprintf "TBind(%s, ...)" x.Var.CompiledName @@ -4576,7 +4576,7 @@ and member x.CaseIndex = (let (APElemRef(_, _, n)) = x in n) [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override __.ToString() = "ActivePatternElemRef(...)" @@ -4584,27 +4584,27 @@ and /// than a closure or a local), including argument names, attributes etc. and [] - ValReprInfo = + ValReprInfo = /// ValReprInfo (numTypars, args, result) - | ValReprInfo of TyparReprInfo list * ArgReprInfo list list * ArgReprInfo + | ValReprInfo of TyparReprInfo list * ArgReprInfo list list * ArgReprInfo /// Get the extra information about the arguments for the value - member x.ArgInfos = (let (ValReprInfo(_, args, _)) = x in args) + member x.ArgInfos = (let (ValReprInfo(_, args, _)) = x in args) /// Get the number of curried arguments of the value member x.NumCurriedArgs = (let (ValReprInfo(_, args, _)) = x in args.Length) /// Get the number of type parameters of the value - member x.NumTypars = (let (ValReprInfo(n, _, _)) = x in n.Length) + member x.NumTypars = (let (ValReprInfo(n, _, _)) = x in n.Length) /// Indicates if the value has no arguments - neither type parameters nor value arguments - member x.HasNoArgs = (let (ValReprInfo(n, args, _)) = x in n.IsEmpty && args.IsEmpty) + member x.HasNoArgs = (let (ValReprInfo(n, args, _)) = x in n.IsEmpty && args.IsEmpty) /// Get the number of tupled arguments in each curried argument position - member x.AritiesOfArgs = (let (ValReprInfo(_, args, _)) = x in List.map List.length args) + member x.AritiesOfArgs = (let (ValReprInfo(_, args, _)) = x in List.map List.length args) /// Get the kind of each type parameter - member x.KindsOfTypars = (let (ValReprInfo(n, _, _)) = x in n |> List.map (fun (TyparReprInfo(_, k)) -> k)) + member x.KindsOfTypars = (let (ValReprInfo(n, _, _)) = x in n |> List.map (fun (TyparReprInfo(_, k)) -> k)) /// Get the total number of arguments member x.TotalArgCount = @@ -4620,7 +4620,7 @@ and loop args 0 [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override __.ToString() = "ValReprInfo(...)" @@ -4634,10 +4634,10 @@ and mutable Attribs: Attribs // MUTABILITY: used when propagating names of parameters from signature into the implementation. - mutable Name: Ident option } + mutable Name: Ident option } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override __.ToString() = "ArgReprInfo(...)" @@ -4674,7 +4674,7 @@ and /// arguments, e.g. if compiled as a toplevel static method. | Lambda of Unique * Val option * Val option * Val list * Expr * range * TType - /// Type lambdas. These are used for the r.h.s. of polymorphic 'let' bindings and + /// Type lambdas. These are used for the r.h.s. of polymorphic 'let' bindings and /// for expressions that implement first-class polymorphic values. | TyLambda of Unique * Typars * Expr * range * TType @@ -4694,13 +4694,13 @@ and // Object expressions: A closure that implements an interface or a base type. // The base object type might be a delegate type. | Obj of - (* unique *) Unique * - (* object type *) TType * (* <-- NOTE: specifies type parameters for base type *) - (* base val *) Val option * - (* ctor call *) Expr * - (* overrides *) ObjExprMethod list * - (* extra interfaces *) (TType * ObjExprMethod list) list * - range + unique: Unique * + objTy: TType * (* <-- NOTE: specifies type parameters for base type *) + baseVal: Val option * + ctorCall: Expr * + overrides: ObjExprMethod list * + interfaceImpls: (TType * ObjExprMethod list) list * + range: range /// Matches are a more complicated form of "let" with multiple possible destinations /// and possibly multiple ways to get to each destination. @@ -4725,7 +4725,7 @@ and | Quote of Expr * (ILTypeRef list * TTypes * Exprs * ExprData) option ref * bool * range * TType /// Typechecking residue: Indicates a free choice of typars that arises due to - /// minimization of polymorphism at let-rec bindings. These are + /// minimization of polymorphism at let-rec bindings. These are /// resolved to a concrete instantiation on subsequent rewrites. | TyChoose of Typars * Expr * range @@ -4737,7 +4737,7 @@ and // Prefer to use the default formatting of this union type //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() // //override __.ToString() = "Expr(...)" @@ -4810,7 +4810,7 @@ and | UnionCaseFieldGetAddr of UnionCaseRef * int * readonly: bool /// An operation representing a field-get from a union value. The value is not assumed to have been proven to be of the corresponding union case. - | UnionCaseFieldSet of UnionCaseRef * int + | UnionCaseFieldSet of UnionCaseRef * int /// An operation representing a field-get from an F# exception value. | ExnFieldGet of TyconRef * int @@ -4861,7 +4861,7 @@ and // Prefer to use the default formatting of this union type //[] - //member x.DebugText = x.ToString() + //member x.DebugText = x.ToString() // //override __.ToString() = "TOp(...)" @@ -4905,7 +4905,7 @@ and LValueOperation = /// In C syntax this is: *localv_ptr | LByrefGet - /// In C syntax this is: localv = e , note == *(&localv) = e == LAddrOf; LByrefSet + /// In C syntax this is: localv = e, note == *(&localv) = e == LAddrOf; LByrefSet | LSet /// In C syntax this is: *localv_ptr = e @@ -4958,7 +4958,7 @@ and member x.Id = let (TObjExprMethod(slotsig, _, _, _, _, m)) = x in mkSynId m slotsig.Name [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = sprintf "TObjExprMethod(%s, ...)" x.Id.idText @@ -4971,20 +4971,20 @@ and | TSlotSig of string * TType * Typars * Typars * SlotParam list list * TType option - member ss.Name = let (TSlotSig(nm, _, _, _, _, _)) = ss in nm + member ss.Name = let (TSlotSig(nm, _, _, _, _, _)) = ss in nm - member ss.ImplementedType = let (TSlotSig(_, ty, _, _, _, _)) = ss in ty + member ss.ImplementedType = let (TSlotSig(_, ty, _, _, _, _)) = ss in ty - member ss.ClassTypars = let (TSlotSig(_, _, ctps, _, _, _)) = ss in ctps + member ss.ClassTypars = let (TSlotSig(_, _, ctps, _, _, _)) = ss in ctps - member ss.MethodTypars = let (TSlotSig(_, _, _, mtps, _, _)) = ss in mtps + member ss.MethodTypars = let (TSlotSig(_, _, _, mtps, _, _)) = ss in mtps - member ss.FormalParams = let (TSlotSig(_, _, _, _, ps, _)) = ss in ps + member ss.FormalParams = let (TSlotSig(_, _, _, _, ps, _)) = ss in ps member ss.FormalReturnType = let (TSlotSig(_, _, _, _, _, rt)) = ss in rt [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override ss.ToString() = sprintf "TSlotSig(%s, ...)" ss.Name @@ -4994,12 +4994,12 @@ and and [] SlotParam = - | TSlotParam of string option * TType * bool (* in *) * bool (* out *) * bool (* optional *) * Attribs + | TSlotParam of string option * TType * bool (* in *) * bool (* out *) * bool (* optional *) * Attribs member x.Type = let (TSlotParam(_, ty, _, _, _, _)) = x in ty [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TSlotParam(...)" @@ -5017,7 +5017,7 @@ and member x.Type = let (ModuleOrNamespaceExprWithSig(mtyp, _, _)) = x in mtyp [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "ModuleOrNamespaceExprWithSig(...)" @@ -5029,20 +5029,20 @@ and | TMAbstract of ModuleOrNamespaceExprWithSig /// Indicates the module fragment is made of several module fragments in succession - | TMDefs of ModuleOrNamespaceExpr list + | TMDefs of ModuleOrNamespaceExpr list /// Indicates the module fragment is a 'let' definition - | TMDefLet of Binding * range + | TMDefLet of Binding * range /// Indicates the module fragment is an evaluation of expression for side-effects - | TMDefDo of Expr * range + | TMDefDo of Expr * range /// Indicates the module fragment is a 'rec' or 'non-rec' definition of types and modules - | TMDefRec of isRec: bool * Tycon list * ModuleOrNamespaceBinding list * range + | TMDefRec of isRec: bool * Tycon list * ModuleOrNamespaceBinding list * range // %+A formatting is used, so this is not needed //[] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x @@ -5061,7 +5061,7 @@ and ModuleOrNamespaceExpr [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override __.ToString() = "ModuleOrNamespaceBinding(...)" @@ -5074,7 +5074,7 @@ and | TImplFile of QualifiedNameOfFile * ScopedPragma list * ModuleOrNamespaceExprWithSig * bool * bool * StampMap [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TImplFile(...)" @@ -5086,12 +5086,12 @@ and | TypedAssemblyAfterOptimization of (TypedImplFile * (* optimizeDuringCodeGen: *) (Expr -> Expr)) list [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "TypedAssemblyAfterOptimization(...)" //--------------------------------------------------------------------------- -// Freevars. Computed and cached by later phases (never computed type checking). Cached in terms. Not pickled. +// Freevars. Computed and cached by later phases (never computed type checking). Cached in terms. Not pickled. //--------------------------------------------------------------------------- /// Represents a set of free local values. @@ -5128,7 +5128,7 @@ and FreeTypars: FreeTypars } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "FreeTyvars(...)" @@ -5167,12 +5167,12 @@ and FreeTyvars: FreeTyvars } [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "FreeVars(...)" -/// Specifies the compiled representations of type and exception definitions. Basically -/// just an ILTypeRef. Computed and cached by later phases. Stored in +/// Specifies the compiled representations of type and exception definitions. Basically +/// just an ILTypeRef. Computed and cached by later phases. Stored in /// type and exception definitions. Not pickled. Store an optional ILType object for /// non-generic types. and @@ -5201,7 +5201,7 @@ and | ILAsmOpen of ILType [] - member x.DebugText = x.ToString() + member x.DebugText = x.ToString() override x.ToString() = "CompiledTypeRepr(...)" @@ -5238,9 +5238,9 @@ module ValReprInfo = // Basic properties via functions (old style) //--------------------------------------------------------------------------- -let typeOfVal (v: Val) = v.Type +let typeOfVal (v: Val) = v.Type let typesOfVals (v: Val list) = v |> List.map (fun v -> v.Type) -let nameOfVal (v: Val) = v.LogicalName +let nameOfVal (v: Val) = v.LogicalName let arityOfVal (v: Val) = (match v.ValReprInfo with None -> ValReprInfo.emptyValData | Some arities -> arities) let tupInfoRef = TupInfo.Const false @@ -5255,15 +5255,15 @@ let mkRawStructTupleTy tys = TType_tuple (tupInfoStruct, tys) // make up the entire compilation unit //--------------------------------------------------------------------------- -let mapTImplFile f (TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes)) = TImplFile(fragName, pragmas, f moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes) +let mapTImplFile f (TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes)) = TImplFile(fragName, pragmas, f moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes) let mapAccImplFile f z (TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes)) = let moduleExpr, z = f z moduleExpr in TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes), z -let foldTImplFile f z (TImplFile(_, _, moduleExpr, _, _, _)) = f z moduleExpr +let foldTImplFile f z (TImplFile(_, _, moduleExpr, _, _, _)) = f z moduleExpr //--------------------------------------------------------------------------- // Equality relations on locally defined things //--------------------------------------------------------------------------- -let typarEq (lv1: Typar) (lv2: Typar) = (lv1.Stamp = lv2.Stamp) +let typarEq (lv1: Typar) (lv2: Typar) = (lv1.Stamp = lv2.Stamp) /// Equality on type variables, implemented as reference equality. This should be equivalent to using typarEq. let typarRefEq (tp1: Typar) (tp2: Typar) = (tp1 === tp2) @@ -5324,7 +5324,7 @@ type EntityRef with let mkModuleUnionCaseRef (modref: ModuleOrNamespaceRef) tycon uc = (modref.NestedTyconRef tycon).MakeNestedUnionCaseRef uc -let VRefLocal x: ValRef = { binding=x; nlr=Unchecked.defaultof<_> } +let VRefLocal x: ValRef = { binding=x; nlr=Unchecked.defaultof<_> } let VRefNonLocal x: ValRef = { binding=Unchecked.defaultof<_>; nlr=x } @@ -5359,11 +5359,11 @@ let mkTyparTy (tp: Typar) = let copyTypar (tp: Typar) = let optData = tp.typar_opt_data |> Option.map (fun tg -> { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs }) - Typar.New { typar_id = tp.typar_id - typar_flags = tp.typar_flags - typar_stamp = newStamp() + Typar.New { typar_id = tp.typar_id + typar_flags = tp.typar_flags + typar_stamp = newStamp() typar_solution = tp.typar_solution - typar_astype = Unchecked.defaultof<_> + typar_astype = Unchecked.defaultof<_> // Be careful to clone the mutable optional data too typar_opt_data = optData } @@ -5426,13 +5426,13 @@ let stripUnitEqns unt = stripUnitEqnsAux false unt // the item is globally stable ("published") or not. //--------------------------------------------------------------------------- -let mkLocalValRef (v: Val) = VRefLocal v +let mkLocalValRef (v: Val) = VRefLocal v let mkLocalModRef (v: ModuleOrNamespace) = ERefLocal v -let mkLocalEntityRef (v: Entity) = ERefLocal v +let mkLocalEntityRef (v: Entity) = ERefLocal v let mkNonLocalCcuRootEntityRef ccu (x: Entity) = mkNonLocalTyconRefPreResolved x (mkNonLocalEntityRef ccu [| |]) x.LogicalName -let mkNestedValRef (cref: EntityRef) (v: Val) : ValRef = +let mkNestedValRef (cref: EntityRef) (v: Val) : ValRef = match cref with | ERefLocal _ -> mkLocalValRef v | ERefNonLocal nlr -> @@ -5499,7 +5499,7 @@ let fslibRefEq (nlr1: NonLocalEntityRef) (PubPath(path2)) = // This breaks certain invariants that hold elsewhere, because they dereference to point to // Entity's from signatures rather than Entity's from implementations. This means backup, alternative // equality comparison techniques are needed when compiling fslib itself. -let fslibEntityRefEq fslibCcu (eref1: EntityRef) (eref2: EntityRef) = +let fslibEntityRefEq fslibCcu (eref1: EntityRef) (eref2: EntityRef) = match eref1, eref2 with | (ERefNonLocal nlr1, ERefLocal x2) | (ERefLocal x2, ERefNonLocal nlr1) -> @@ -5508,7 +5508,7 @@ let fslibEntityRefEq fslibCcu (eref1: EntityRef) (eref2: EntityRef) = | Some pp2 -> fslibRefEq nlr1 pp2 | None -> false | (ERefLocal e1, ERefLocal e2) -> - match e1.PublicPath , e2.PublicPath with + match e1.PublicPath, e2.PublicPath with | Some pp1, Some pp2 -> pubPathEq pp1 pp2 | _ -> false | _ -> false @@ -5531,7 +5531,7 @@ let fslibValRefEq fslibCcu vref1 vref2 = // This relies on the fact that the compiler doesn't use any references to // entities in fslib that are overloaded, or, if they are overloaded, then value identity // is not significant - nlr1.ItemKey.PartialKey = nm2.PartialKey && + nlr1.ItemKey.PartialKey = nm2.PartialKey && fslibRefEq nlr1.EnclosingEntity.nlr pp2 | _ -> false @@ -5568,7 +5568,7 @@ let primEntityRefEq compilingFslib fslibCcu (x: EntityRef) (y: EntityRef) = let primUnionCaseRefEq compilingFslib fslibCcu (UCRef(tcr1, c1) as uc1) (UCRef(tcr2, c2) as uc2) = uc1 === uc2 || (primEntityRefEq compilingFslib fslibCcu tcr1 tcr2 && c1 = c2) -/// Primitive routine to compare two ValRef's for equality. On the whole value identity is not particularly +/// Primitive routine to compare two ValRef's for equality. On the whole value identity is not particularly /// significant in F#. However it is significant for /// (a) Active Patterns /// (b) detecting uses of "special known values" from FSharp.Core.dll, such as 'seq' @@ -5593,12 +5593,12 @@ let primValRefEq compilingFslib fslibCcu (x: ValRef) (y: ValRef) = //--------------------------------------------------------------------------- let fullCompPathOfModuleOrNamespace (m: ModuleOrNamespace) = - let (CompPath(scoref, cpath)) = m.CompilationPath + let (CompPath(scoref, cpath)) = m.CompilationPath CompPath(scoref, cpath@[(m.LogicalName, m.ModuleOrNamespaceType.ModuleOrNamespaceKind)]) // Can cpath2 be accessed given a right to access cpath1. That is, is cpath2 a nested type or namespace of cpath1. Note order of arguments. let inline canAccessCompPathFrom (CompPath(scoref1, cpath1)) (CompPath(scoref2, cpath2)) = - let rec loop p1 p2 = + let rec loop p1 p2 = match p1, p2 with | (a1, k1)::rest1, (a2, k2)::rest2 -> (a1=a2) && (k1=k2) && loop rest1 rest2 | [], _ -> true @@ -5614,7 +5614,7 @@ let canAccessFrom (TAccess x) cpath = let canAccessFromEverywhere (TAccess x) = x.IsEmpty let canAccessFromSomewhere (TAccess _) = true -let isLessAccessible (TAccess aa) (TAccess bb) = +let isLessAccessible (TAccess aa) (TAccess bb) = not (aa |> List.forall(fun a -> bb |> List.exists (fun b -> canAccessCompPathFrom a b))) /// Given (newPath, oldPath) replace oldPath by newPath in the TAccess. @@ -5641,7 +5641,7 @@ let MakeUnionCasesTable ucs: TyconUnionCases = let MakeRecdFieldsTable ucs: TyconRecdFields = { FieldsByIndex = Array.ofList ucs - FieldsByName = ucs |> NameMap.ofKeyedList (fun rfld -> rfld.Name) } + FieldsByName = ucs |> NameMap.ofKeyedList (fun rfld -> rfld.Name) } let MakeUnionCases ucs: TyconUnionData = @@ -5700,7 +5700,7 @@ let NewExn cpath (id: Ident) access repr attribs doc = | _ -> Some { Entity.NewEmptyEntityOptData() with entity_xmldoc = doc; entity_accessiblity = access; entity_tycon_repr_accessibility = access; entity_exn_info = repr } } /// Create a new TAST RecdField node for an F# class, struct or record field -let NewRecdField stat konst id nameGenerated ty isMutable isVolatile pattribs fattribs docOption access secret = +let NewRecdField stat konst id nameGenerated ty isMutable isVolatile pattribs fattribs docOption access secret = { rfield_mutable=isMutable rfield_pattribs=pattribs rfield_fattribs=fattribs @@ -5764,24 +5764,24 @@ let NewVal let stamp = newStamp() Val.New - { val_stamp = stamp + { val_stamp = stamp val_logical_name = logicalName - val_range = m - val_flags = ValFlags(recValInfo, baseOrThis, isCompGen, inlineInfo, isMutable, isModuleOrMemberBinding, isExtensionMember, isIncrClassSpecialMember, isTyFunc, allowTypeInst, isGeneratedEventVal) - val_type = ty - val_opt_data = + val_range = m + val_flags = ValFlags(recValInfo, baseOrThis, isCompGen, inlineInfo, isMutable, isModuleOrMemberBinding, isExtensionMember, isIncrClassSpecialMember, isTyFunc, allowTypeInst, isGeneratedEventVal) + val_type = ty + val_opt_data = match compiledName, arity, konst, access, doc, specialRepr, actualParent, attribs with | None, None, None, TAccess [], XmlDoc [||], None, ParentNone, [] -> None | _ -> Some { Val.NewEmptyValOptData() with - val_compiled_name = (match compiledName with Some v when v <> logicalName -> compiledName | _ -> None) - val_repr_info = arity - val_const = konst - val_access = access - val_xmldoc = doc - val_member_info = specialRepr + val_compiled_name = (match compiledName with Some v when v <> logicalName -> compiledName | _ -> None) + val_repr_info = arity + val_const = konst + val_access = access + val_xmldoc = doc + val_member_info = specialRepr val_declaring_entity = actualParent - val_attribs = attribs } + val_attribs = attribs } } @@ -5799,7 +5799,7 @@ let NewCcuContents sref m nm mty = /// We pass the new tycon to 'f' in case it needs to reparent the /// contents of the tycon. let NewModifiedTycon f (orig: Tycon) = - let data = { orig with entity_stamp = newStamp() } + let data = { orig with entity_stamp = newStamp() } Tycon.New "NewModifiedTycon" (f data) /// Create a module Tycon based on an existing one using the function 'f'. @@ -5817,8 +5817,8 @@ let NewModifiedVal f (orig: Val) = let data' = f { orig with val_stamp=stamp } Val.New data' -let NewClonedModuleOrNamespace orig = NewModifiedModuleOrNamespace (fun mty -> mty) orig -let NewClonedTycon orig = NewModifiedTycon (fun d -> d) orig +let NewClonedModuleOrNamespace orig = NewModifiedModuleOrNamespace (fun mty -> mty) orig +let NewClonedTycon orig = NewModifiedTycon (fun d -> d) orig //------------------------------------------------------------------------------ @@ -5828,8 +5828,8 @@ let CombineCcuContentFragments m l = /// Combine module types when multiple namespace fragments contribute to the /// same namespace, making new module specs as we go. - let rec CombineModuleOrNamespaceTypes path m (mty1: ModuleOrNamespaceType) (mty2: ModuleOrNamespaceType) = - match mty1.ModuleOrNamespaceKind, mty2.ModuleOrNamespaceKind with + let rec CombineModuleOrNamespaceTypes path m (mty1: ModuleOrNamespaceType) (mty2: ModuleOrNamespaceType) = + match mty1.ModuleOrNamespaceKind, mty2.ModuleOrNamespaceKind with | Namespace, Namespace -> let kind = mty1.ModuleOrNamespaceKind let tab1 = mty1.AllEntitiesByLogicalMangledName diff --git a/tests/scripts/codingConventions.fsx b/tests/scripts/codingConventions.fsx index 46ddf3804d6..9f5a997e020 100644 --- a/tests/scripts/codingConventions.fsx +++ b/tests/scripts/codingConventions.fsx @@ -101,3 +101,19 @@ let spaceBeforeColon = printfn "Top files that have extra space before colon:\n%A" (Array.truncate 10 spaceBeforeColon) +printfn "------ Internal spacing----------" + + +let internalSpacing = + let re = Regex("[^ ] [^ ]") + 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 internal spacing in lines:\n%A" (Array.truncate 10 internalSpacing) +