From 51a19b9a8bb0a4b5851b3e5d93005ddf8a38d891 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 25 Sep 2017 21:37:05 +0100 Subject: [PATCH 1/4] fix assembly reference --- .../Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vsintegration/Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj b/vsintegration/Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj index 3b9fad0cd90..c0bd76dc751 100644 --- a/vsintegration/Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj +++ b/vsintegration/Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj @@ -324,8 +324,8 @@ False $(FSharpSourcesRoot)\..\packages\Newtonsoft.Json.10.0.2\lib\net45\Newtonsoft.Json.dll - - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.3.1\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll From 9d07802789bdce6d9cf7474ea1cbb88e88b917f1 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 3 Oct 2017 21:50:27 +0100 Subject: [PATCH 2/4] whitespace and comments --- src/absil/ilascii.fs | 36 +- src/absil/ilprint.fs | 10 +- src/absil/ilread.fs | 984 ++++++++++++++--------------- src/absil/ilreflect.fs | 889 +++++++++++++------------- src/absil/ilwrite.fs | 692 ++++++++++---------- src/absil/ilx.fs | 44 +- src/fsharp/ErrorLogger.fs | 91 ++- src/fsharp/ErrorResolutionHints.fs | 10 +- src/fsharp/PrettyNaming.fs | 279 ++++---- src/fsharp/range.fs | 24 +- 10 files changed, 1551 insertions(+), 1508 deletions(-) diff --git a/src/absil/ilascii.fs b/src/absil/ilascii.fs index d3c0bd5b00b..763235afa19 100644 --- a/src/absil/ilascii.fs +++ b/src/absil/ilascii.fs @@ -149,9 +149,9 @@ let wordsOfNoArgInstr, isNoArgInstr = let t = lazy (let t = HashMultiMap(300, HashIdentity.Structural) - noArgInstrs |> Lazy.force |> List.iter (fun (x,mk) -> t.Add(mk,x)) ; + noArgInstrs |> Lazy.force |> List.iter (fun (x, mk) -> t.Add(mk, x)) ; t) - (fun s -> (Lazy.force t).[s]), + (fun s -> (Lazy.force t).[s]), (fun s -> (Lazy.force t).ContainsKey s) #endif @@ -159,8 +159,8 @@ let wordsOfNoArgInstr, isNoArgInstr = // Instructions are preceded by prefixes, e.g. ".tail" etc. // -------------------------------------------------------------------- -let mk_stind (nm,dt) = (nm, (fun () -> I_stind(Aligned,Nonvolatile,dt))) -let mk_ldind (nm,dt) = (nm, (fun () -> I_ldind(Aligned,Nonvolatile,dt))) +let mk_stind (nm, dt) = (nm, (fun () -> I_stind(Aligned, Nonvolatile, dt))) +let mk_ldind (nm, dt) = (nm, (fun () -> I_ldind(Aligned, Nonvolatile, dt))) // -------------------------------------------------------------------- // Parsing only... Tables of different types of instructions. @@ -192,7 +192,7 @@ type LazyInstrTable<'T> = Lazy> // -------------------------------------------------------------------- let NoArgInstrs = - lazy (((noArgInstrs |> Lazy.force |> List.map (fun (nm,i) -> (nm,(fun () -> i)))) @ + lazy (((noArgInstrs |> Lazy.force |> List.map (fun (nm, i) -> (nm, (fun () -> i)))) @ [ (mk_stind (["stind";"u"], DT_I)); (mk_stind (["stind";"i"], DT_I)); (mk_stind (["stind";"u1"], DT_I1));(* ILX EQUIVALENT *) @@ -218,8 +218,8 @@ let NoArgInstrs = (mk_ldind (["ldind";"r4"], DT_R4)); (mk_ldind (["ldind";"r8"], DT_R8)); (mk_ldind (["ldind";"ref"], DT_REF)); - (["cpblk"], (fun () -> I_cpblk(Aligned,Nonvolatile))); - (["initblk"], (fun () -> I_initblk(Aligned,Nonvolatile))); + (["cpblk"], (fun () -> I_cpblk(Aligned, Nonvolatile))); + (["initblk"], (fun () -> I_initblk(Aligned, Nonvolatile))); ] ) : NoArgInstr InstrTable);; @@ -231,14 +231,14 @@ let Int32Instrs = (["ldc";"i4";"s"], (fun x -> ((mkLdcInt32 x)))); ] : Int32Instr InstrTable) let Int32Int32Instrs = - lazy ([ (["ldlen";"multi"], (fun (x,y) -> EI_ldlen_multi (x, y))); ] : Int32Int32Instr InstrTable) + lazy ([ (["ldlen";"multi"], (fun (x, y) -> EI_ldlen_multi (x, y))); ] : Int32Int32Instr InstrTable) let DoubleInstrs = lazy ([ (["ldc";"r4"], (fun x -> (AI_ldc (DT_R4, x)))); (["ldc";"r8"], (fun x -> (AI_ldc (DT_R8, x)))); ] : DoubleInstr InstrTable) let MethodSpecInstrs = - lazy ([ ( (["call"], (fun (mspec,y) -> I_call (Normalcall,mspec,y)))) ] : InstrTable) + lazy ([ ( (["call"], (fun (mspec, y) -> I_call (Normalcall, mspec, y)))) ] : InstrTable) let StringInstrs = lazy ([ (["ldstr"], (fun x -> I_ldstr x)); ] : InstrTable) @@ -248,10 +248,10 @@ let TokenInstrs = let TypeInstrs = - lazy ([ (["ldelema"], (fun x -> I_ldelema (NormalAddress,false,ILArrayShape.SingleDimensional,x))); - (["ldelem";"any"], (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional,x))); + lazy ([ (["ldelema"], (fun x -> I_ldelema (NormalAddress, false, ILArrayShape.SingleDimensional, x))); + (["ldelem";"any"], (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional, x))); (["stelem";"any"], (fun x -> I_stelem_any (ILArrayShape.SingleDimensional, x))); - (["newarr"], (fun x -> I_newarr (ILArrayShape.SingleDimensional,x))); + (["newarr"], (fun x -> I_newarr (ILArrayShape.SingleDimensional, x))); (["castclass"], (fun x -> I_castclass x)); (["ilzero"], (fun x -> EI_ilzero x)); (["isinst"], (fun x -> I_isinst x)); @@ -259,16 +259,16 @@ let TypeInstrs = (["unbox";"any"], (fun x -> I_unbox_any x)); ] : InstrTable) let IntTypeInstrs = - lazy ([ (["ldelem";"multi"], (fun (x,y) -> (I_ldelem_any (ILArrayShape.FromRank x,y)))); - (["stelem";"multi"], (fun (x,y) -> (I_stelem_any (ILArrayShape.FromRank x,y)))); - (["newarr";"multi"], (fun (x,y) -> (I_newarr (ILArrayShape.FromRank x,y)))); - (["ldelema";"multi"], (fun (x,y) -> (I_ldelema (NormalAddress,false,ILArrayShape.FromRank x,y)))); ] : InstrTable) + lazy ([ (["ldelem";"multi"], (fun (x, y) -> (I_ldelem_any (ILArrayShape.FromRank x, y)))); + (["stelem";"multi"], (fun (x, y) -> (I_stelem_any (ILArrayShape.FromRank x, y)))); + (["newarr";"multi"], (fun (x, y) -> (I_newarr (ILArrayShape.FromRank x, y)))); + (["ldelema";"multi"], (fun (x, y) -> (I_ldelema (NormalAddress, false, ILArrayShape.FromRank x, y)))); ] : InstrTable) let ValueTypeInstrs = lazy ([ (["cpobj"], (fun x -> I_cpobj x)); (["initobj"], (fun x -> I_initobj x)); - (["ldobj"], (fun z -> I_ldobj (Aligned,Nonvolatile,z))); - (["stobj"], (fun z -> I_stobj (Aligned,Nonvolatile,z))); + (["ldobj"], (fun z -> I_ldobj (Aligned, Nonvolatile, z))); + (["stobj"], (fun z -> I_stobj (Aligned, Nonvolatile, z))); (["sizeof"], (fun x -> I_sizeof x)); (["box"], (fun x -> I_box x)); (["unbox"], (fun x -> I_unbox x)); ] : InstrTable) diff --git a/src/absil/ilprint.fs b/src/absil/ilprint.fs index 2bb50daa0a3..6c98fc605b9 100644 --- a/src/absil/ilprint.fs +++ b/src/absil/ilprint.fs @@ -271,11 +271,11 @@ and goutput_permission _env os p = match p with | PermissionSet (sa,b) -> - output_string os " .permissionset "; - output_security_action os sa ; - output_string os " = (" ; - output_bytes os b ; - output_string os ")" ; + output_string os " .permissionset " + output_security_action os sa + output_string os " = (" + output_bytes os b + output_string os ")" and goutput_security_decls env os (ps: ILPermissions) = output_seq " " (goutput_permission env) os ps.AsList diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index 2d42a6abd83..647d30457eb 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -43,7 +43,7 @@ let checking = false let logging = false let _ = if checking then dprintn "warning : Ilread.checking is on" -let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x),0) +let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) let doubleOfBits (x:int64) = System.BitConverter.Int64BitsToDouble(x) //--------------------------------------------------------------------- @@ -57,29 +57,29 @@ let uncodedToken (tab:TableName) idx = ((tab.Index <<< 24) ||| idx) let i32ToUncodedToken tok = let idx = tok &&& 0xffffff let tab = tok >>>& 24 - (TableName.FromIndex tab, idx) + (TableName.FromIndex tab, idx) [] type TaggedIndex<'T> = val tag: 'T val index : int32 - new(tag,index) = { tag=tag; index=index } + new(tag, index) = { tag=tag; index=index } -let uncodedTokenToTypeDefOrRefOrSpec (tab,tok) = +let uncodedTokenToTypeDefOrRefOrSpec (tab, tok) = let tag = if tab = TableNames.TypeDef then tdor_TypeDef elif tab = TableNames.TypeRef then tdor_TypeRef elif tab = TableNames.TypeSpec then tdor_TypeSpec else failwith "bad table in uncodedTokenToTypeDefOrRefOrSpec" - TaggedIndex(tag,tok) + TaggedIndex(tag, tok) -let uncodedTokenToMethodDefOrRef (tab,tok) = +let uncodedTokenToMethodDefOrRef (tab, tok) = let tag = if tab = TableNames.Method then mdor_MethodDef elif tab = TableNames.MemberRef then mdor_MemberRef else failwith "bad table in uncodedTokenToMethodDefOrRef" - TaggedIndex(tag,tok) + TaggedIndex(tag, tok) let (|TaggedIndex|) (x:TaggedIndex<'T>) = x.tag, x.index let tokToTaggedIdx f nbits tok = @@ -117,9 +117,9 @@ module MemoryMapping = [] extern HANDLE CreateFile (string _lpFileName, int _dwDesiredAccess, - int _dwShareMode, + int _dwShareMode, HANDLE _lpSecurityAttributes, - int _dwCreationDisposition, + int _dwCreationDisposition, int _dwFlagsAndAttributes, HANDLE _hTemplateFile) @@ -128,13 +128,13 @@ module MemoryMapping = HANDLE _lpAttributes, int _flProtect, int _dwMaximumSizeLow, - int _dwMaximumSizeHigh, + int _dwMaximumSizeHigh, string _lpName) [] extern ADDR MapViewOfFile (HANDLE _hFileMappingObject, int _dwDesiredAccess, - int _dwFileOffsetHigh, + int _dwFileOffsetHigh, int _dwFileOffsetLow, SIZE_T _dwNumBytesToMap) @@ -164,12 +164,12 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = failwithf "CreateFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) let protection = 0x00000002 (* ReadOnly *) //printf "OK! hFile = %Lx\n" (hFile.ToInt64()) - let hMap = MemoryMapping.CreateFileMapping (hFile, IntPtr.Zero, protection, 0,0, null ) + let hMap = MemoryMapping.CreateFileMapping (hFile, IntPtr.Zero, protection, 0, 0, null ) ignore(MemoryMapping.CloseHandle(hFile)) if hMap.Equals(MemoryMapping.NULL_HANDLE) then failwithf "CreateFileMapping(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) - let start = MemoryMapping.MapViewOfFile (hMap, MemoryMapping.MAP_READ,0,0,0n) + let start = MemoryMapping.MapViewOfFile (hMap, MemoryMapping.MAP_READ, 0, 0, 0n) if start.Equals(IntPtr.Zero) then failwithf "MapViewOfFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) @@ -183,7 +183,7 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = override m.ReadBytes i len = let res = Bytes.zeroCreate len - Marshal.Copy(m.Addr i, res, 0,len) + Marshal.Copy(m.Addr i, res, 0, len) res override m.ReadInt32 i = @@ -327,21 +327,21 @@ let sigptrGetByte (bytes:byte[]) sigptr = bytes.[sigptr], sigptr + 1 let sigptrGetBool bytes sigptr = - let b0,sigptr = sigptrGetByte bytes sigptr - (b0 = 0x01uy) ,sigptr + let b0, sigptr = sigptrGetByte bytes sigptr + (b0 = 0x01uy) , sigptr let sigptrGetSByte bytes sigptr = - let i,sigptr = sigptrGetByte bytes sigptr - sbyte i,sigptr + let i, sigptr = sigptrGetByte bytes sigptr + sbyte i, sigptr let sigptrGetUInt16 bytes sigptr = - let b0,sigptr = sigptrGetByte bytes sigptr - let b1,sigptr = sigptrGetByte bytes sigptr - uint16 (int b0 ||| (int b1 <<< 8)),sigptr + let b0, sigptr = sigptrGetByte bytes sigptr + let b1, sigptr = sigptrGetByte bytes sigptr + uint16 (int b0 ||| (int b1 <<< 8)), sigptr let sigptrGetInt16 bytes sigptr = - let u,sigptr = sigptrGetUInt16 bytes sigptr - int16 u,sigptr + let u, sigptr = sigptrGetUInt16 bytes sigptr + int16 u, sigptr let sigptrGetInt32 bytes sigptr = sigptrCheck bytes sigptr @@ -353,43 +353,43 @@ let sigptrGetInt32 bytes sigptr = res, sigptr + 4 let sigptrGetUInt32 bytes sigptr = - let u,sigptr = sigptrGetInt32 bytes sigptr - uint32 u,sigptr + let u, sigptr = sigptrGetInt32 bytes sigptr + uint32 u, sigptr let sigptrGetUInt64 bytes sigptr = - let u0,sigptr = sigptrGetUInt32 bytes sigptr - let u1,sigptr = sigptrGetUInt32 bytes sigptr - (uint64 u0 ||| (uint64 u1 <<< 32)),sigptr + let u0, sigptr = sigptrGetUInt32 bytes sigptr + let u1, sigptr = sigptrGetUInt32 bytes sigptr + (uint64 u0 ||| (uint64 u1 <<< 32)), sigptr let sigptrGetInt64 bytes sigptr = - let u,sigptr = sigptrGetUInt64 bytes sigptr - int64 u,sigptr + let u, sigptr = sigptrGetUInt64 bytes sigptr + int64 u, sigptr let sigptrGetSingle bytes sigptr = - let u,sigptr = sigptrGetInt32 bytes sigptr - singleOfBits u,sigptr + let u, sigptr = sigptrGetInt32 bytes sigptr + singleOfBits u, sigptr let sigptrGetDouble bytes sigptr = - let u,sigptr = sigptrGetInt64 bytes sigptr - doubleOfBits u,sigptr + let u, sigptr = sigptrGetInt64 bytes sigptr + doubleOfBits u, sigptr let sigptrGetZInt32 bytes sigptr = - let b0,sigptr = sigptrGetByte bytes sigptr + let b0, sigptr = sigptrGetByte bytes sigptr if b0 <= 0x7Fuy then int b0, sigptr elif b0 <= 0xBFuy then let b0 = b0 &&& 0x7Fuy - let b1,sigptr = sigptrGetByte bytes sigptr + let b1, sigptr = sigptrGetByte bytes sigptr (int b0 <<< 8) ||| int b1, sigptr else let b0 = b0 &&& 0x3Fuy - let b1,sigptr = sigptrGetByte bytes sigptr - let b2,sigptr = sigptrGetByte bytes sigptr - let b3,sigptr = sigptrGetByte 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 let rec sigptrFoldAcc f n (bytes:byte[]) (sigptr:int) i acc = if i < n then - let x,sp = f bytes sigptr + let x, sp = f bytes sigptr sigptrFoldAcc f n bytes sp (i+1) (x::acc) else List.rev acc, sigptr @@ -409,8 +409,8 @@ let sigptrGetBytes n (bytes:byte[]) sigptr = res, sigptr + n let sigptrGetString n bytes sigptr = - let bytearray,sigptr = sigptrGetBytes n bytes sigptr - (System.Text.Encoding.UTF8.GetString(bytearray, 0, bytearray.Length)),sigptr + let bytearray, sigptr = sigptrGetBytes n bytes sigptr + (System.Text.Encoding.UTF8.GetString(bytearray, 0, bytearray.Length)), sigptr // -------------------------------------------------------------------- @@ -437,7 +437,7 @@ let volatileOrUnalignedPrefix mk prefixes = if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here" if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here" if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" - mk (prefixes.al,prefixes.vol) + mk (prefixes.al, prefixes.vol) let volatilePrefix mk prefixes = if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" @@ -457,7 +457,7 @@ let constraintOrTailPrefix mk prefixes = if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here" if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" - mk (prefixes.constrained,prefixes.tl ) + mk (prefixes.constrained, prefixes.tl ) let readonlyPrefix mk prefixes = if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" @@ -490,40 +490,40 @@ type ILInstrDecoder = | I_type_instr of (ILInstrPrefixesRegister -> ILType -> ILInstr) | I_invalid_instr -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 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_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_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_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) - i_stind_i8, I_none_instr (mkStind DT_I8) - i_stind_r4, I_none_instr (mkStind DT_R4) - i_stind_r8, I_none_instr (mkStind DT_R8) + [ 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_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_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) + i_stind_i8, I_none_instr (mkStind DT_I8) + 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_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) - i_ldind_i8, I_none_instr (mkLdind DT_I8) - i_ldind_u1, I_none_instr (mkLdind DT_U1) - i_ldind_u2, I_none_instr (mkLdind DT_U2) - i_ldind_u4, I_none_instr (mkLdind DT_U4) - i_ldind_r4, I_none_instr (mkLdind DT_R4) - i_ldind_r8, I_none_instr (mkLdind DT_R8) + 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) + i_ldind_i8, I_none_instr (mkLdind DT_I8) + i_ldind_u1, I_none_instr (mkLdind DT_U1) + i_ldind_u2, I_none_instr (mkLdind DT_U2) + i_ldind_u4, I_none_instr (mkLdind DT_U4) + i_ldind_r4, I_none_instr (mkLdind DT_R4) + i_ldind_r8, I_none_instr (mkLdind DT_R8) i_ldind_ref, I_none_instr (mkLdind DT_REF) i_cpblk, I_none_instr (volatileOrUnalignedPrefix I_cpblk) i_initblk, I_none_instr (volatileOrUnalignedPrefix I_initblk) @@ -532,62 +532,62 @@ let instrs () = i_ldc_i4_s, I_i32_i8_instr (noPrefixes mkLdcInt32) i_ldc_r4, I_r4_instr (noPrefixes (fun x -> (AI_ldc (DT_R4, ILConst.R4 x)))) i_ldc_r8, I_r8_instr (noPrefixes (fun x -> (AI_ldc (DT_R8, ILConst.R8 x)))) - i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x,y) fspec -> I_ldfld(x,y,fspec))) - i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x,y) fspec -> I_stfld(x,y,fspec))) + i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_ldfld(x, y, fspec))) + i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_stfld(x, y, fspec))) i_ldsfld, I_field_instr (volatilePrefix (fun x fspec -> I_ldsfld (x, fspec))) i_stsfld, I_field_instr (volatilePrefix (fun x fspec -> I_stsfld (x, fspec))) i_ldflda, I_field_instr (noPrefixes I_ldflda) i_ldsflda, I_field_instr (noPrefixes I_ldsflda) - i_call, I_method_instr (tailPrefix (fun tl (mspec,y) -> I_call (tl,mspec,y))) - i_ldftn, I_method_instr (noPrefixes (fun (mspec,_y) -> I_ldftn mspec)) - i_ldvirtftn, I_method_instr (noPrefixes (fun (mspec,_y) -> I_ldvirtftn mspec)) + i_call, I_method_instr (tailPrefix (fun tl (mspec, y) -> I_call (tl, mspec, y))) + i_ldftn, I_method_instr (noPrefixes (fun (mspec, _y) -> I_ldftn mspec)) + i_ldvirtftn, I_method_instr (noPrefixes (fun (mspec, _y) -> I_ldvirtftn mspec)) i_newobj, I_method_instr (noPrefixes I_newobj) - i_callvirt, I_method_instr (constraintOrTailPrefix (fun (c,tl) (mspec,y) -> match c with Some ty -> I_callconstraint(tl,ty,mspec,y) | None -> I_callvirt (tl,mspec,y))) + i_callvirt, I_method_instr (constraintOrTailPrefix (fun (c, tl) (mspec, y) -> match c with Some ty -> I_callconstraint(tl, ty, mspec, y) | None -> I_callvirt (tl, mspec, y))) i_leave_s, I_unconditional_i8_instr (noPrefixes (fun x -> I_leave x)) i_br_s, I_unconditional_i8_instr (noPrefixes I_br) i_leave, I_unconditional_i32_instr (noPrefixes (fun x -> I_leave x)) i_br, I_unconditional_i32_instr (noPrefixes I_br) - i_brtrue_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue,x))) - i_brfalse_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse,x))) - i_beq_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_beq,x))) - i_blt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt,x))) - i_blt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un,x))) - i_ble_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble,x))) - i_ble_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un,x))) - i_bgt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt,x))) - i_bgt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un,x))) - i_bge_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge,x))) - i_bge_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un,x))) - i_bne_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un,x))) - i_brtrue, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue,x))) - i_brfalse, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse,x))) - i_beq, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_beq,x))) - i_blt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt,x))) - i_blt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un,x))) - i_ble, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble,x))) - i_ble_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un,x))) - i_bgt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt,x))) - i_bgt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un,x))) - i_bge, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge,x))) - i_bge_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un,x))) - i_bne_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un,x))) + i_brtrue_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue, x))) + i_brfalse_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse, x))) + i_beq_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_beq, x))) + i_blt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt, x))) + i_blt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un, x))) + i_ble_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble, x))) + i_ble_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un, x))) + i_bgt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt, x))) + i_bgt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un, x))) + i_bge_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge, x))) + i_bge_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un, x))) + i_bne_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un, x))) + i_brtrue, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue, x))) + i_brfalse, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse, x))) + i_beq, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_beq, x))) + i_blt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt, x))) + i_blt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un, x))) + i_ble, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble, x))) + i_ble_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un, x))) + i_bgt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt, x))) + i_bgt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un, x))) + i_bge, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge, x))) + i_bge_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un, x))) + i_bne_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un, x))) i_ldstr, I_string_instr (noPrefixes I_ldstr) i_switch, I_switch_instr (noPrefixes I_switch) i_ldtoken, I_tok_instr (noPrefixes I_ldtoken) - i_calli, I_sig_instr (tailPrefix (fun tl (x,y) -> I_calli (tl, x, y))) + i_calli, I_sig_instr (tailPrefix (fun tl (x, y) -> I_calli (tl, x, y))) i_mkrefany, I_type_instr (noPrefixes I_mkrefany) i_refanyval, I_type_instr (noPrefixes I_refanyval) - i_ldelema, I_type_instr (readonlyPrefix (fun ro x -> I_ldelema (ro,false,ILArrayShape.SingleDimensional,x))) - i_ldelem_any, I_type_instr (noPrefixes (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional,x))) - i_stelem_any, I_type_instr (noPrefixes (fun x -> I_stelem_any (ILArrayShape.SingleDimensional,x))) - i_newarr, I_type_instr (noPrefixes (fun x -> I_newarr (ILArrayShape.SingleDimensional,x))) + i_ldelema, I_type_instr (readonlyPrefix (fun ro x -> I_ldelema (ro, false, ILArrayShape.SingleDimensional, x))) + i_ldelem_any, I_type_instr (noPrefixes (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional, x))) + i_stelem_any, I_type_instr (noPrefixes (fun x -> I_stelem_any (ILArrayShape.SingleDimensional, x))) + i_newarr, I_type_instr (noPrefixes (fun x -> I_newarr (ILArrayShape.SingleDimensional, x))) i_castclass, I_type_instr (noPrefixes I_castclass) i_isinst, I_type_instr (noPrefixes I_isinst) i_unbox_any, I_type_instr (noPrefixes I_unbox_any) i_cpobj, I_type_instr (noPrefixes I_cpobj) i_initobj, I_type_instr (noPrefixes I_initobj) - i_ldobj, I_type_instr (volatileOrUnalignedPrefix (fun (x,y) z -> I_ldobj (x,y,z))) - i_stobj, I_type_instr (volatileOrUnalignedPrefix (fun (x,y) z -> I_stobj (x,y,z))) + i_ldobj, I_type_instr (volatileOrUnalignedPrefix (fun (x, y) z -> I_ldobj (x, y, z))) + i_stobj, I_type_instr (volatileOrUnalignedPrefix (fun (x, y) z -> I_stobj (x, y, z))) i_sizeof, I_type_instr (noPrefixes I_sizeof) i_box, I_type_instr (noPrefixes I_box) i_unbox, I_type_instr (noPrefixes I_unbox) ] @@ -599,7 +599,7 @@ let twoByteInstrs = ref None let fillInstrs () = let oneByteInstrTable = Array.create 256 I_invalid_instr let twoByteInstrTable = Array.create 256 I_invalid_instr - let addInstr (i,f) = + let addInstr (i, f) = if i > 0xff then assert (i >>>& 8 = 0xfe) let i = (i &&& 0xff) @@ -613,7 +613,7 @@ let fillInstrs () = | _ -> dprintn ("warning: duplicate decode entries for "+string i) oneByteInstrTable.[i] <- f List.iter addInstr (instrs()) - List.iter (fun (x,mk) -> addInstr (x,I_none_instr (noPrefixes mk))) (noArgInstrs.Force()) + List.iter (fun (x, mk) -> addInstr (x, I_none_instr (noPrefixes mk))) (noArgInstrs.Force()) oneByteInstrs := Some oneByteInstrTable twoByteInstrs := Some twoByteInstrTable @@ -633,8 +633,8 @@ 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 chunk sz next = ({addr=next; size=sz}, next + sz) +let nochunk next = ({addr= 0x0;size= 0x0; } , next) type RowElementKind = | UShort @@ -761,7 +761,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<_> @@ -784,7 +784,7 @@ let mkCacheGeneric lowMem _inbase _nm _sz = fun f (idx :'T) -> let cache = match !cache with - | null -> cache := new Dictionary<_,_>(11 (* sz:int *) ) + | null -> cache := new Dictionary<_, _>(11 (* sz:int *) ) | _ -> () !cache if cache.ContainsKey idx then (incr count; cache.[idx]) @@ -1090,7 +1090,7 @@ let seekReadTypeRefRow ctxt idx = let scopeIdx = seekReadResolutionScopeIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let namespaceIdx = seekReadStringIdx ctxt &addr - (scopeIdx,nameIdx,namespaceIdx) + (scopeIdx, nameIdx, namespaceIdx) /// Read Table ILTypeDef. let seekReadTypeDefRow ctxt idx = ctxt.seekReadTypeDefRow idx @@ -1113,7 +1113,7 @@ let seekReadFieldRow ctxt idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let typeIdx = seekReadBlobIdx ctxt &addr - (flags,nameIdx,typeIdx) + (flags, nameIdx, typeIdx) /// Read Table Method. let seekReadMethodRow ctxt idx = @@ -1134,7 +1134,7 @@ let seekReadParamRow ctxt idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let seq = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr - (flags,seq,nameIdx) + (flags, seq, nameIdx) /// Read Table InterfaceImpl. let seekReadInterfaceImplRow ctxt idx = ctxt.seekReadInterfaceImplRow idx @@ -1144,7 +1144,7 @@ let seekReadInterfaceImplRowUncached ctxtH idx = let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let intfIdx = seekReadTypeDefOrRefOrSpecIdx ctxt &addr - (tidx,intfIdx) + (tidx, intfIdx) /// Read Table MemberRef. let seekReadMemberRefRow ctxt idx = @@ -1153,7 +1153,7 @@ let seekReadMemberRefRow ctxt idx = let mrpIdx = seekReadMemberRefParentIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let typeIdx = seekReadBlobIdx ctxt &addr - (mrpIdx,nameIdx,typeIdx) + (mrpIdx, nameIdx, typeIdx) /// Read Table Constant. let seekReadConstantRow ctxt idx = ctxt.seekReadConstantRow idx @@ -1201,7 +1201,7 @@ let seekReadClassLayoutRow ctxt idx = let pack = seekReadUInt16Adv ctxt &addr let size = seekReadInt32Adv ctxt &addr let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr - (pack,size,tidx) + (pack, size, tidx) /// Read Table FieldLayout. let seekReadFieldLayoutRow ctxt idx = @@ -1209,7 +1209,7 @@ let seekReadFieldLayoutRow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.FieldLayout idx let offset = seekReadInt32Adv ctxt &addr let fidx = seekReadUntaggedIdx TableNames.Field ctxt &addr - (offset,fidx) + (offset, fidx) //// Read Table StandAloneSig. let seekReadStandAloneSigRow ctxt idx = @@ -1224,7 +1224,7 @@ let seekReadEventMapRow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.EventMap idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let eventsIdx = seekReadUntaggedIdx TableNames.Event ctxt &addr - (tidx,eventsIdx) + (tidx, eventsIdx) /// Read Table Event. let seekReadEventRow ctxt idx = @@ -1233,7 +1233,7 @@ let seekReadEventRow ctxt idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let typIdx = seekReadTypeDefOrRefOrSpecIdx ctxt &addr - (flags,nameIdx,typIdx) + (flags, nameIdx, typIdx) /// Read Table PropertyMap. let seekReadPropertyMapRow ctxt idx = ctxt.seekReadPropertyMapRow idx @@ -1243,7 +1243,7 @@ let seekReadPropertyMapRowUncached ctxtH idx = let mutable addr = ctxt.rowAddr TableNames.PropertyMap idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let propsIdx = seekReadUntaggedIdx TableNames.Property ctxt &addr - (tidx,propsIdx) + (tidx, propsIdx) /// Read Table Property. let seekReadPropertyRow ctxt idx = @@ -1252,7 +1252,7 @@ let seekReadPropertyRow ctxt idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let typIdx = seekReadBlobIdx ctxt &addr - (flags,nameIdx,typIdx) + (flags, nameIdx, typIdx) /// Read Table MethodSemantics. let seekReadMethodSemanticsRow ctxt idx = ctxt.seekReadMethodSemanticsRow idx @@ -1263,7 +1263,7 @@ let seekReadMethodSemanticsRowUncached ctxtH idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let midx = seekReadUntaggedIdx TableNames.Method ctxt &addr let assocIdx = seekReadHasSemanticsIdx ctxt &addr - (flags,midx,assocIdx) + (flags, midx, assocIdx) /// Read Table MethodImpl. let seekReadMethodImplRow ctxt idx = @@ -1272,7 +1272,7 @@ let seekReadMethodImplRow ctxt idx = let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let mbodyIdx = seekReadMethodDefOrRefIdx ctxt &addr let mdeclIdx = seekReadMethodDefOrRefIdx ctxt &addr - (tidx,mbodyIdx,mdeclIdx) + (tidx, mbodyIdx, mdeclIdx) /// Read Table ILModuleRef. let seekReadModuleRefRow ctxt idx = @@ -1304,7 +1304,7 @@ let seekReadFieldRVARow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.FieldRVA idx let rva = seekReadInt32Adv ctxt &addr let fidx = seekReadUntaggedIdx TableNames.Field ctxt &addr - (rva,fidx) + (rva, fidx) /// Read Table Assembly. let seekReadAssemblyRow ctxt idx = @@ -1319,7 +1319,7 @@ let seekReadAssemblyRow ctxt idx = let publicKeyIdx = seekReadBlobIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let localeIdx = seekReadStringIdx ctxt &addr - (hash,v1,v2,v3,v4,flags,publicKeyIdx, nameIdx, localeIdx) + (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) /// Read Table ILAssemblyRef. let seekReadAssemblyRefRow ctxt idx = @@ -1334,7 +1334,7 @@ let seekReadAssemblyRefRow ctxt idx = let nameIdx = seekReadStringIdx ctxt &addr let localeIdx = seekReadStringIdx ctxt &addr let hashValueIdx = seekReadBlobIdx ctxt &addr - (v1,v2,v3,v4,flags,publicKeyOrTokenIdx, nameIdx, localeIdx,hashValueIdx) + (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) /// Read Table File. let seekReadFileRow ctxt idx = @@ -1354,7 +1354,7 @@ let seekReadExportedTypeRow ctxt idx = let nameIdx = seekReadStringIdx ctxt &addr let namespaceIdx = seekReadStringIdx ctxt &addr let implIdx = seekReadImplementationIdx ctxt &addr - (flags,tok,nameIdx,namespaceIdx,implIdx) + (flags, tok, nameIdx, namespaceIdx, implIdx) /// Read Table ManifestResource. let seekReadManifestResourceRow ctxt idx = @@ -1364,7 +1364,7 @@ let seekReadManifestResourceRow ctxt idx = let flags = seekReadInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let implIdx = seekReadImplementationIdx ctxt &addr - (offset,flags,nameIdx,implIdx) + (offset, flags, nameIdx, implIdx) /// Read Table Nested. let seekReadNestedRow ctxt idx = ctxt.seekReadNestedRow idx @@ -1374,7 +1374,7 @@ let seekReadNestedRowUncached ctxtH idx = let mutable addr = ctxt.rowAddr TableNames.Nested idx let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let enclIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr - (nestedIdx,enclIdx) + (nestedIdx, enclIdx) /// Read Table GenericParam. let seekReadGenericParamRow ctxt idx = @@ -1384,7 +1384,7 @@ let seekReadGenericParamRow ctxt idx = let flags = seekReadUInt16Adv ctxt &addr let ownerIdx = seekReadTypeOrMethodDefIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr - (idx,seq,flags,ownerIdx,nameIdx) + (idx, seq, flags, ownerIdx, nameIdx) // Read Table GenericParamConstraint. let seekReadGenericParamConstraintRow ctxt idx = @@ -1392,7 +1392,7 @@ let seekReadGenericParamConstraintRow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.GenericParamConstraint idx let pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt &addr let constraintIdx = seekReadTypeDefOrRefOrSpecIdx ctxt &addr - (pidx,constraintIdx) + (pidx, constraintIdx) /// Read Table ILMethodSpec. let seekReadMethodSpecRow ctxt idx = @@ -1400,7 +1400,7 @@ let seekReadMethodSpecRow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.MethodSpec idx let mdorIdx = seekReadMethodDefOrRefIdx ctxt &addr let instIdx = seekReadBlobIdx ctxt &addr - (mdorIdx,instIdx) + (mdorIdx, instIdx) let readUserStringHeapUncached ctxtH idx = @@ -1465,7 +1465,7 @@ let readNativeResources ctxt = if ctxt.nativeResourcesSize = 0x0 || ctxt.nativeResourcesAddr = 0x0 then [] else - [ (lazy (let linkedResource = seekReadBytes ctxt.is (ctxt.anyV2P (ctxt.infile + ": native resources",ctxt.nativeResourcesAddr)) ctxt.nativeResourcesSize + [ (lazy (let linkedResource = seekReadBytes ctxt.is (ctxt.anyV2P (ctxt.infile + ": native resources", ctxt.nativeResourcesAddr)) ctxt.nativeResourcesSize unlinkResource ctxt.nativeResourcesAddr linkedResource)) ] nativeResources #endif @@ -1476,10 +1476,10 @@ let dataEndPoints ctxtH = let dataStartPoints = let res = ref [] for i = 1 to ctxt.getNumRows (TableNames.FieldRVA) do - let rva,_fidx = seekReadFieldRVARow ctxt i - res := ("field",rva) :: !res + let rva, _fidx = seekReadFieldRVARow ctxt i + res := ("field", rva) :: !res for i = 1 to ctxt.getNumRows TableNames.ManifestResource do - let (offset,_,_,TaggedIndex(_tag,idx)) = seekReadManifestResourceRow ctxt i + let (offset, _, _, TaggedIndex(_tag, idx)) = seekReadManifestResourceRow ctxt i if idx = 0 then let rva = ctxt.resourcesAddr + offset res := ("manifest resource", rva) :: !res @@ -1492,19 +1492,19 @@ let dataEndPoints ctxtH = let (rva, _, _, nameIdx, _, _) = seekReadMethodRow ctxt i if rva <> 0 then let nm = readStringHeap ctxt nameIdx - res := (nm,rva) :: !res + res := (nm, rva) :: !res !res ([ ctxt.textSegmentPhysicalLoc + ctxt.textSegmentPhysicalSize ; ctxt.dataSegmentPhysicalLoc + ctxt.dataSegmentPhysicalSize ] @ (List.map ctxt.anyV2P (dataStartPoints - @ [for (virtAddr,_virtSize,_physLoc) in ctxt.sectionHeaders do yield ("section start",virtAddr) done] - @ [("md",ctxt.metadataAddr)] - @ (if ctxt.nativeResourcesAddr = 0x0 then [] else [("native resources",ctxt.nativeResourcesAddr) ]) - @ (if ctxt.resourcesAddr = 0x0 then [] else [("managed resources",ctxt.resourcesAddr) ]) - @ (if ctxt.strongnameAddr = 0x0 then [] else [("managed strongname",ctxt.strongnameAddr) ]) - @ (if ctxt.vtableFixupsAddr = 0x0 then [] else [("managed vtable_fixups",ctxt.vtableFixupsAddr) ]) + @ [for (virtAddr, _virtSize, _physLoc) in ctxt.sectionHeaders do yield ("section start", virtAddr) done] + @ [("md", ctxt.metadataAddr)] + @ (if ctxt.nativeResourcesAddr = 0x0 then [] else [("native resources", ctxt.nativeResourcesAddr) ]) + @ (if ctxt.resourcesAddr = 0x0 then [] else [("managed resources", ctxt.resourcesAddr) ]) + @ (if ctxt.strongnameAddr = 0x0 then [] else [("managed strongname", ctxt.strongnameAddr) ]) + @ (if ctxt.vtableFixupsAddr = 0x0 then [] else [("managed vtable_fixups", ctxt.vtableFixupsAddr) ]) @ methodRVAs))) |> List.distinct |> List.sort @@ -1532,7 +1532,7 @@ let rec rvaToData ctxt nm rva = let isSorted ctxt (tab:TableName) = ((ctxt.sorted &&& (int64 1 <<< tab.Index)) <> int64 0x0) -let rec seekReadModule ctxt (subsys,subsysversion,useHighEntropyVA, ilOnly,only32,is32bitpreferred,only64,platform,isDll, alignVirt,alignPhys,imageBaseReal,ilMetadataVersion) idx = +let rec seekReadModule ctxt (subsys, subsysversion, useHighEntropyVA, ilOnly, only32, is32bitpreferred, only64, platform, isDll, alignVirt, alignPhys, imageBaseReal, ilMetadataVersion) idx = let (_generation, nameIdx, _mvidIdx, _encidIdx, _encbaseidIdx) = seekReadModuleRow ctxt idx let ilModuleName = readStringHeap ctxt nameIdx let nativeResources = readNativeResources ctxt @@ -1540,7 +1540,7 @@ let rec seekReadModule ctxt (subsys,subsysversion,useHighEntropyVA, ilOnly,only3 { Manifest = if ctxt.getNumRows (TableNames.Assembly) > 0 then Some (seekReadAssemblyManifest ctxt 1) else None - CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Module,idx)) + CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Module, idx)) Name = ilModuleName NativeResources=nativeResources TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt ()) @@ -1561,16 +1561,16 @@ let rec seekReadModule ctxt (subsys,subsysversion,useHighEntropyVA, ilOnly,only3 Resources = seekReadManifestResources ctxt () } and seekReadAssemblyManifest ctxt idx = - let (hash,v1,v2,v3,v4,flags,publicKeyIdx, nameIdx, localeIdx) = seekReadAssemblyRow ctxt idx + let (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) = seekReadAssemblyRow ctxt idx let name = readStringHeap ctxt nameIdx let pubkey = readBlobHeapOption ctxt publicKeyIdx { Name= name AuxModuleHashAlgorithm=hash - SecurityDecls= seekReadSecurityDecls ctxt (TaggedIndex(hds_Assembly,idx)) + SecurityDecls= seekReadSecurityDecls ctxt (TaggedIndex(hds_Assembly, idx)) PublicKey= pubkey - Version= Some (v1,v2,v3,v4) + Version= Some (v1, v2, v3, v4) Locale= readStringHeapOption ctxt localeIdx - CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Assembly,idx)) + CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Assembly, idx)) AssemblyLongevity= begin let masked = flags &&& 0x000e if masked = 0x0000 then ILAssemblyLongevity.Unspecified @@ -1590,7 +1590,7 @@ and seekReadAssemblyManifest ctxt idx = and seekReadAssemblyRef ctxt idx = ctxt.seekReadAssemblyRef idx and seekReadAssemblyRefUncached ctxtH idx = let ctxt = getHole ctxtH - let (v1,v2,v3,v4,flags,publicKeyOrTokenIdx, nameIdx, localeIdx,hashValueIdx) = seekReadAssemblyRefRow ctxt idx + let (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) = seekReadAssemblyRefRow ctxt idx let nm = readStringHeap ctxt nameIdx let publicKey = match readBlobHeapOption ctxt publicKeyOrTokenIdx with @@ -1600,27 +1600,27 @@ and seekReadAssemblyRefUncached ctxtH idx = ILAssemblyRef.Create (name=nm, hash=readBlobHeapOption ctxt hashValueIdx, - publicKey=publicKey, + publicKey=publicKey, retargetable=((flags &&& 0x0100) <> 0x0), - version=Some(v1,v2,v3,v4), + version=Some(v1, v2, v3, v4), locale=readStringHeapOption ctxt localeIdx) and seekReadModuleRef ctxt idx = let (nameIdx) = seekReadModuleRefRow ctxt idx - ILModuleRef.Create(name = readStringHeap ctxt nameIdx, - hasMetadata=true, + ILModuleRef.Create(name = readStringHeap ctxt nameIdx, + hasMetadata=true, hash=None) and seekReadFile ctxt idx = let (flags, nameIdx, hashValueIdx) = seekReadFileRow ctxt idx - ILModuleRef.Create(name = readStringHeap ctxt nameIdx, - hasMetadata= ((flags &&& 0x0001) = 0x0), + ILModuleRef.Create(name = readStringHeap ctxt nameIdx, + hasMetadata= ((flags &&& 0x0001) = 0x0), hash= readBlobHeapOption ctxt hashValueIdx) and seekReadClassLayout ctxt idx = - match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.ClassLayout,seekReadClassLayoutRow ctxt,(fun (_,_,tidx) -> tidx),simpleIndexCompare idx,isSorted ctxt TableNames.ClassLayout,(fun (pack,size,_) -> pack,size)) with + match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.ClassLayout, seekReadClassLayoutRow ctxt, (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 } + | Some (pack, size) -> { Size = Some size; Pack = Some pack } and memberAccessOfFlags flags = let f = (flags &&& 0x00000007) @@ -1673,17 +1673,17 @@ and isTopTypeDef flags = typeAccessOfFlags flags = ILTypeDefAccess.Public and seekIsTopTypeDefOfIdx ctxt idx = - let (flags,_,_, _, _,_) = seekReadTypeDefRow ctxt idx + let (flags, _, _, _, _, _) = seekReadTypeDefRow ctxt idx isTopTypeDef flags -and readBlobHeapAsSplitTypeName ctxt (nameIdx,namespaceIdx) = +and readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) = let name = readStringHeap ctxt nameIdx let nspace = readStringHeapOption ctxt namespaceIdx match nspace with - | Some nspace -> splitNamespace nspace,name - | None -> [],name + | Some nspace -> splitNamespace nspace, name + | None -> [], name -and readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) = +and readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) = let name = readStringHeap ctxt nameIdx let nspace = readStringHeapOption ctxt namespaceIdx match nspace with @@ -1692,7 +1692,7 @@ and readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) = and seekReadTypeDefRowExtents ctxt _info (idx:int) = if idx >= ctxt.getNumRows TableNames.TypeDef then - ctxt.getNumRows TableNames.Field + 1, + ctxt.getNumRows TableNames.Field + 1, ctxt.getNumRows TableNames.Method + 1 else let (_, _, _, _, fieldsIdx, methodsIdx) = seekReadTypeDefRow ctxt (idx + 1) @@ -1700,35 +1700,35 @@ and seekReadTypeDefRowExtents ctxt _info (idx:int) = and seekReadTypeDefRowWithExtents ctxt (idx:int) = let info= seekReadTypeDefRow ctxt idx - info,seekReadTypeDefRowExtents ctxt info idx + info, seekReadTypeDefRowExtents ctxt info idx and seekReadTypeDef ctxt toponly (idx:int) = - let (flags,nameIdx,namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx + let (flags, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx if toponly && not (isTopTypeDef flags) then None else - let ns,n = readBlobHeapAsSplitTypeName ctxt (nameIdx,namespaceIdx) - let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_TypeDef,idx)) + let ns, n = readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) + let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_TypeDef, idx)) let rest = lazy // Re-read so as not to save all these in the lazy closure - this suspension ctxt.is the largest // heavily allocated one in all of AbsIL - let ((flags,nameIdx,namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) as info) = seekReadTypeDefRow ctxt idx - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) - let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_TypeDef,idx)) + let ((flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) as info) = seekReadTypeDefRow ctxt idx + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) + let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_TypeDef, idx)) let (endFieldsIdx, endMethodsIdx) = seekReadTypeDefRowExtents ctxt info idx - let typars = seekReadGenericParams ctxt 0 (tomd_TypeDef,idx) + let typars = seekReadGenericParams ctxt 0 (tomd_TypeDef, idx) let numtypars = typars.Length let super = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject extendsIdx let layout = typeLayoutOfFlags ctxt flags idx let hasLayout = (match layout with ILTypeDefLayout.Explicit _ -> true | _ -> false) let mdefs = seekReadMethods ctxt numtypars methodsIdx endMethodsIdx - let fdefs = seekReadFields ctxt (numtypars,hasLayout) fieldsIdx endFieldsIdx + let fdefs = seekReadFields ctxt (numtypars, hasLayout) fieldsIdx endFieldsIdx let kind = typeKindOfFlags nm mdefs fdefs super flags let nested = seekReadNestedTypeDefs ctxt idx let impls = seekReadInterfaceImpls ctxt numtypars idx - let sdecls = seekReadSecurityDecls ctxt (TaggedIndex(hds_TypeDef,idx)) + let sdecls = seekReadSecurityDecls ctxt (TaggedIndex(hds_TypeDef, idx)) let mimpls = seekReadMethodImpls ctxt numtypars idx let props = seekReadProperties ctxt numtypars idx let events = seekReadEvents ctxt numtypars idx @@ -1758,7 +1758,7 @@ and seekReadTypeDef ctxt toponly (idx:int) = Events= events Properties=props CustomAttrs=cas } - Some (ns,n,cas,rest) + Some (ns, n, cas, rest) and seekReadTopTypeDefs ctxt () = [| for i = 1 to ctxt.getNumRows TableNames.TypeDef do @@ -1768,32 +1768,32 @@ and seekReadTopTypeDefs ctxt () = and seekReadNestedTypeDefs ctxt tidx = mkILTypeDefsComputed (fun () -> - let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested,seekReadNestedRow ctxt,snd,simpleIndexCompare tidx,false,fst) + let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, snd, simpleIndexCompare tidx, false, fst) [| for i in nestedIdxs do match seekReadTypeDef ctxt false i with | None -> () | Some td -> yield td |]) and seekReadInterfaceImpls ctxt numtypars tidx = - seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl, - seekReadInterfaceImplRow ctxt, - fst, - simpleIndexCompare tidx, - isSorted ctxt TableNames.InterfaceImpl, + seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl, + seekReadInterfaceImplRow ctxt, + fst, + simpleIndexCompare tidx, + isSorted ctxt TableNames.InterfaceImpl, (snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty)) -and seekReadGenericParams ctxt numtypars (a,b) : ILGenericParameterDefs = - ctxt.seekReadGenericParams (GenericParamsIdx(numtypars,a,b)) +and seekReadGenericParams ctxt numtypars (a, b) : ILGenericParameterDefs = + ctxt.seekReadGenericParams (GenericParamsIdx(numtypars, a, b)) -and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars,a,b)) = +and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars, a, b)) = let ctxt = getHole ctxtH let pars = seekReadIndexedRows - (ctxt.getNumRows TableNames.GenericParam,seekReadGenericParamRow ctxt, - (fun (_,_,_,tomd,_) -> tomd), - tomdCompare (TaggedIndex(a,b)), - isSorted ctxt TableNames.GenericParam, - (fun (gpidx,seq,flags,_,nameIdx) -> + (ctxt.getNumRows TableNames.GenericParam, seekReadGenericParamRow ctxt, + (fun (_, _, _, tomd, _) -> tomd), + tomdCompare (TaggedIndex(a, b)), + isSorted ctxt TableNames.GenericParam, + (fun (gpidx, seq, flags, _, nameIdx) -> let flags = int32 flags let variance_flags = flags &&& 0x0003 let variance = @@ -1802,7 +1802,7 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars,a,b)) = elif variance_flags = 0x0002 then ContraVariant else NonVariant let constraints = seekReadGenericParamConstraintsUncached ctxt numtypars gpidx - let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_GenericParam,gpidx)) + let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_GenericParam, gpidx)) seq, {Name=readStringHeap ctxt nameIdx Constraints = constraints Variance=variance @@ -1814,17 +1814,17 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars,a,b)) = and seekReadGenericParamConstraintsUncached ctxt numtypars gpidx = seekReadIndexedRows - (ctxt.getNumRows TableNames.GenericParamConstraint, - seekReadGenericParamConstraintRow ctxt, - fst, - simpleIndexCompare gpidx, - isSorted ctxt TableNames.GenericParamConstraint, + (ctxt.getNumRows TableNames.GenericParamConstraint, + seekReadGenericParamConstraintRow ctxt, + fst, + simpleIndexCompare gpidx, + isSorted ctxt TableNames.GenericParamConstraint, (snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty)) and seekReadTypeDefAsType ctxt boxity (ginst:ILTypes) idx = - ctxt.seekReadTypeDefAsType (TypeDefAsTypIdx (boxity,ginst,idx)) + ctxt.seekReadTypeDefAsType (TypeDefAsTypIdx (boxity, ginst, idx)) -and seekReadTypeDefAsTypeUncached ctxtH (TypeDefAsTypIdx (boxity,ginst,idx)) = +and seekReadTypeDefAsTypeUncached ctxtH (TypeDefAsTypIdx (boxity, ginst, idx)) = let ctxt = getHole ctxtH mkILTy boxity (ILTypeSpec.Create(seekReadTypeDefAsTypeRef ctxt idx, ginst)) @@ -1832,27 +1832,27 @@ and seekReadTypeDefAsTypeRef ctxt idx = let enc = if seekIsTopTypeDefOfIdx ctxt idx then [] else - let enclIdx = seekReadIndexedRow (ctxt.getNumRows TableNames.Nested,seekReadNestedRow ctxt,fst,simpleIndexCompare idx,isSorted ctxt TableNames.Nested,snd) + let enclIdx = seekReadIndexedRow (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, fst, simpleIndexCompare idx, isSorted ctxt TableNames.Nested, snd) let tref = seekReadTypeDefAsTypeRef ctxt enclIdx tref.Enclosing@[tref.Name] let (_, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) ILTypeRef.Create(scope=ILScopeRef.Local, enclosing=enc, name = nm ) and seekReadTypeRef ctxt idx = ctxt.seekReadTypeRef idx and seekReadTypeRefUncached ctxtH idx = let ctxt = getHole ctxtH - let scopeIdx,nameIdx,namespaceIdx = seekReadTypeRefRow ctxt idx - let scope,enc = seekReadTypeRefScope ctxt scopeIdx - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) + let scopeIdx, nameIdx, namespaceIdx = seekReadTypeRefRow ctxt idx + let scope, enc = seekReadTypeRefScope ctxt scopeIdx + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) ILTypeRef.Create(scope=scope, enclosing=enc, name = nm) -and seekReadTypeRefAsType ctxt boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx (boxity,ginst,idx)) -and seekReadTypeRefAsTypeUncached ctxtH (TypeRefAsTypIdx (boxity,ginst,idx)) = +and seekReadTypeRefAsType ctxt 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 numtypars boxity (ginst:ILTypes) (TaggedIndex(tag,idx) ) = +and seekReadTypeDefOrRef ctxt numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, idx) ) = match tag with | tag when tag = tdor_TypeDef -> seekReadTypeDefAsType ctxt boxity ginst idx | tag when tag = tdor_TypeRef -> seekReadTypeRefAsType ctxt boxity ginst idx @@ -1861,7 +1861,7 @@ and seekReadTypeDefOrRef ctxt numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt idx) | _ -> failwith "seekReadTypeDefOrRef ctxt" -and seekReadTypeDefOrRefAsTypeRef ctxt (TaggedIndex(tag,idx) ) = +and seekReadTypeDefOrRefAsTypeRef ctxt (TaggedIndex(tag, idx) ) = match tag with | tag when tag = tdor_TypeDef -> seekReadTypeDefAsTypeRef ctxt idx | tag when tag = tdor_TypeRef -> seekReadTypeRef ctxt idx @@ -1870,7 +1870,7 @@ and seekReadTypeDefOrRefAsTypeRef ctxt (TaggedIndex(tag,idx) ) = ctxt.ilg.typ_Object.TypeRef | _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec" -and seekReadMethodRefParent ctxt numtypars (TaggedIndex(tag,idx)) = +and seekReadMethodRefParent ctxt 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 ctxt.is a value type or not *) List.empty idx | tag when tag = mrp_ModuleRef -> mkILTypeForGlobalFunctions (ILScopeRef.Module (seekReadModuleRef ctxt idx)) @@ -1881,11 +1881,11 @@ and seekReadMethodRefParent ctxt numtypars (TaggedIndex(tag,idx)) = | tag when tag = mrp_TypeSpec -> readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt idx) | _ -> failwith "seekReadMethodRefParent ctxt" -and seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(tag,idx)) = +and seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(tag, idx)) = match tag with | tag when tag = mdor_MethodDef -> - let (MethodData(enclTyp, cc, nm, argtys, retty,minst)) = seekReadMethodDefAsMethodData ctxt idx - VarArgMethodData(enclTyp, cc, nm, argtys, None,retty,minst) + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx + VarArgMethodData(enclTyp, cc, nm, argtys, None, retty, minst) | tag when tag = mdor_MemberRef -> seekReadMemberRefAsMethodData ctxt numtypars idx | _ -> failwith "seekReadMethodDefOrRef ctxt" @@ -1893,9 +1893,9 @@ and seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(tag,idx)) = and seekReadMethodDefOrRefNoVarargs ctxt numtypars x = let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) = seekReadMethodDefOrRef ctxt numtypars x if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" - MethodData(enclTyp, cc, nm, argtys, retty,minst) + MethodData(enclTyp, cc, nm, argtys, retty, minst) -and seekReadCustomAttrType ctxt (TaggedIndex(tag,idx) ) = +and seekReadCustomAttrType ctxt (TaggedIndex(tag, idx) ) = match tag with | tag when tag = cat_MethodDef -> let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx @@ -1905,7 +1905,7 @@ and seekReadCustomAttrType ctxt (TaggedIndex(tag,idx) ) = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst) | _ -> failwith "seekReadCustomAttrType ctxt" -and seekReadImplAsScopeRef ctxt (TaggedIndex(tag,idx) ) = +and seekReadImplAsScopeRef ctxt (TaggedIndex(tag, idx) ) = if idx = 0 then ILScopeRef.Local else match tag with @@ -1914,14 +1914,14 @@ and seekReadImplAsScopeRef ctxt (TaggedIndex(tag,idx) ) = | tag when tag = i_ExportedType -> failwith "seekReadImplAsScopeRef ctxt" | _ -> failwith "seekReadImplAsScopeRef ctxt" -and seekReadTypeRefScope ctxt (TaggedIndex(tag,idx) ) = +and seekReadTypeRefScope ctxt (TaggedIndex(tag, idx) ) = match tag with - | tag when tag = rs_Module -> ILScopeRef.Local,[] - | tag when tag = rs_ModuleRef -> ILScopeRef.Module (seekReadModuleRef ctxt idx),[] - | tag when tag = rs_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx),[] + | tag when tag = rs_Module -> ILScopeRef.Local, [] + | tag when tag = rs_ModuleRef -> ILScopeRef.Module (seekReadModuleRef ctxt idx), [] + | tag when tag = rs_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx), [] | tag when tag = rs_TypeRef -> let tref = seekReadTypeRef ctxt idx - tref.Scope,(tref.Enclosing@[tref.Name]) + tref.Scope, (tref.Enclosing@[tref.Name]) | _ -> failwith "seekReadTypeRefScope ctxt" and seekReadOptionalTypeDefOrRef ctxt numtypars boxity idx = @@ -1929,7 +1929,7 @@ and seekReadOptionalTypeDefOrRef ctxt numtypars boxity idx = else Some (seekReadTypeDefOrRef ctxt numtypars boxity List.empty idx) and seekReadField ctxt (numtypars, hasLayout) (idx:int) = - let (flags,nameIdx,typeIdx) = seekReadFieldRow ctxt idx + let (flags, nameIdx, typeIdx) = seekReadFieldRow ctxt idx let nm = readStringHeap ctxt nameIdx let isStatic = (flags &&& 0x0010) <> 0 let fd = @@ -1941,24 +1941,24 @@ and seekReadField ctxt (numtypars, hasLayout) (idx:int) = IsLiteral = (flags &&& 0x0040) <> 0 NotSerialized = (flags &&& 0x0080) <> 0 IsSpecialName = (flags &&& 0x0200) <> 0 || (flags &&& 0x0400) <> 0 (* REVIEW: RTSpecialName *) - LiteralValue = if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef,idx))) + LiteralValue = if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef, idx))) Marshal = if (flags &&& 0x1000) = 0 then None else - Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal,seekReadFieldMarshalRow ctxt, - fst,hfmCompare (TaggedIndex(hfm_FieldDef,idx)), - isSorted ctxt TableNames.FieldMarshal, + Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt, + fst, hfmCompare (TaggedIndex(hfm_FieldDef, idx)), + isSorted ctxt TableNames.FieldMarshal, (snd >> readBlobHeapAsNativeType ctxt))) Data = if (flags &&& 0x0100) = 0 then None else - let rva = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldRVA,seekReadFieldRVARow ctxt, - snd,simpleIndexCompare idx,isSorted ctxt TableNames.FieldRVA,fst) + let rva = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldRVA, seekReadFieldRVARow ctxt, + snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldRVA, fst) Some (rvaToData ctxt "field" rva) Offset = if hasLayout && not isStatic then - Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout,seekReadFieldLayoutRow ctxt, - snd,simpleIndexCompare idx,isSorted ctxt TableNames.FieldLayout,fst)) else None - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_FieldDef,idx)) } + Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout, seekReadFieldLayoutRow ctxt, + snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldLayout, fst)) else None + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_FieldDef, idx)) } fd and seekReadFields ctxt (numtypars, hasLayout) fidx1 fidx2 = @@ -1975,12 +1975,12 @@ and seekReadMethods ctxt numtypars midx1 midx2 = and sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr = let n, sigptr = sigptrGetZInt32 bytes sigptr if (n &&& 0x01) = 0x0 then (* Type Def *) - TaggedIndex(tdor_TypeDef, (n >>>& 2)), sigptr + TaggedIndex(tdor_TypeDef, (n >>>& 2)), sigptr else (* Type Ref *) - TaggedIndex(tdor_TypeRef, (n >>>& 2)), sigptr + TaggedIndex(tdor_TypeRef, (n >>>& 2)), sigptr and sigptrGetTy ctxt numtypars bytes sigptr = - let b0,sigptr = sigptrGetByte bytes sigptr + let b0, sigptr = sigptrGetByte bytes 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 @@ -1998,11 +1998,11 @@ and sigptrGetTy ctxt numtypars bytes sigptr = elif b0 = et_CHAR then ctxt.ilg.typ_Char, sigptr elif b0 = et_BOOLEAN then ctxt.ilg.typ_Bool, sigptr elif b0 = et_WITH then - let b0,sigptr = sigptrGetByte bytes sigptr + let b0, sigptr = sigptrGetByte bytes sigptr let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr let n, sigptr = sigptrGetZInt32 bytes sigptr - let argtys,sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr - seekReadTypeDefOrRef ctxt numtypars (if b0 = et_CLASS then AsObject else AsValue) argtys tdorIdx, + let argtys, sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr + seekReadTypeDefOrRef ctxt numtypars (if b0 = et_CLASS then AsObject else AsValue) argtys tdorIdx, sigptr elif b0 = et_CLASS then @@ -2013,7 +2013,7 @@ and sigptrGetTy ctxt numtypars bytes sigptr = seekReadTypeDefOrRef ctxt numtypars AsValue List.empty tdorIdx, sigptr elif b0 = et_VAR then let n, sigptr = sigptrGetZInt32 bytes sigptr - ILType.TypeVar (uint16 n),sigptr + ILType.TypeVar (uint16 n), sigptr elif b0 = et_MVAR then let n, sigptr = sigptrGetZInt32 bytes sigptr ILType.TypeVar (uint16 (n + numtypars)), sigptr @@ -2035,31 +2035,31 @@ and sigptrGetTy ctxt 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 < numLoBounded then Some (List.item i lobounds) else None), (if i < numSized then Some (List.item i sizes) else None) ILArrayShape (Array.toList (Array.init rank dim)) mkILArrTy (typ, shape), sigptr elif b0 = et_VOID then ILType.Void, sigptr elif b0 = et_TYPEDBYREF then - let t = mkILNonGenericValueTy(mkILTyRef(ctxt.ilg.primaryAssemblyScopeRef,"System.TypedReference")) + let t = mkILNonGenericValueTy(mkILTyRef(ctxt.ilg.primaryAssemblyScopeRef, "System.TypedReference")) t, sigptr elif b0 = et_CMOD_REQD || b0 = et_CMOD_OPT then let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr let typ, sigptr = sigptrGetTy ctxt numtypars bytes sigptr ILType.Modified((b0 = et_CMOD_REQD), seekReadTypeDefOrRefAsTypeRef ctxt tdorIdx, typ), sigptr elif b0 = et_FNPTR then - let ccByte,sigptr = sigptrGetByte bytes sigptr - let generic,cc = byteAsCallConv ccByte + let ccByte, sigptr = sigptrGetByte bytes sigptr + let generic, cc = byteAsCallConv ccByte if generic then failwith "fptr sig may not be generic" - let numparams,sigptr = sigptrGetZInt32 bytes sigptr - let retty,sigptr = sigptrGetTy ctxt numtypars bytes sigptr - let argtys,sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) 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 + , sigptr elif b0 = et_SENTINEL then failwith "varargs NYI" else ILType.Void , sigptr @@ -2067,18 +2067,18 @@ and sigptrGetVarArgTys ctxt n numtypars bytes sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr and sigptrGetArgTys ctxt n numtypars bytes sigptr acc = - if n <= 0 then (List.rev acc,None),sigptr + if n <= 0 then (List.rev acc, None), sigptr else - let b0,sigptr2 = sigptrGetByte bytes sigptr + let b0, sigptr2 = sigptrGetByte bytes sigptr if b0 = et_SENTINEL then - let varargs,sigptr = sigptrGetVarArgTys ctxt n numtypars bytes sigptr2 - (List.rev acc,Some(varargs)),sigptr + let varargs, sigptr = sigptrGetVarArgTys ctxt n numtypars bytes sigptr2 + (List.rev acc, Some(varargs)), sigptr else - let x,sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let x, sigptr = sigptrGetTy ctxt numtypars bytes sigptr sigptrGetArgTys ctxt (n-1) numtypars bytes sigptr (x::acc) and sigptrGetLocal ctxt numtypars bytes sigptr = - let pinned,sigptr = + let pinned, sigptr = let b0, sigptr' = sigptrGetByte bytes sigptr if b0 = et_PINNED then true, sigptr' @@ -2089,64 +2089,64 @@ and sigptrGetLocal ctxt numtypars bytes sigptr = loc, sigptr and readBlobHeapAsMethodSig ctxt numtypars blobIdx = - ctxt.readBlobHeapAsMethodSig (BlobAsMethodSigIdx (numtypars,blobIdx)) + ctxt.readBlobHeapAsMethodSig (BlobAsMethodSigIdx (numtypars, blobIdx)) -and readBlobHeapAsMethodSigUncached ctxtH (BlobAsMethodSigIdx (numtypars,blobIdx)) = +and readBlobHeapAsMethodSigUncached ctxtH (BlobAsMethodSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr - let generic,cc = byteAsCallConv ccByte - let genarity,sigptr = if generic then sigptrGetZInt32 bytes sigptr else 0x0,sigptr - let numparams,sigptr = sigptrGetZInt32 bytes sigptr - let retty,sigptr = sigptrGetTy ctxt numtypars bytes sigptr - let (argtys,varargs),_sigptr = sigptrGetArgTys ctxt ( numparams) numtypars bytes sigptr [] - generic,genarity,cc,retty,argtys,varargs + let ccByte, sigptr = sigptrGetByte bytes sigptr + let generic, cc = byteAsCallConv ccByte + let genarity, sigptr = if generic then sigptrGetZInt32 bytes sigptr else 0x0, sigptr + let numparams, sigptr = sigptrGetZInt32 bytes sigptr + let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let (argtys, varargs), _sigptr = sigptrGetArgTys ctxt ( numparams) numtypars bytes sigptr [] + generic, genarity, cc, retty, argtys, varargs and readBlobHeapAsType ctxt numtypars blobIdx = let bytes = readBlobHeap ctxt blobIdx - let ty,_sigptr = sigptrGetTy ctxt numtypars bytes 0 + let ty, _sigptr = sigptrGetTy ctxt numtypars bytes 0 ty and readBlobHeapAsFieldSig ctxt numtypars blobIdx = - ctxt.readBlobHeapAsFieldSig (BlobAsFieldSigIdx (numtypars,blobIdx)) + ctxt.readBlobHeapAsFieldSig (BlobAsFieldSigIdx (numtypars, blobIdx)) -and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars,blobIdx)) = +and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr + let ccByte, sigptr = sigptrGetByte bytes sigptr if ccByte <> e_IMAGE_CEE_CS_CALLCONV_FIELD then dprintn "warning: field sig was not CC_FIELD" - let retty,_sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let retty, _sigptr = sigptrGetTy ctxt numtypars bytes sigptr retty and readBlobHeapAsPropertySig ctxt numtypars blobIdx = - ctxt.readBlobHeapAsPropertySig (BlobAsPropSigIdx (numtypars,blobIdx)) -and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars,blobIdx)) = + ctxt.readBlobHeapAsPropertySig (BlobAsPropSigIdx (numtypars, blobIdx)) +and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr + let ccByte, sigptr = sigptrGetByte bytes sigptr let hasthis = byteAsHasThis ccByte let ccMaxked = (ccByte &&& 0x0Fuy) if ccMaxked <> e_IMAGE_CEE_CS_CALLCONV_PROPERTY then dprintn ("warning: property sig was "+string ccMaxked+" instead of CC_PROPERTY") - let numparams,sigptr = sigptrGetZInt32 bytes sigptr - let retty,sigptr = sigptrGetTy ctxt numtypars bytes sigptr - let argtys,_sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr - hasthis,retty,argtys + let numparams, sigptr = sigptrGetZInt32 bytes sigptr + let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr + hasthis, retty, argtys and readBlobHeapAsLocalsSig ctxt numtypars blobIdx = - ctxt.readBlobHeapAsLocalsSig (BlobAsLocalSigIdx (numtypars,blobIdx)) + ctxt.readBlobHeapAsLocalsSig (BlobAsLocalSigIdx (numtypars, blobIdx)) -and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars,blobIdx)) = +and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr + let ccByte, sigptr = sigptrGetByte bytes sigptr if ccByte <> e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG then dprintn "warning: local sig was not CC_LOCAL" - let numlocals,sigptr = sigptrGetZInt32 bytes sigptr - let localtys,_sigptr = sigptrFold (sigptrGetLocal ctxt numtypars) ( numlocals) bytes sigptr + let numlocals, sigptr = sigptrGetZInt32 bytes sigptr + let localtys, _sigptr = sigptrFold (sigptrGetLocal ctxt numtypars) ( numlocals) bytes sigptr localtys and byteAsHasThis b = @@ -2165,45 +2165,45 @@ and byteAsCallConv b = elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_VARARG then ILArgConvention.VarArg else ILArgConvention.Default let generic = (b &&& e_IMAGE_CEE_CS_CALLCONV_GENERIC) <> 0x0uy - generic, Callconv (byteAsHasThis b,cc) + generic, Callconv (byteAsHasThis b, cc) and seekReadMemberRefAsMethodData ctxt numtypars idx : VarArgMethodData = - ctxt.seekReadMemberRefAsMethodData (MemberRefAsMspecIdx (numtypars,idx)) -and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars,idx)) = + ctxt.seekReadMemberRefAsMethodData (MemberRefAsMspecIdx (numtypars, idx)) +and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars, idx)) = let ctxt = getHole ctxtH - let (mrpIdx,nameIdx,typeIdx) = seekReadMemberRefRow ctxt idx + let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt idx let nm = readStringHeap ctxt nameIdx let enclTyp = seekReadMethodRefParent ctxt numtypars mrpIdx - let _generic,genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt enclTyp.GenericArgs.Length typeIdx + let _generic, genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt enclTyp.GenericArgs.Length typeIdx let minst = List.init genarity (fun n -> mkILTyvarTy (uint16 (numtypars+n))) - (VarArgMethodData(enclTyp, cc, nm, argtys, varargs,retty,minst)) + (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx : MethodData = - let (VarArgMethodData(enclTyp, cc, nm, argtys,varargs, retty,minst)) = seekReadMemberRefAsMethodData ctxt numtypars idx + let (VarArgMethodData(enclTyp, 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(enclTyp, cc, nm, argtys, retty,minst)) + (MethodData(enclTyp, cc, nm, argtys, retty, minst)) and seekReadMethodSpecAsMethodData ctxt numtypars idx = - ctxt.seekReadMethodSpecAsMethodData (MethodSpecAsMspecIdx (numtypars,idx)) -and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypars,idx)) = + ctxt.seekReadMethodSpecAsMethodData (MethodSpecAsMspecIdx (numtypars, idx)) +and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypars, idx)) = let ctxt = getHole ctxtH - let (mdorIdx,instIdx) = seekReadMethodSpecRow ctxt idx - let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs,retty,_)) = seekReadMethodDefOrRef ctxt numtypars mdorIdx + let (mdorIdx, instIdx) = seekReadMethodSpecRow ctxt idx + let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, _)) = seekReadMethodDefOrRef ctxt numtypars mdorIdx let minst = let bytes = readBlobHeap ctxt instIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr + let ccByte, sigptr = sigptrGetByte bytes sigptr if ccByte <> e_IMAGE_CEE_CS_CALLCONV_GENERICINST then dprintn ("warning: method inst ILCallingConv was "+string ccByte+" instead of CC_GENERICINST") - let numgpars,sigptr = sigptrGetZInt32 bytes sigptr - let argtys,_sigptr = sigptrFold (sigptrGetTy ctxt numtypars) numgpars bytes sigptr + let numgpars, sigptr = sigptrGetZInt32 bytes sigptr + let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) numgpars bytes sigptr argtys - VarArgMethodData(enclTyp, cc, nm, argtys, varargs,retty, minst) + VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst) and seekReadMemberRefAsFieldSpec ctxt numtypars idx = - ctxt.seekReadMemberRefAsFieldSpec (MemberRefAsFspecIdx (numtypars,idx)) -and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars,idx)) = + ctxt.seekReadMemberRefAsFieldSpec (MemberRefAsFspecIdx (numtypars, idx)) +and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars, idx)) = let ctxt = getHole ctxtH - let (mrpIdx,nameIdx,typeIdx) = seekReadMemberRefRow ctxt idx + let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt idx let nm = readStringHeap ctxt nameIdx let enclTyp = seekReadMethodRefParent ctxt numtypars mrpIdx let retty = readBlobHeapAsFieldSig ctxt numtypars typeIdx @@ -2221,15 +2221,15 @@ and seekReadMethodDefAsMethodDataUncached ctxtH idx = let ctxt = getHole ctxtH // Look for the method def parent. let tidx = - seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, - (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), - (fun r -> r), - (fun (_,((_, _, _, _, _, methodsIdx), + seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, + (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), + (fun r -> r), + (fun (_, ((_, _, _, _, _, methodsIdx), (_, endMethodsIdx))) -> if endMethodsIdx <= idx then 1 elif methodsIdx <= idx && idx < endMethodsIdx then 0 - else -1), - true,fst) + else -1), + true, fst) // Create a formal instantiation if needed let typeGenericArgs = seekReadGenericParams ctxt 0 (tomd_TypeDef, tidx) let typeGenericArgsCount = typeGenericArgs.Length @@ -2246,7 +2246,7 @@ and seekReadMethodDefAsMethodDataUncached ctxtH idx = let nm = readStringHeap ctxt nameIdx // Read the method def signature. - let _generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt typeGenericArgsCount typeIdx + let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt typeGenericArgsCount typeIdx if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" MethodData(enclTyp, cc, nm, argtys, retty, minst) @@ -2261,18 +2261,18 @@ and seekReadFieldDefAsFieldSpecUncached ctxtH idx = let nm = readStringHeap ctxt nameIdx (* Look for the field def parent. *) let tidx = - seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, - (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), - (fun r -> r), - (fun (_,((_, _, _, _, fieldsIdx, _),(endFieldsIdx, _))) -> + seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, + (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), + (fun r -> r), + (fun (_, ((_, _, _, _, fieldsIdx, _), (endFieldsIdx, _))) -> if endFieldsIdx <= idx then 1 elif fieldsIdx <= idx && idx < endFieldsIdx then 0 - else -1), - true,fst) + else -1), + true, fst) // Read the field signature. let retty = readBlobHeapAsFieldSig ctxt 0 typeIdx // Create a formal instantiation if needed - let finst = mkILFormalGenericArgs 0 (seekReadGenericParams ctxt 0 (tomd_TypeDef,tidx)) + let finst = mkILFormalGenericArgs 0 (seekReadGenericParams ctxt 0 (tomd_TypeDef, tidx)) // Read the field def parent. let enclTyp = seekReadTypeDefAsType ctxt AsObject (* not ok: see note *) finst tidx // Put it together. @@ -2305,17 +2305,17 @@ and seekReadMethod ctxt numtypars (idx:int) = let mustrun = (implflags &&& 0x0040) <> 0x0 let cctor = (nm = ".cctor") let ctor = (nm = ".ctor") - let _generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt numtypars typeIdx + let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt numtypars typeIdx if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef signature" let endParamIdx = if idx >= ctxt.getNumRows TableNames.Method then ctxt.getNumRows TableNames.Param + 1 else - let (_,_,_,_,_, paramIdx) = seekReadMethodRow ctxt (idx + 1) + let (_, _, _, _, _, paramIdx) = seekReadMethodRow ctxt (idx + 1) paramIdx - let ret,ilParams = seekReadParams ctxt (retty,argtys) paramIdx endParamIdx + let ret, ilParams = seekReadParams ctxt (retty, argtys) paramIdx endParamIdx { Name=nm mdKind = @@ -2330,7 +2330,7 @@ and seekReadMethod ctxt numtypars (idx:int) = IsAbstract=abstr } else MethodKind.NonVirtual) Access = memberAccessOfFlags flags - SecurityDecls=seekReadSecurityDecls ctxt (TaggedIndex(hds_MethodDef,idx)) + SecurityDecls=seekReadSecurityDecls ctxt (TaggedIndex(hds_MethodDef, idx)) HasSecurity=hassec IsEntryPoint= (fst ctxt.entryPointToken = TableNames.Method && snd ctxt.entryPointToken = idx) IsReqSecObj=reqsecobj @@ -2346,8 +2346,8 @@ and seekReadMethod ctxt numtypars (idx:int) = IsInternalCall = internalcall IsForwardRef = forwardref mdCodeKind = (if (codetype = 0x00) then MethodCodeKind.IL elif (codetype = 0x01) then MethodCodeKind.Native elif (codetype = 0x03) then MethodCodeKind.Runtime else MethodCodeKind.Native) - GenericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef,idx) - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_MethodDef,idx)) + GenericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef, idx) + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_MethodDef, idx)) Parameters= ilParams CallingConv=cc Return=ret @@ -2360,11 +2360,11 @@ and seekReadMethod ctxt numtypars (idx:int) = //if codeRVA <> 0x0 then dprintn "non-IL or abstract method with non-zero RVA" mkMethBodyLazyAux (notlazy MethodBody.Abstract) else - seekReadMethodRVA ctxt (idx,nm,internalcall,noinline,aggressiveinline,numtypars) codeRVA + seekReadMethodRVA ctxt (idx, nm, internalcall, noinline, aggressiveinline, numtypars) codeRVA } -and seekReadParams ctxt (retty,argtys) pidx1 pidx2 = +and seekReadParams ctxt (retty, argtys) pidx1 pidx2 = let retRes : ILReturn ref = ref { Marshal=None; Type=retty; CustomAttrs=emptyILCustomAttrs } let paramsRes : ILParameter [] = argtys @@ -2379,26 +2379,26 @@ and seekReadParams ctxt (retty,argtys) pidx1 pidx2 = Type=ty CustomAttrs=emptyILCustomAttrs }) for i = pidx1 to pidx2 - 1 do - seekReadParamExtras ctxt (retRes,paramsRes) i + seekReadParamExtras ctxt (retRes, paramsRes) i !retRes, List.ofArray paramsRes -and seekReadParamExtras ctxt (retRes,paramsRes) (idx:int) = - let (flags,seq,nameIdx) = seekReadParamRow ctxt idx +and seekReadParamExtras ctxt (retRes, paramsRes) (idx:int) = + let (flags, seq, nameIdx) = seekReadParamRow ctxt idx let inOutMasked = (flags &&& 0x00FF) let hasMarshal = (flags &&& 0x2000) <> 0x0 let hasDefault = (flags &&& 0x1000) <> 0x0 - let fmReader idx = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal,seekReadFieldMarshalRow ctxt,fst,hfmCompare idx,isSorted ctxt TableNames.FieldMarshal,(snd >> readBlobHeapAsNativeType ctxt)) - let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_ParamDef,idx)) + let fmReader idx = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt, fst, hfmCompare idx, isSorted ctxt TableNames.FieldMarshal, (snd >> readBlobHeapAsNativeType ctxt)) + let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_ParamDef, idx)) if seq = 0 then retRes := { !retRes with - Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef,idx))) else None) + Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None) CustomAttrs = cas } elif seq > Array.length paramsRes then dprintn "bad seq num. for param" else paramsRes.[seq - 1] <- { paramsRes.[seq - 1] with - Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef,idx))) else None) - Default = (if hasDefault then Some (seekReadConstant ctxt (TaggedIndex(hc_ParamDef,idx))) else None) + Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None) + Default = (if hasDefault then Some (seekReadConstant ctxt (TaggedIndex(hc_ParamDef, idx))) else None) Name = readStringHeapOption ctxt nameIdx IsIn = ((inOutMasked &&& 0x0001) <> 0x0) IsOut = ((inOutMasked &&& 0x0002) <> 0x0) @@ -2408,27 +2408,27 @@ and seekReadParamExtras ctxt (retRes,paramsRes) (idx:int) = and seekReadMethodImpls ctxt numtypars tidx = mkILMethodImplsLazy (lazy - let mimpls = seekReadIndexedRows (ctxt.getNumRows TableNames.MethodImpl,seekReadMethodImplRow ctxt,(fun (a,_,_) -> a),simpleIndexCompare tidx,isSorted ctxt TableNames.MethodImpl,(fun (_,b,c) -> b,c)) - mimpls |> List.map (fun (b,c) -> + let mimpls = seekReadIndexedRows (ctxt.getNumRows TableNames.MethodImpl, seekReadMethodImplRow ctxt, (fun (a, _, _) -> a), simpleIndexCompare tidx, isSorted ctxt TableNames.MethodImpl, (fun (_, b, c) -> b, c)) + mimpls |> List.map (fun (b, c) -> { OverrideBy= - let (MethodData(enclTyp, cc, nm, argtys, retty,minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars b - mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty,minst) + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars b + mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst) Overrides= - let (MethodData(enclTyp, cc, nm, argtys, retty,minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars c - let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty,minst) + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars c + let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst) OverridesSpec(mspec.MethodRef, mspec.EnclosingType) })) -and seekReadMultipleMethodSemantics ctxt (flags,id) = +and seekReadMultipleMethodSemantics ctxt (flags, id) = seekReadIndexedRows - (ctxt.getNumRows TableNames.MethodSemantics , - seekReadMethodSemanticsRow ctxt, - (fun (_flags,_,c) -> c), - hsCompare id, - isSorted ctxt TableNames.MethodSemantics, - (fun (a,b,_c) -> + (ctxt.getNumRows TableNames.MethodSemantics , + seekReadMethodSemanticsRow ctxt, + (fun (_flags, _, c) -> c), + hsCompare id, + isSorted ctxt TableNames.MethodSemantics, + (fun (a, b, _c) -> let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt b a, (mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)).MethodRef)) - |> List.filter (fun (flags2,_) -> flags = flags2) + |> List.filter (fun (flags2, _) -> flags = flags2) |> List.map snd @@ -2444,24 +2444,24 @@ and seekReadMethodSemantics ctxt id = | Some x -> x and seekReadEvent ctxt numtypars idx = - let (flags,nameIdx,typIdx) = seekReadEventRow ctxt idx + let (flags, nameIdx, typIdx) = seekReadEventRow ctxt idx { Name = readStringHeap ctxt nameIdx Type = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx IsSpecialName = (flags &&& 0x0200) <> 0x0 IsRTSpecialName = (flags &&& 0x0400) <> 0x0 - AddMethod= seekReadMethodSemantics ctxt (0x0008,TaggedIndex(hs_Event, idx)) - RemoveMethod=seekReadMethodSemantics ctxt (0x0010,TaggedIndex(hs_Event,idx)) - FireMethod=seekReadoptional_MethodSemantics ctxt (0x0020,TaggedIndex(hs_Event,idx)) + AddMethod= seekReadMethodSemantics ctxt (0x0008, TaggedIndex(hs_Event, idx)) + RemoveMethod=seekReadMethodSemantics ctxt (0x0010, TaggedIndex(hs_Event, idx)) + FireMethod=seekReadoptional_MethodSemantics ctxt (0x0020, TaggedIndex(hs_Event, idx)) OtherMethods = seekReadMultipleMethodSemantics ctxt (0x0004, TaggedIndex(hs_Event, idx)) - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Event,idx)) } + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Event, idx)) } (* REVIEW: can substantially reduce numbers of EventMap and PropertyMap reads by first checking if the whole table is sorted according to ILTypeDef tokens and then doing a binary chop *) and seekReadEvents ctxt numtypars tidx = mkILEventsLazy (lazy - match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.EventMap,(fun i -> i, seekReadEventMapRow ctxt i),(fun (_,row) -> fst row),compare tidx,false,(fun (i,row) -> (i,snd row))) with + match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.EventMap, (fun i -> i, seekReadEventMapRow ctxt i), (fun (_, row) -> fst row), compare tidx, false, (fun (i, row) -> (i, snd row))) with | None -> [] - | Some (rowNum,beginEventIdx) -> + | Some (rowNum, beginEventIdx) -> let endEventIdx = if rowNum >= ctxt.getNumRows TableNames.EventMap then ctxt.getNumRows TableNames.Event + 1 @@ -2473,10 +2473,10 @@ and seekReadEvents ctxt numtypars tidx = yield seekReadEvent ctxt numtypars i ]) and seekReadProperty ctxt numtypars idx = - let (flags,nameIdx,typIdx) = seekReadPropertyRow ctxt idx - let cc,retty,argtys = readBlobHeapAsPropertySig ctxt numtypars typIdx - let setter= seekReadoptional_MethodSemantics ctxt (0x0001,TaggedIndex(hs_Property,idx)) - let getter = seekReadoptional_MethodSemantics ctxt (0x0002,TaggedIndex(hs_Property,idx)) + let (flags, nameIdx, typIdx) = seekReadPropertyRow ctxt idx + let cc, retty, argtys = readBlobHeapAsPropertySig ctxt numtypars typIdx + let setter= seekReadoptional_MethodSemantics ctxt (0x0001, TaggedIndex(hs_Property, idx)) + let getter = seekReadoptional_MethodSemantics ctxt (0x0002, TaggedIndex(hs_Property, idx)) (* NOTE: the "ThisConv" value on the property is not reliable: better to look on the getter/setter *) (* NOTE: e.g. tlbimp on Office msword.olb seems to set this incorrectly *) let cc2 = @@ -2493,16 +2493,16 @@ and seekReadProperty ctxt numtypars idx = SetMethod=setter GetMethod=getter Type=retty - Init= if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property,idx))) + Init= if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property, idx))) Args=argtys - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Property,idx)) } + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Property, idx)) } and seekReadProperties ctxt numtypars tidx = mkILPropertiesLazy (lazy - match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.PropertyMap,(fun i -> i, seekReadPropertyMapRow ctxt i),(fun (_,row) -> fst row),compare tidx,false,(fun (i,row) -> (i,snd row))) with + match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.PropertyMap, (fun i -> i, seekReadPropertyMapRow ctxt i), (fun (_, row) -> fst row), compare tidx, false, (fun (i, row) -> (i, snd row))) with | None -> [] - | Some (rowNum,beginPropIdx) -> + | Some (rowNum, beginPropIdx) -> let endPropIdx = if rowNum >= ctxt.getNumRows TableNames.PropertyMap then ctxt.getNumRows TableNames.Property + 1 @@ -2516,19 +2516,19 @@ and seekReadProperties ctxt numtypars tidx = and seekReadCustomAttrs ctxt idx = mkILComputedCustomAttrs (fun () -> - seekReadIndexedRows (ctxt.getNumRows TableNames.CustomAttribute, - seekReadCustomAttributeRow ctxt,(fun (a,_,_) -> a), - hcaCompare idx, - isSorted ctxt TableNames.CustomAttribute, - (fun (_,b,c) -> seekReadCustomAttr ctxt (b,c))) + seekReadIndexedRows (ctxt.getNumRows TableNames.CustomAttribute, + seekReadCustomAttributeRow ctxt, (fun (a, _, _) -> a), + hcaCompare idx, + isSorted ctxt TableNames.CustomAttribute, + (fun (_, b, c) -> seekReadCustomAttr ctxt (b, c))) |> List.toArray) -and seekReadCustomAttr ctxt (TaggedIndex(cat,idx),b) = - ctxt.seekReadCustomAttr (CustomAttrIdx (cat,idx,b)) +and seekReadCustomAttr ctxt (TaggedIndex(cat, idx), b) = + ctxt.seekReadCustomAttr (CustomAttrIdx (cat, idx, b)) -and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat,idx,valIdx)) = +and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat, idx, valIdx)) = let ctxt = getHole ctxtH - { Method=seekReadCustomAttrType ctxt (TaggedIndex(cat,idx)) + { Method=seekReadCustomAttrType ctxt (TaggedIndex(cat, idx)) Data= match readBlobHeapOption ctxt valIdx with | Some bytes -> bytes @@ -2538,27 +2538,27 @@ and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat,idx,valIdx)) = and seekReadSecurityDecls ctxt idx = mkILLazySecurityDecls (lazy - seekReadIndexedRows (ctxt.getNumRows TableNames.Permission, - seekReadPermissionRow ctxt, - (fun (_,par,_) -> par), - hdsCompare idx, - isSorted ctxt TableNames.Permission, - (fun (act,_,ty) -> seekReadSecurityDecl ctxt (act,ty)))) + seekReadIndexedRows (ctxt.getNumRows TableNames.Permission, + seekReadPermissionRow ctxt, + (fun (_, par, _) -> par), + hdsCompare idx, + isSorted ctxt TableNames.Permission, + (fun (act, _, ty) -> seekReadSecurityDecl ctxt (act, ty)))) -and seekReadSecurityDecl ctxt (a,b) = - ctxt.seekReadSecurityDecl (SecurityDeclIdx (a,b)) +and seekReadSecurityDecl ctxt (a, b) = + ctxt.seekReadSecurityDecl (SecurityDeclIdx (a, b)) -and seekReadSecurityDeclUncached ctxtH (SecurityDeclIdx (act,ty)) = +and seekReadSecurityDeclUncached ctxtH (SecurityDeclIdx (act, ty)) = let ctxt = getHole ctxtH - PermissionSet ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"), + PermissionSet ((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 idx = - let kind,vidx = seekReadIndexedRow (ctxt.getNumRows TableNames.Constant, - seekReadConstantRow ctxt, - (fun (_,key,_) -> key), - hcCompare idx,isSorted ctxt TableNames.Constant,(fun (kind,_,v) -> kind,v)) + let kind, vidx = seekReadIndexedRow (ctxt.getNumRows TableNames.Constant, + seekReadConstantRow ctxt, + (fun (_, key, _) -> key), + hcCompare idx, isSorted ctxt TableNames.Constant, (fun (kind, _, v) -> kind, v)) match kind with | x when x = uint16 et_STRING -> let blobHeap = readBlobHeap ctxt vidx @@ -2582,12 +2582,12 @@ and seekReadConstant ctxt idx = and seekReadImplMap ctxt nm midx = mkMethBodyLazyAux (lazy - let (flags,nameIdx, scopeIdx) = seekReadIndexedRow (ctxt.getNumRows TableNames.ImplMap, - seekReadImplMapRow ctxt, - (fun (_,m,_,_) -> m), - mfCompare (TaggedIndex(mf_MethodDef,midx)), - isSorted ctxt TableNames.ImplMap, - (fun (a,_,c,d) -> a,c,d)) + let (flags, nameIdx, scopeIdx) = seekReadIndexedRow (ctxt.getNumRows TableNames.ImplMap, + seekReadImplMapRow ctxt, + (fun (_, m, _, _) -> m), + mfCompare (TaggedIndex(mf_MethodDef, midx)), + isSorted ctxt TableNames.ImplMap, + (fun (a, _, c, d) -> a, c, d)) let cc = let masked = flags &&& 0x0700 if masked = 0x0000 then PInvokeCallingConvention.None @@ -2630,8 +2630,8 @@ and seekReadImplMap ctxt nm midx = Where = seekReadModuleRef ctxt scopeIdx }) and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = - let labelsOfRawOffsets = new Dictionary<_,_>(sz/2) - let ilOffsetsOfLabels = new Dictionary<_,_>(sz/2) + let labelsOfRawOffsets = new Dictionary<_, _>(sz/2) + let ilOffsetsOfLabels = new Dictionary<_, _>(sz/2) let tryRawToLabel rawOffset = if labelsOfRawOffsets.ContainsKey rawOffset then Some(labelsOfRawOffsets.[rawOffset]) @@ -2676,11 +2676,11 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = // 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 - let (_,tag) = List.head !seqPointsRemaining + let (_, tag) = List.head !seqPointsRemaining seqPointsRemaining := List.tail !seqPointsRemaining ibuf.Add (I_seqpoint tag) @@ -2759,7 +2759,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = curr := !curr + 8 f prefixes x | I_field_instr f -> - let (tab,tok) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, tok) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 let fspec = if tab = TableNames.Field then @@ -2771,7 +2771,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = | I_method_instr f -> // method instruction, curr = "+string !curr - let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, idx) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) = if tab = TableNames.Method then @@ -2782,23 +2782,23 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = seekReadMethodSpecAsMethodData ctxt numtypars idx else failwith "bad table in MethodDefOrRefOrSpec" match enclTyp with - | ILType.Array (shape,ty) -> + | 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) + | "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) | _ -> failwith "bad method on array type" | _ -> let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst) - f prefixes (mspec,varargs) + f prefixes (mspec, varargs) | I_type_instr f -> let uncoded = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 let typ = seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec uncoded) f prefixes typ | I_string_instr f -> - let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, idx) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 if tab <> TableNames.UserStrings then dprintn "warning: bad table in user string for ldstr" f prefixes (readUserStringHeap ctxt (idx)) @@ -2824,29 +2824,29 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = let dest = !curr + offsDest f prefixes (rawToLabel dest) | I_invalid_instr -> - dprintn ("invalid instruction: "+string !lastb+ (if !lastb = 0xfe then ","+string !lastb2 else "")) + dprintn ("invalid instruction: "+string !lastb+ (if !lastb = 0xfe then ", "+string !lastb2 else "")) I_ret | I_tok_instr f -> - let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, idx) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 (* REVIEW: this incorrectly labels all MemberRef tokens as ILMethod's: we should go look at the MemberRef sig to determine if it is a field or method *) let token_info = if tab = TableNames.Method || tab = TableNames.MemberRef (* REVIEW:generics or tab = TableNames.MethodSpec *) then - let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars (uncodedTokenToMethodDefOrRef (tab,idx)) + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars (uncodedTokenToMethodDefOrRef (tab, idx)) ILToken.ILMethod (mkILMethSpecInTy (enclTyp, 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 - ILToken.ILType (seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec (tab,idx))) + ILToken.ILType (seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec (tab, idx))) else failwith "bad token for ldtoken" f prefixes token_info | I_sig_instr f -> - let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, idx) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 if tab <> TableNames.StandAloneSig then dprintn "strange table for callsig token" - let generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt numtypars (seekReadStandAloneSigRow ctxt idx) + let generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt numtypars (seekReadStandAloneSigRow ctxt idx) if generic then failwith "bad image: a generic method signature ctxt.is begin used at a calli instruction" - f prefixes (mkILCallSig (cc,argtys,retty), varargs) + f prefixes (mkILCallSig (cc, argtys, retty), varargs) | I_switch_instr f -> let n = (seekReadInt32 ctxt.is (start + (!curr))) curr := !curr + 4 @@ -2877,12 +2877,12 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = 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 + instrs, rawToLabel, lab2pc, raw2nextLab #if FX_NO_PDB_READER -and seekReadMethodRVA ctxt (_idx,nm,_internalcall,noinline,aggressiveinline,numtypars) rva = +and seekReadMethodRVA ctxt (_idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva = #else -and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numtypars) rva = +and seekReadMethodRVA ctxt (idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva = #endif mkMethBodyLazyAux (lazy @@ -2905,61 +2905,61 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty 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 *) + (* 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 *) let sourcedoc = get_doc (pdbDocumentGetURL sp.pdbSeqPointDocument) let source = - ILSourceMarker.Create(document = sourcedoc, - line = sp.pdbSeqPointLine, - column = sp.pdbSeqPointColumn, - endLine = sp.pdbSeqPointEndLine, + ILSourceMarker.Create(document = sourcedoc, + line = sp.pdbSeqPointLine, + column = sp.pdbSeqPointColumn, + endLine = sp.pdbSeqPointEndLine, endColumn = sp.pdbSeqPointEndColumn) - (sp.pdbSeqPointOffset,source)) + (sp.pdbSeqPointOffset, source)) Array.sortInPlaceBy fst arr Array.toList arr let rec scopes scp = - let a,b = pdbScopeGetOffsets scp + let a, b = pdbScopeGetOffsets scp let lvs = pdbScopeGetLocals scp let ilvs = lvs |> Array.toList |> List.filter (fun l -> - let k,_idx = pdbVariableGetAddressAttributes l + let k, _idx = pdbVariableGetAddressAttributes l k = 1 (* ADDR_IL_OFFSET *)) let ilinfos : ILLocalDebugMapping list = ilvs |> List.map (fun ilv -> - let _k,idx = pdbVariableGetAddressAttributes ilv + let _k, idx = pdbVariableGetAddressAttributes ilv let n = pdbVariableGetName ilv { LocalIndex= idx LocalName=n}) let thisOne = (fun raw2nextLab -> - { Range= (raw2nextLab a,raw2nextLab b) + { Range= (raw2nextLab a, raw2nextLab b) 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?? - (localPdbInfos,None,seqpoints) + (localPdbInfos, None, seqpoints) with e -> // "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message - [],None,[] + [], None, [] #endif - let baseRVA = ctxt.anyV2P("method rva",rva) + let baseRVA = ctxt.anyV2P("method rva", rva) // ": reading body of method "+nm+" at rva "+string rva+", phys "+string baseRVA let b = seekReadByte ctxt.is baseRVA if (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_TinyFormat then let codeBase = baseRVA + 1 let codeSize = (int32 b >>>& 2) // tiny format for "+nm+", code size = " + string codeSize) - let instrs,_,lab2pc,raw2nextLab = seekReadTopCode ctxt numtypars codeSize codeBase seqpoints + let instrs, _, lab2pc, raw2nextLab = seekReadTopCode ctxt numtypars codeSize codeBase seqpoints (* Convert the linear code format to the nested code format *) let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos let code = buildILCode nm lab2pc instrs [] localPdbInfos2 @@ -2977,7 +2977,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty let initlocals = (b &&& e_CorILMethod_InitLocals) <> 0x0uy let maxstack = seekReadUInt16AsInt32 ctxt.is (baseRVA + 2) let codeSize = seekReadInt32 ctxt.is (baseRVA + 4) - let localsTab,localToken = seekReadUncodedToken ctxt.is (baseRVA + 8) + let localsTab, localToken = seekReadUncodedToken ctxt.is (baseRVA + 8) let codeBase = baseRVA + 12 let locals = if localToken = 0x0 then [] @@ -2985,10 +2985,10 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty if localsTab <> TableNames.StandAloneSig then dprintn "strange table for locals token" readBlobHeapAsLocalsSig ctxt numtypars (seekReadStandAloneSigRow ctxt localToken) - // fat format for "+nm+", code size = " + string codeSize+", hasMoreSections = "+(if hasMoreSections then "true" else "false")+",b = "+string b) + // fat format for "+nm+", code size = " + string codeSize+", hasMoreSections = "+(if hasMoreSections then "true" else "false")+", b = "+string b) // Read the method body - let instrs,rawToLabel,lab2pc,raw2nextLab = seekReadTopCode ctxt numtypars ( codeSize) codeBase seqpoints + let instrs, rawToLabel, lab2pc, raw2nextLab = seekReadTopCode ctxt numtypars ( codeSize) codeBase seqpoints // Read all the sections that follow the method body. // These contain the exception clauses. @@ -3018,7 +3018,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty let st2 = seekReadInt32 ctxt.is (clauseBase + 12) let sz2 = seekReadInt32 ctxt.is (clauseBase + 16) let extra = seekReadInt32 ctxt.is (clauseBase + 20) - (kind,st1,sz1,st2,sz2,extra)) + (kind, st1, sz1, st2, sz2, extra)) else [] bigSize, clauses else @@ -3039,17 +3039,17 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty let st2 = seekReadUInt16AsInt32 ctxt.is (clauseBase + 5) let sz2 = seekReadByteAsInt32 ctxt.is (clauseBase + 7) let extra = seekReadInt32 ctxt.is (clauseBase + 8) - (kind,st1,sz1,st2,sz2,extra)) + (kind, st1, sz1, st2, sz2, extra)) else [] smallSize, clauses // Morph together clauses that cover the same range let sehClauses = - let sehMap = Dictionary<_,_>(clauses.Length, HashIdentity.Structural) + let sehMap = Dictionary<_, _>(clauses.Length, HashIdentity.Structural) List.iter - (fun (kind,st1,sz1,st2,sz2,extra) -> + (fun (kind, st1, sz1, st2, sz2, extra) -> let tryStart = rawToLabel st1 let tryFinish = rawToLabel (st1 + sz1) let handlerStart = rawToLabel st2 @@ -3077,7 +3077,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty else 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 @@ -3113,89 +3113,89 @@ and int32AsILVariantType ctxt (n:int32) = and readBlobHeapAsNativeType ctxt blobIdx = // reading native type blob "+string blobIdx) let bytes = readBlobHeap ctxt blobIdx - let res,_ = sigptrGetILNativeType ctxt bytes 0 + let res, _ = sigptrGetILNativeType ctxt bytes 0 res and sigptrGetILNativeType ctxt bytes sigptr = // reading native type blob, sigptr= "+string sigptr) - let ntbyte,sigptr = sigptrGetByte bytes sigptr + let ntbyte, sigptr = sigptrGetByte bytes sigptr if List.memAssoc ntbyte (Lazy.force ILNativeTypeMap) then 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) - let guidLen,sigptr = sigptrGetZInt32 bytes sigptr + let guidLen, sigptr = sigptrGetZInt32 bytes sigptr // reading native type blob (CM2) , sigptr= "+string sigptr+", guidLen = "+string ( guidLen)) - let guid,sigptr = sigptrGetBytes ( guidLen) bytes sigptr + let guid, sigptr = sigptrGetBytes ( guidLen) bytes sigptr // reading native type blob (CM3) , sigptr= "+string sigptr) - let nativeTypeNameLen,sigptr = sigptrGetZInt32 bytes sigptr + let nativeTypeNameLen, sigptr = sigptrGetZInt32 bytes sigptr // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeNameLen = "+string ( nativeTypeNameLen)) - let nativeTypeName,sigptr = sigptrGetString ( nativeTypeNameLen) bytes sigptr + 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) - let custMarshallerNameLen,sigptr = sigptrGetZInt32 bytes sigptr + let custMarshallerNameLen, sigptr = sigptrGetZInt32 bytes sigptr // reading native type blob (CM6) , sigptr= "+string sigptr+", custMarshallerNameLen = "+string ( custMarshallerNameLen)) - let custMarshallerName,sigptr = sigptrGetString ( custMarshallerNameLen) bytes sigptr + let custMarshallerName, sigptr = sigptrGetString ( custMarshallerNameLen) bytes sigptr // reading native type blob (CM7) , sigptr= "+string sigptr+", custMarshallerName = "+custMarshallerName) - let cookieStringLen,sigptr = sigptrGetZInt32 bytes sigptr + let cookieStringLen, sigptr = sigptrGetZInt32 bytes sigptr // reading native type blob (CM8) , sigptr= "+string sigptr+", cookieStringLen = "+string ( cookieStringLen)) - let cookieString,sigptr = sigptrGetBytes ( cookieStringLen) bytes sigptr + let cookieString, sigptr = sigptrGetBytes ( cookieStringLen) bytes sigptr // reading native type blob (CM9) , sigptr= "+string sigptr) - ILNativeType.Custom (guid,nativeTypeName,custMarshallerName,cookieString), sigptr + ILNativeType.Custom (guid, nativeTypeName, custMarshallerName, cookieString), sigptr elif ntbyte = nt_FIXEDSYSSTRING then - let i,sigptr = sigptrGetZInt32 bytes sigptr + let i, sigptr = sigptrGetZInt32 bytes sigptr ILNativeType.FixedSysString i, sigptr elif ntbyte = nt_FIXEDARRAY then - let i,sigptr = sigptrGetZInt32 bytes sigptr + let i, sigptr = sigptrGetZInt32 bytes sigptr ILNativeType.FixedArray i, sigptr elif ntbyte = nt_SAFEARRAY then (if sigptr >= bytes.Length then - ILNativeType.SafeArray(ILNativeVariant.Empty, None),sigptr + ILNativeType.SafeArray(ILNativeVariant.Empty, None), sigptr else - let i,sigptr = sigptrGetZInt32 bytes sigptr + let i, sigptr = sigptrGetZInt32 bytes sigptr if sigptr >= bytes.Length then ILNativeType.SafeArray (int32AsILVariantType ctxt i, None), sigptr else - let len,sigptr = sigptrGetZInt32 bytes sigptr - let s,sigptr = sigptrGetString ( len) bytes sigptr + let len, sigptr = sigptrGetZInt32 bytes sigptr + let s, sigptr = sigptrGetString ( len) bytes sigptr ILNativeType.SafeArray (int32AsILVariantType ctxt i, Some s), sigptr) elif ntbyte = nt_ARRAY then if sigptr >= bytes.Length then - ILNativeType.Array(None,None),sigptr + ILNativeType.Array(None, None), sigptr else - let nt,sigptr = - let u,sigptr' = sigptrGetZInt32 bytes sigptr + let nt, sigptr = + let u, sigptr' = sigptrGetZInt32 bytes sigptr if (u = int nt_MAX) then ILNativeType.Empty, sigptr' else // NOTE: go back to start and read native type sigptrGetILNativeType ctxt bytes sigptr if sigptr >= bytes.Length then - ILNativeType.Array (Some nt,None), sigptr + ILNativeType.Array (Some nt, None), sigptr else - let pnum,sigptr = sigptrGetZInt32 bytes sigptr + let pnum, sigptr = sigptrGetZInt32 bytes sigptr if sigptr >= bytes.Length then - ILNativeType.Array (Some nt,Some(pnum,None)), sigptr + ILNativeType.Array (Some nt, Some(pnum, None)), sigptr else - let additive,sigptr = + let additive, sigptr = if sigptr >= bytes.Length then 0, sigptr else sigptrGetZInt32 bytes sigptr - ILNativeType.Array (Some nt,Some(pnum,Some(additive))), sigptr + ILNativeType.Array (Some nt, Some(pnum, Some(additive))), sigptr else (ILNativeType.Empty, sigptr) and seekReadManifestResources ctxt () = mkILResourcesLazy (lazy [ for i = 1 to ctxt.getNumRows TableNames.ManifestResource do - let (offset,flags,nameIdx,implIdx) = seekReadManifestResourceRow ctxt i + let (offset, flags, nameIdx, implIdx) = seekReadManifestResourceRow ctxt i let scoref = seekReadImplAsScopeRef ctxt implIdx let datalab = match scoref with | ILScopeRef.Local -> - let start = ctxt.anyV2P ("resource",offset + ctxt.resourcesAddr) + let start = ctxt.anyV2P ("resource", offset + ctxt.resourcesAddr) let len = seekReadInt32 ctxt.is start ILResourceLocation.Local (fun () -> seekReadBytes ctxt.is (start + 4) len) - | ILScopeRef.Module mref -> ILResourceLocation.File (mref,offset) + | ILScopeRef.Module mref -> ILResourceLocation.File (mref, offset) | ILScopeRef.Assembly aref -> ILResourceLocation.Assembly aref let r = @@ -3210,14 +3210,14 @@ and seekReadNestedExportedTypes ctxt parentIdx = mkILNestedExportedTypesLazy (lazy [ for i = 1 to ctxt.getNumRows TableNames.ExportedType do - let (flags,_tok,nameIdx,namespaceIdx,implIdx) = seekReadExportedTypeRow ctxt i + let (flags, _tok, nameIdx, namespaceIdx, implIdx) = seekReadExportedTypeRow ctxt i if not (isTopTypeDef flags) then - let (TaggedIndex(tag,idx) ) = implIdx + let (TaggedIndex(tag, idx) ) = implIdx //let isTopTypeDef = (idx = 0 || tag <> i_ExportedType) //if not isTopTypeDef then match tag with | tag when tag = i_ExportedType && idx = parentIdx -> - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) yield { Name=nm Access=(match typeAccessOfFlags flags with ILTypeDefAccess.Nested n -> n | _ -> failwith "non-nested access for a nested type described as being in an auxiliary module") @@ -3230,13 +3230,13 @@ and seekReadTopExportedTypes ctxt () = (lazy let res = ref [] for i = 1 to ctxt.getNumRows TableNames.ExportedType do - let (flags,_tok,nameIdx,namespaceIdx,implIdx) = seekReadExportedTypeRow ctxt i + let (flags, _tok, nameIdx, namespaceIdx, implIdx) = seekReadExportedTypeRow ctxt i if isTopTypeDef flags then - let (TaggedIndex(tag,_idx) ) = implIdx + let (TaggedIndex(tag, _idx) ) = implIdx // the nested types will be picked up by their enclosing types if tag <> i_ExportedType then - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) let scoref = seekReadImplAsScopeRef ctxt implIdx @@ -3260,13 +3260,13 @@ let getPdbReader opts infile = let pdbr = pdbReadOpen infile pdbpath let pdbdocs = pdbReaderGetDocuments pdbr - let tab = new Dictionary<_,_>(Array.length pdbdocs) + let tab = new Dictionary<_, _>(Array.length pdbdocs) pdbdocs |> Array.iter (fun pdbdoc -> let url = pdbDocumentGetURL pdbdoc tab.[url] <- - ILSourceDocument.Create(language=Some (pdbDocumentGetLanguage pdbdoc), - vendor = Some (pdbDocumentGetLanguageVendor pdbdoc), - documentType = Some (pdbDocumentGetType pdbdoc), + ILSourceDocument.Create(language=Some (pdbDocumentGetLanguage pdbdoc), + vendor = Some (pdbDocumentGetLanguageVendor pdbdoc), + documentType = Some (pdbDocumentGetType pdbdoc), file = url)) let docfun url = if tab.ContainsKey url then tab.[url] else failwith ("Document with URL "+url+" not found in list of documents in the PDB file") @@ -3314,7 +3314,7 @@ let rec genOpenBinaryReader infile is opts = let _textAddr = seekReadInt32 is (peOptionalHeaderPhysLoc + 20) (* e.g. 0x0002000 *) (* x86: 000000b0 *) let dataSegmentAddr = seekReadInt32 is (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, + (* 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 is (peOptionalHeaderPhysLoc + 28) (* Image Base Always 0x400000 (see Section 23.1). - QUERY : no it's not always 0x400000, e.g. 0x034f0000 *) let alignVirt = seekReadInt32 is (peOptionalHeaderPhysLoc + 32) (* Section Alignment Always 0x2000 (see Section 23.1). *) @@ -3375,7 +3375,7 @@ let rec genOpenBinaryReader infile is opts = let virtSize = seekReadInt32 is (pos + 8) let virtAddr = seekReadInt32 is (pos + 12) let physLoc = seekReadInt32 is (pos + 20) - yield (virtAddr,virtSize,physLoc) ] + yield (virtAddr, virtSize, physLoc) ] let findSectionHeader addr = let rec look i pos = @@ -3407,7 +3407,7 @@ let rec genOpenBinaryReader infile is opts = if logging then dprintn (infile + ": dataSegmentAddr (post section crack) = "+string dataSegmentAddr) - let anyV2P (n,v) = + let anyV2P (n, v) = let rec look i pos = if i >= numSections then (failwith (infile + ": bad "+n+", rva "+string v); 0x0) else @@ -3420,11 +3420,11 @@ let rec genOpenBinaryReader infile is opts = if logging then dprintn (infile + ": numSections = "+string numSections) if logging then dprintn (infile + ": cliHeaderAddr = "+string cliHeaderAddr) - if logging then dprintn (infile + ": cliHeaderPhys = "+string (anyV2P ("cli header",cliHeaderAddr))) + if logging then dprintn (infile + ": cliHeaderPhys = "+string (anyV2P ("cli header", cliHeaderAddr))) if logging then dprintn (infile + ": dataSegmentSize = "+string dataSegmentSize) if logging then dprintn (infile + ": dataSegmentAddr = "+string dataSegmentAddr) - let cliHeaderPhysLoc = anyV2P ("cli header",cliHeaderAddr) + let cliHeaderPhysLoc = anyV2P ("cli header", cliHeaderAddr) let _majorRuntimeVersion = seekReadUInt16 is (cliHeaderPhysLoc + 4) let _minorRuntimeVersion = seekReadUInt16 is (cliHeaderPhysLoc + 6) @@ -3452,7 +3452,7 @@ let rec genOpenBinaryReader infile is opts = if logging then dprintn (infile + ": nativeResourcesAddr = "+string nativeResourcesAddr) if logging then dprintn (infile + ": nativeResourcesSize = "+string nativeResourcesSize) - let metadataPhysLoc = anyV2P ("metadata",metadataAddr) + let metadataPhysLoc = anyV2P ("metadata", metadataAddr) let magic = seekReadUInt16AsInt32 is metadataPhysLoc if magic <> 0x5342 then failwith (infile + ": bad metadata magic number: " + string magic) let magic2 = seekReadUInt16AsInt32 is (metadataPhysLoc + 2) @@ -3488,7 +3488,7 @@ let rec genOpenBinaryReader infile is opts = elif !n >= Array.length name || c <> name.[!n] then res := false incr n - if !res then Some(offset + metadataPhysLoc,length) + if !res then Some(offset + metadataPhysLoc, length) else look (i+1) (align 0x04 (pos + 8 + (!n))) look 0 streamHeadersStart @@ -3507,7 +3507,7 @@ let rec genOpenBinaryReader infile is opts = dprintf "no metadata tables found under stream names '#~' or '#-', please report this\n" let firstStreamOffset = seekReadInt32 is (streamHeadersStart + 0) let firstStreamLength = seekReadInt32 is (streamHeadersStart + 4) - firstStreamOffset,firstStreamLength + firstStreamOffset, firstStreamLength let (stringsStreamPhysicalLoc, stringsStreamSize) = findStream [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; |] (* #Strings *) let (userStringsStreamPhysicalLoc, userStringsStreamSize) = findStream [| 0x23; 0x55; 0x53; |] (* #US *) @@ -3931,10 +3931,10 @@ let rec genOpenBinaryReader infile is opts = countMethodSpec = countMethodSpec } ctxtH := Some ctxt - let ilModule = seekReadModule ctxt (subsys, (subsysMajor, subsysMinor), useHighEnthropyVA, ilOnly,only32,is32bitpreferred,only64,platform,isDll, alignVirt,alignPhys,imageBaseReal,System.Text.Encoding.UTF8.GetString (ilMetadataVersion, 0, ilMetadataVersion.Length)) 1 + let ilModule = seekReadModule ctxt (subsys, (subsysMajor, subsysMinor), useHighEnthropyVA, ilOnly, only32, is32bitpreferred, only64, platform, isDll, alignVirt, alignPhys, imageBaseReal, System.Text.Encoding.UTF8.GetString (ilMetadataVersion, 0, ilMetadataVersion.Length)) 1 let ilAssemblyRefs = lazy [ for i in 1 .. getNumRows TableNames.AssemblyRef do yield seekReadAssemblyRef ctxt i ] - ilModule,ilAssemblyRefs,pdb + ilModule, ilAssemblyRefs, pdb let mkDefault ilg = { optimizeForMemory=false @@ -3947,7 +3947,7 @@ let ClosePdbReader pdb = () #else match pdb with - | Some (pdbr,_) -> pdbReadClose pdbr + | Some (pdbr, _) -> pdbReadClose pdbr | None -> () #endif @@ -3955,7 +3955,7 @@ let OpenILModuleReader infile opts = try let mmap = MemoryMappedFile.Create infile - let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mmap opts + let modul, ilAssemblyRefs, pdb = genOpenBinaryReader infile mmap opts { modul = modul ilAssemblyRefs=ilAssemblyRefs dispose = (fun () -> @@ -3963,7 +3963,7 @@ let OpenILModuleReader infile opts = ClosePdbReader pdb) } with _ -> let mc = ByteFile(infile |> FileSystem.ReadAllBytesShim) - let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mc opts + let modul, ilAssemblyRefs, pdb = genOpenBinaryReader infile mc opts { modul = modul ilAssemblyRefs = ilAssemblyRefs dispose = (fun () -> @@ -3971,20 +3971,20 @@ let OpenILModuleReader infile opts = // ++GLOBAL MUTABLE STATE (concurrency safe via locking) type ILModuleReaderCacheLockToken() = interface LockToken -let ilModuleReaderCache = new AgedLookup(0, areSimilar=(fun (x,y) -> x = y)) +let ilModuleReaderCache = new AgedLookup(0, areSimilar=(fun (x, y) -> x = y)) let ilModuleReaderCacheLock = Lock() let OpenILModuleReaderAfterReadingAllBytes infile opts = // Pseudo-normalize the paths. - let key,succeeded = + let key, succeeded = try (FileSystem.GetFullPathShim(infile), FileSystem.GetLastWriteTimeShim(infile), - opts.ilGlobals.primaryAssemblyScopeRef, + opts.ilGlobals.primaryAssemblyScopeRef, opts.pdbPath.IsSome), true with e -> System.Diagnostics.Debug.Assert(false, sprintf "Failed to compute key in OpenILModuleReaderAfterReadingAllBytes cache for '%s'. Falling back to uncached." infile) - ("",System.DateTime.Now,ILScopeRef.Local,false), false + ("", System.DateTime.Now, ILScopeRef.Local, false), false let cacheResult = if not succeeded then None // Fall back to uncached. @@ -3995,7 +3995,7 @@ let OpenILModuleReaderAfterReadingAllBytes infile opts = | Some(ilModuleReader) -> ilModuleReader | None -> let mc = ByteFile(infile |> FileSystem.ReadAllBytesShim) - let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mc opts + let modul, ilAssemblyRefs, pdb = genOpenBinaryReader infile mc opts let ilModuleReader = { modul = modul ilAssemblyRefs = ilAssemblyRefs @@ -4007,7 +4007,7 @@ let OpenILModuleReaderAfterReadingAllBytes infile opts = let OpenILModuleReaderFromBytes fileNameForDebugOutput bytes opts = assert opts.pdbPath.IsNone let mc = ByteFile(bytes) - let modul,ilAssemblyRefs,pdb = genOpenBinaryReader fileNameForDebugOutput mc opts + let modul, ilAssemblyRefs, pdb = genOpenBinaryReader fileNameForDebugOutput mc opts let ilModuleReader = { modul = modul ilAssemblyRefs = ilAssemblyRefs diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 1f2a6fff605..f35e6e7b792 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -47,26 +47,25 @@ let wrapCustomAttr setCustomAttr (cinfo, bytes) = let logRefEmitCalls = false type System.Reflection.Emit.AssemblyBuilder with - member asmB.DefineDynamicModuleAndLog(a,b,c) = + member asmB.DefineDynamicModuleAndLog(a, b, c) = #if FX_RESHAPED_REFEMIT ignore b ignore c let modB = asmB.DefineDynamicModule(a) #else - let modB = asmB.DefineDynamicModule(a,b,c) - if logRefEmitCalls then printfn "let moduleBuilder%d = assemblyBuilder%d.DefineDynamicModule(%A,%A,%A)" (abs <| hash modB) (abs <| hash asmB) a b c + let modB = asmB.DefineDynamicModule(a, b, c) + if logRefEmitCalls then printfn "let moduleBuilder%d = assemblyBuilder%d.DefineDynamicModule(%A, %A, %A)" (abs <| hash modB) (abs <| hash asmB) a b c #endif modB - member asmB.SetCustomAttributeAndLog(cinfo,bytes) = + member asmB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then printfn "assemblyBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash asmB) cinfo bytes wrapCustomAttr asmB.SetCustomAttribute (cinfo, bytes) -#if FX_RESHAPED_REFEMIT -#else +#if !FX_RESHAPED_REFEMIT 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) + asmB.AddResourceFile(nm1, nm2, attrs) #endif member asmB.SetCustomAttributeAndLog(cab) = if logRefEmitCalls then printfn "assemblyBuilder%d.SetCustomAttribute(%A)" (abs <| hash asmB) cab @@ -74,35 +73,33 @@ type System.Reflection.Emit.AssemblyBuilder with type System.Reflection.Emit.ModuleBuilder with - member modB.GetArrayMethodAndLog(aty,nm,flags,rty,tys) = - if logRefEmitCalls then printfn "moduleBuilder%d.GetArrayMethod(%A,%A,%A,%A,%A)" (abs <| hash modB) aty nm flags rty tys - modB.GetArrayMethod(aty,nm,flags,rty,tys) - -#if FX_RESHAPED_REFEMIT -#else - 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 + member modB.GetArrayMethodAndLog(aty, nm, flags, rty, tys) = + if logRefEmitCalls then printfn "moduleBuilder%d.GetArrayMethod(%A, %A, %A, %A, %A)" (abs <| hash modB) aty nm flags rty tys + modB.GetArrayMethod(aty, nm, flags, rty, tys) + +#if !FX_RESHAPED_REFEMIT + member modB.DefineDocumentAndLog(file, lang, vendor, doctype) = + let symDoc = modB.DefineDocument(file, lang, vendor, doctype) + if logRefEmitCalls then printfn "let docWriter%d = moduleBuilder%d.DefineDocument(@%A, System.Guid(\"%A\"), System.Guid(\"%A\"), System.Guid(\"%A\"))" (abs <| hash symDoc) (abs <| hash modB) file lang vendor doctype symDoc #endif - member modB.GetTypeAndLog(nameInModule,flag1,flag2) = - if logRefEmitCalls then printfn "moduleBuilder%d.GetType(%A,%A,%A) |> ignore" (abs <| hash modB) nameInModule flag1 flag2 - modB.GetType(nameInModule,flag1,flag2) + member modB.GetTypeAndLog(nameInModule, flag1, flag2) = + if logRefEmitCalls then printfn "moduleBuilder%d.GetType(%A, %A, %A) |> ignore" (abs <| hash modB) nameInModule flag1 flag2 + modB.GetType(nameInModule, flag1, flag2) - member modB.DefineTypeAndLog(name,attrs) = - let typB = modB.DefineType(name,attrs) - if logRefEmitCalls then printfn "let typeBuilder%d = moduleBuilder%d.DefineType(%A,enum %d)" (abs <| hash typB) (abs <| hash modB) name (LanguagePrimitives.EnumToValue attrs) + member modB.DefineTypeAndLog(name, attrs) = + let typB = modB.DefineType(name, attrs) + if logRefEmitCalls then printfn "let typeBuilder%d = moduleBuilder%d.DefineType(%A, enum %d)" (abs <| hash typB) (abs <| hash modB) name (LanguagePrimitives.EnumToValue attrs) typB -#if FX_RESHAPED_REFEMIT -#else - member modB.DefineManifestResourceAndLog(name,stream,attrs) = - if logRefEmitCalls then printfn "moduleBuilder%d.DefineManifestResource(%A,%A,enum %d)" (abs <| hash modB) name stream (LanguagePrimitives.EnumToValue attrs) - modB.DefineManifestResource(name,stream,attrs) +#if !FX_RESHAPED_REFEMIT + member modB.DefineManifestResourceAndLog(name, stream, attrs) = + if logRefEmitCalls then printfn "moduleBuilder%d.DefineManifestResource(%A, %A, enum %d)" (abs <| hash modB) name stream (LanguagePrimitives.EnumToValue attrs) + modB.DefineManifestResource(name, stream, attrs) #endif - member modB.SetCustomAttributeAndLog(cinfo,bytes) = + member modB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then printfn "moduleBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash modB) cinfo bytes - wrapCustomAttr modB.SetCustomAttribute (cinfo,bytes) + wrapCustomAttr modB.SetCustomAttribute (cinfo, bytes) type System.Reflection.Emit.ConstructorBuilder with @@ -110,9 +107,9 @@ type System.Reflection.Emit.ConstructorBuilder with if logRefEmitCalls then printfn "constructorBuilder%d.SetImplementationFlags(enum %d)" (abs <| hash consB) (LanguagePrimitives.EnumToValue attrs) consB.SetImplementationFlags(attrs) - member consB.DefineParameterAndLog(n,attr,nm) = - if logRefEmitCalls then printfn "constructorBuilder%d.DefineParameter(%d,enum %d,%A)" (abs <| hash consB) n (LanguagePrimitives.EnumToValue attr) nm - consB.DefineParameter(n,attr,nm) + member consB.DefineParameterAndLog(n, attr, nm) = + if logRefEmitCalls then printfn "constructorBuilder%d.DefineParameter(%d, enum %d, %A)" (abs <| hash consB) n (LanguagePrimitives.EnumToValue attr) nm + consB.DefineParameter(n, attr, nm) member consB.GetILGeneratorAndLog() = let ilG = consB.GetILGenerator() @@ -132,9 +129,9 @@ type System.Reflection.Emit.MethodBuilder with if logRefEmitCalls then printfn "methodBuilder%d.SetParameters(%A)" (abs <| hash methB) ps methB.SetParameters(ps) - member methB.DefineParameterAndLog(n,attr,nm) = - if logRefEmitCalls then printfn "methodBuilder%d.DefineParameter(%d,enum %d,%A)" (abs <| hash methB) n (LanguagePrimitives.EnumToValue attr) nm - methB.DefineParameter(n,attr,nm) + member methB.DefineParameterAndLog(n, attr, nm) = + if logRefEmitCalls then printfn "methodBuilder%d.DefineParameter(%d, enum %d, %A)" (abs <| hash methB) n (LanguagePrimitives.EnumToValue attr) nm + methB.DefineParameter(n, attr, nm) member methB.DefineGenericParametersAndLog(gps) = if logRefEmitCalls then printfn "let gps%d = methodBuilder%d.DefineGenericParameters(%A)" (abs <| hash methB) (abs <| hash methB) gps @@ -145,9 +142,9 @@ 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) + wrapCustomAttr methB.SetCustomAttribute (cinfo, bytes) type System.Reflection.Emit.TypeBuilder with member typB.CreateTypeAndLog() = @@ -157,37 +154,37 @@ type System.Reflection.Emit.TypeBuilder with #else typB.CreateType() #endif - member typB.DefineNestedTypeAndLog(name,attrs) = - let res = typB.DefineNestedType(name,attrs) - if logRefEmitCalls then printfn "let typeBuilder%d = typeBuilder%d.DefineNestedType(\"%s\",enum %d)" (abs <| hash res) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) + member typB.DefineNestedTypeAndLog(name, attrs) = + let res = typB.DefineNestedType(name, attrs) + if logRefEmitCalls then printfn "let typeBuilder%d = typeBuilder%d.DefineNestedType(\"%s\", enum %d)" (abs <| hash res) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) res - member typB.DefineMethodAndLog(name,attrs,cconv) = - let methB = typB.DefineMethod(name,attrs,cconv) - if logRefEmitCalls then printfn "let methodBuilder%d = typeBuilder%d.DefineMethod(\"%s\",enum %d,enum %d)" (abs <| hash methB) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) (LanguagePrimitives.EnumToValue cconv) + member typB.DefineMethodAndLog(name, attrs, cconv) = + let methB = typB.DefineMethod(name, attrs, cconv) + if logRefEmitCalls then printfn "let methodBuilder%d = typeBuilder%d.DefineMethod(\"%s\", enum %d, enum %d)" (abs <| hash methB) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) (LanguagePrimitives.EnumToValue cconv) methB member typB.DefineGenericParametersAndLog(gps) = if logRefEmitCalls then printfn "typeBuilder%d.DefineGenericParameters(%A)" (abs <| hash typB) gps typB.DefineGenericParameters(gps) - member typB.DefineConstructorAndLog(attrs,cconv,parms) = - let consB = typB.DefineConstructor(attrs,cconv,parms) - if logRefEmitCalls then printfn "let constructorBuilder%d = typeBuilder%d.DefineConstructor(enum %d,CallingConventions.%A,%A)" (abs <| hash consB) (abs <| hash typB) (LanguagePrimitives.EnumToValue attrs) cconv parms + member typB.DefineConstructorAndLog(attrs, cconv, parms) = + let consB = typB.DefineConstructor(attrs, cconv, parms) + if logRefEmitCalls then printfn "let constructorBuilder%d = typeBuilder%d.DefineConstructor(enum %d, CallingConventions.%A, %A)" (abs <| hash consB) (abs <| hash typB) (LanguagePrimitives.EnumToValue attrs) cconv parms consB - member typB.DefineFieldAndLog(nm,ty:System.Type,attrs) = - let fieldB = typB.DefineField(nm,ty,attrs) - if logRefEmitCalls then printfn "let fieldBuilder%d = typeBuilder%d.DefineField(\"%s\",typeof<%s>,enum %d)" (abs <| hash fieldB) (abs <| hash typB) nm ty.FullName (LanguagePrimitives.EnumToValue attrs) + member typB.DefineFieldAndLog(nm, ty:System.Type, attrs) = + let fieldB = typB.DefineField(nm, ty, attrs) + if logRefEmitCalls then printfn "let fieldBuilder%d = typeBuilder%d.DefineField(\"%s\", typeof<%s>, enum %d)" (abs <| hash fieldB) (abs <| hash typB) nm ty.FullName (LanguagePrimitives.EnumToValue attrs) fieldB - member typB.DefinePropertyAndLog(nm,attrs,ty:System.Type,args) = - if logRefEmitCalls then printfn "typeBuilder%d.DefineProperty(\"%A\",enum %d,typeof<%s>,%A)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName args - typB.DefineProperty(nm,attrs,ty,args) + member typB.DefinePropertyAndLog(nm, attrs, ty:System.Type, args) = + if logRefEmitCalls then printfn "typeBuilder%d.DefineProperty(\"%A\", enum %d, typeof<%s>, %A)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName args + typB.DefineProperty(nm, attrs, ty, args) - member typB.DefineEventAndLog(nm,attrs,ty:System.Type) = - if logRefEmitCalls then printfn "typeBuilder%d.DefineEvent(\"%A\",enum %d,typeof<%A>)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName - typB.DefineEvent(nm,attrs,ty) + member typB.DefineEventAndLog(nm, attrs, ty:System.Type) = + if logRefEmitCalls then printfn "typeBuilder%d.DefineEvent(\"%A\", enum %d, typeof<%A>)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName + typB.DefineEvent(nm, attrs, ty) member typB.SetParentAndLog(ty:System.Type) = if logRefEmitCalls then printfn "typeBuilder%d.SetParent(typeof<%s>)" (abs <| hash typB) ty.FullName @@ -197,7 +194,7 @@ type System.Reflection.Emit.TypeBuilder with if logRefEmitCalls then printfn "typeBuilder%d.AddInterfaceImplementation(%A)" (abs <| hash typB) ty typB.AddInterfaceImplementation(ty) - member typB.InvokeMemberAndLog(nm,_flags,args) = + member typB.InvokeMemberAndLog(nm, _flags, args) = #if FX_RESHAPED_REFEMIT let t = typB.CreateTypeAndLog() let m = @@ -206,29 +203,28 @@ type System.Reflection.Emit.TypeBuilder with if m <> null then m.Invoke(null, args) else raise (MissingMethodException(nm)) #else - if logRefEmitCalls then printfn "typeBuilder%d.InvokeMember(\"%s\",enum %d,null,null,%A,Globalization.CultureInfo.InvariantCulture)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue _flags) args - typB.InvokeMember(nm,_flags,null,null,args,Globalization.CultureInfo.InvariantCulture) + if logRefEmitCalls then printfn "typeBuilder%d.InvokeMember(\"%s\", enum %d, null, null, %A, Globalization.CultureInfo.InvariantCulture)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue _flags) args + typB.InvokeMember(nm, _flags, null, null, args, Globalization.CultureInfo.InvariantCulture) #endif - member typB.SetCustomAttributeAndLog(cinfo,bytes) = + member typB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then printfn "typeBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash typB) cinfo bytes - wrapCustomAttr typB.SetCustomAttribute (cinfo,bytes) + wrapCustomAttr typB.SetCustomAttribute (cinfo, bytes) 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) = - if logRefEmitCalls then printfn "ilg%d.DeclareLocal(typeof<%s>,%b)" (abs <| hash ilG) ty.FullName isPinned - ilG.DeclareLocal(ty,isPinned) + member ilG.DeclareLocalAndLog(ty:System.Type, isPinned) = + if logRefEmitCalls then printfn "ilg%d.DeclareLocal(typeof<%s>, %b)" (abs <| hash ilG) ty.FullName isPinned + ilG.DeclareLocal(ty, isPinned) member ilG.MarkLabelAndLog(lab) = if logRefEmitCalls then printfn "ilg%d.MarkLabel(label%d_%d)" (abs <| hash ilG) (abs <| hash ilG) (abs <| hash lab) ilG.MarkLabel(lab) -#if FX_RESHAPED_REFEMIT -#else +#if !FX_RESHAPED_REFEMIT member ilG.MarkSequencePointAndLog(symDoc, l1, c1, l2, c2) = if logRefEmitCalls then printfn "ilg%d.MarkSequencePoint(docWriter%d, %A, %A, %A, %A)" (abs <| hash ilG) (abs <| hash symDoc) l1 c1 l2 c2 ilG.MarkSequencePoint(symDoc, l1, c1, l2, c2) @@ -265,30 +261,30 @@ type System.Reflection.Emit.ILGenerator with member x.EmitAndLog (op:OpCode) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s)" (abs <| hash x) op.RefEmitName x.Emit(op) - member x.EmitAndLog (op:OpCode,v:Label) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s,label%d_%d)" (abs <| hash x) op.RefEmitName (abs <| hash x) (abs <| hash v); - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:int16) = + member x.EmitAndLog (op:OpCode, v:Label) = + if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, label%d_%d)" (abs <| hash x) op.RefEmitName (abs <| hash x) (abs <| hash v); + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:int16) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, int16 %d)" (abs <| hash x) op.RefEmitName v; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:int32) = + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:int32) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, %d)" (abs <| hash x) op.RefEmitName v; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:MethodInfo) = + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:MethodInfo) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, methodBuilder%d) // method %s" (abs <| hash x) op.RefEmitName (abs <| hash v) v.Name; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:string) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s,\"@%s\")" (abs <| hash x) op.RefEmitName v; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:Type) = + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:string) = + if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, \"@%s\")" (abs <| hash x) op.RefEmitName v; + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:Type) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, typeof<%s>)" (abs <| hash x) op.RefEmitName v.FullName; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:FieldInfo) = + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:FieldInfo) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, fieldBuilder%d) // field %s" (abs <| hash x) op.RefEmitName (abs <| hash v) v.Name; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:ConstructorInfo) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s,constructor_%s)" (abs <| hash x) op.RefEmitName v.DeclaringType.Name; - x.Emit(op,v) + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:ConstructorInfo) = + if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, constructor_%s)" (abs <| hash x) op.RefEmitName v.DeclaringType.Name; + x.Emit(op, v) //---------------------------------------------------------------------------- @@ -322,12 +318,11 @@ let convAssemblyRef (aref:ILAssemblyRef) = | None -> () | 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) + let setVersion (major, minor, build, rev) = + asmName.Version <- System.Version (int32 major, int32 minor, int32 build, int32 rev) Option.iter setVersion aref.Version; // asmName.ProcessorArchitecture <- System.Reflection.ProcessorArchitecture.MSIL; -#if FX_RESHAPED_GLOBALIZATION -#else +#if !FX_RESHAPED_GLOBALIZATION //Option.iter (fun name -> asmName.CultureInfo <- System.Globalization.CultureInfo.CreateSpecificCulture(name)) aref.Locale; asmName.CultureInfo <- System.Globalization.CultureInfo.InvariantCulture; #endif @@ -338,15 +333,15 @@ type cenv = { ilg: ILGlobals tryFindSysILTypeRef : string -> ILTypeRef option generatePdb: bool - resolveAssemblyRef: (ILAssemblyRef -> Choice option) } + resolveAssemblyRef: (ILAssemblyRef -> Choice option) } /// Convert an Abstract IL type reference to Reflection.Emit System.Type value. // This ought to be an adequate substitute for this whole function, but it needs // to be thoroughly tested. // Type.GetType(tref.QualifiedName) -// [] ,name -> name -// [ns] ,name -> ns+name -// [ns;typeA;typeB],name -> ns+typeA+typeB+name +// [] , name -> name +// [ns] , name -> ns+name +// [ns;typeA;typeB], name -> ns+typeA+typeB+name let convTypeRefAux (cenv:cenv) (tref:ILTypeRef) = let qualifiedName = (String.concat "+" (tref.Enclosing @ [ tref.Name ])).Replace(",", @"\,") match tref.Scope with @@ -377,13 +372,13 @@ let convTypeRefAux (cenv:cenv) (tref:ILTypeRef) = /// and could be placed as hash tables in the global environment. [] type emEnv = - { emTypMap : Zmap ; - emConsMap : Zmap; - emMethMap : Zmap; - emFieldMap : Zmap; - emPropMap : Zmap; + { emTypMap : Zmap ; + emConsMap : Zmap; + emMethMap : Zmap; + emFieldMap : Zmap; + emPropMap : Zmap; emLocals : LocalBuilder[]; - emLabels : Zmap; + emLabels : Zmap; emTyvars : Type[] list; // stack emEntryPts : (TypeBuilder * string) list delayedFieldInits : (unit -> unit) list} @@ -405,16 +400,16 @@ let emEnv0 = emEntryPts = [] delayedFieldInits = [] } -let envBindTypeRef emEnv (tref:ILTypeRef) (typT,typB,typeDef)= +let envBindTypeRef emEnv (tref:ILTypeRef) (typT, typB, typeDef)= match typT with | null -> failwithf "binding null type in envBindTypeRef: %s\n" tref.Name; - | _ -> {emEnv with emTypMap = Zmap.add tref (typT,typB,typeDef,None) emEnv.emTypMap} + | _ -> {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, None) emEnv.emTypMap} let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = // The tref's TypeBuilder has been created, so we have a Type proper. // Update the tables to include this created type (the typT held prior to this is (i think) actually (TypeBuilder :> Type). // The (TypeBuilder :> Type) does not implement all the methods that a Type proper does. - let typT,typB,typeDef,_createdTypOpt = Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" + let typT, typB, typeDef, _createdTypOpt = Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" if typB.IsCreated() then let typ = typB.CreateTypeAndLog() #if ENABLE_MONO_SUPPORT @@ -429,7 +424,7 @@ let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = System.Runtime.Serialization.FormatterServices.GetUninitializedObject(typ) |> ignore with e -> () #endif - {emEnv with emTypMap = Zmap.add tref (typT,typB,typeDef,Some typ) emEnv.emTypMap} + {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, Some typ) emEnv.emTypMap} else #if DEBUG printf "envUpdateCreatedTypeRef: expected type to be created\n"; @@ -439,8 +434,8 @@ let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = let convTypeRef cenv emEnv preferCreated (tref:ILTypeRef) = let res = match Zmap.tryFind tref emEnv.emTypMap with - | Some (_typT,_typB,_typeDef,Some createdTyp) when preferCreated -> createdTyp - | Some (typT,_typB,_typeDef,_) -> typT + | Some (_typT, _typB, _typeDef, Some createdTyp) when preferCreated -> createdTyp + | 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)) @@ -472,11 +467,11 @@ let envGetPropB emEnv pref = let envGetTypB emEnv (tref:ILTypeRef) = Zmap.force tref emEnv.emTypMap "envGetTypB: failed" - |> (fun (_typT,typB,_typeDef,_createdTypOpt) -> typB) + |> (fun (_typT, typB, _typeDef, _createdTypOpt) -> typB) let envGetTypeDef emEnv (tref:ILTypeRef) = Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" - |> (fun (_typT,_typB,typeDef,_createdTypOpt) -> typeDef) + |> (fun (_typT, _typB, typeDef, _createdTypOpt) -> typeDef) let envSetLocals emEnv locs = assert (emEnv.emLocals.Length = 0); // check "locals" is not yet set (scopes once only) {emEnv with emLocals = locs} @@ -504,13 +499,13 @@ 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 envPopEntryPts emEnv = {emEnv with emEntryPts = []}, emEnv.emEntryPts //---------------------------------------------------------------------------- // convCallConv //---------------------------------------------------------------------------- -let convCallConv (Callconv (hasThis,basic)) = +let convCallConv (Callconv (hasThis, basic)) = let ccA = match hasThis with ILThisConvention.Static -> CallingConventions.Standard | ILThisConvention.InstanceExplicit -> CallingConventions.ExplicitThis | ILThisConvention.Instance -> CallingConventions.HasThis @@ -531,10 +526,10 @@ let rec convTypeSpec cenv emEnv preferCreated (tspec:ILTypeSpec) = 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,false -> typT - | _ ,false -> null + match isNil tyargs, typT.IsGenericType with + | _ , true -> typT.MakeGenericType(List.toArray tyargs) + | true, false -> typT + | _ , false -> null match res with | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tspec.TypeRef.QualifiedName, tspec.Scope.QualifiedName), range0)) | _ -> res @@ -542,13 +537,13 @@ let rec convTypeSpec cenv emEnv preferCreated (tspec:ILTypeSpec) = and convTypeAux cenv emEnv preferCreated typ = match typ with | ILType.Void -> Type.GetType("System.Void") - | ILType.Array (shape,eltType) -> + | ILType.Array (shape, eltType) -> let baseT = convTypeAux cenv emEnv preferCreated eltType let nDims = shape.Rank // MakeArrayType() returns "eltType[]" // MakeArrayType(1) returns "eltType[*]" - // MakeArrayType(2) returns "eltType[,]" - // MakeArrayType(3) returns "eltType[,,]" + // MakeArrayType(2) returns "eltType[, ]" + // MakeArrayType(3) returns "eltType[, , ]" // All non-equal. if nDims=1 then baseT.MakeArrayType() @@ -664,7 +659,7 @@ let queryableTypeGetField _emEnv (parentT:Type) (fref: ILFieldRef) = let nonQueryableTypeGetField (parentTI:Type) (fieldInfo : FieldInfo) : FieldInfo = let res = - if parentTI.IsGenericType then TypeBuilder.GetField(parentTI,fieldInfo) + if parentTI.IsGenericType then TypeBuilder.GetField(parentTI, fieldInfo) else fieldInfo match res with | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("field", fieldInfo.Name, parentTI.AssemblyQualifiedName, parentTI.Assembly.FullName), range0)) @@ -745,11 +740,11 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref:ILMethodRef) = // constructs generic type without checking constraints if not (satisfiesAllParameters mrefParameterTypes haveArgTs) then false else - let argTs,resT = + 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 - argTs,resT + argTs, resT let haveResT = methInfo.ReturnType (* check for match *) @@ -765,18 +760,18 @@ let queryableTypeGetMethod cenv emEnv parentT (mref:ILMethodRef) = assert(not (typeIsNotQueryable(parentT))) if mref.GenericArity = 0 then let tyargTs = getGenericArgumentsOfType parentT - let argTs,resT = + let argTs, resT = let emEnv = envPushTyvars emEnv tyargTs let argTs = convTypesToArray cenv emEnv mref.ArgTypes let resT = convType cenv emEnv mref.ReturnType - argTs,resT + argTs, resT let stat = mref.CallingConv.IsStatic let cconv = (if stat then BindingFlags.Static else BindingFlags.Instance) let methInfo = try - parentT.GetMethod(mref.Name,cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic, - null, - argTs, + parentT.GetMethod(mref.Name, cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic, + null, + argTs, #if FX_RESHAPED_REFLECTION (null:obj[])) #else @@ -794,7 +789,7 @@ let queryableTypeGetMethod cenv emEnv parentT (mref:ILMethodRef) = let nonQueryableTypeGetMethod (parentTI:Type) (methInfo : MethodInfo) : MethodInfo = if (parentTI.IsGenericType && not (equalTypes parentTI (getTypeConstructor parentTI))) - then TypeBuilder.GetMethod(parentTI,methInfo ) + then TypeBuilder.GetMethod(parentTI, methInfo ) else methInfo let convMethodRef cenv emEnv (parentTI:Type) (mref:ILMethodRef) = @@ -842,14 +837,14 @@ let queryableTypeGetConstructor cenv emEnv (parentT:Type) (mref:ILMethodRef) = 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) + let res = parentT.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance, null, reqArgTs, null) match res with | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("constructor", mref.Name, parentT.FullName, parentT.Assembly.FullName), range0)) | _ -> res let nonQueryableTypeGetConstructor (parentTI:Type) (consInfo : ConstructorInfo) : ConstructorInfo = - if parentTI.IsGenericType then TypeBuilder.GetConstructor(parentTI,consInfo) else consInfo + if parentTI.IsGenericType then TypeBuilder.GetConstructor(parentTI, consInfo) else consInfo //---------------------------------------------------------------------------- // convConstructorSpec (like convMethodSpec) @@ -889,18 +884,18 @@ let emitLabelMark emEnv (ilG:ILGenerator) (label:ILCodeLabel) = ///Emit comparison instructions. let emitInstrCompare emEnv (ilG:ILGenerator) comp targ = match comp with - | BI_beq -> ilG.EmitAndLog(OpCodes.Beq,envGetLabel emEnv targ) - | BI_bge -> ilG.EmitAndLog(OpCodes.Bge ,envGetLabel emEnv targ) - | BI_bge_un -> ilG.EmitAndLog(OpCodes.Bge_Un ,envGetLabel emEnv targ) - | BI_bgt -> ilG.EmitAndLog(OpCodes.Bgt ,envGetLabel emEnv targ) - | BI_bgt_un -> ilG.EmitAndLog(OpCodes.Bgt_Un ,envGetLabel emEnv targ) - | BI_ble -> ilG.EmitAndLog(OpCodes.Ble ,envGetLabel emEnv targ) - | BI_ble_un -> ilG.EmitAndLog(OpCodes.Ble_Un ,envGetLabel emEnv targ) - | BI_blt -> ilG.EmitAndLog(OpCodes.Blt ,envGetLabel emEnv targ) - | BI_blt_un -> ilG.EmitAndLog(OpCodes.Blt_Un ,envGetLabel emEnv targ) - | BI_bne_un -> ilG.EmitAndLog(OpCodes.Bne_Un ,envGetLabel emEnv targ) - | BI_brfalse -> ilG.EmitAndLog(OpCodes.Brfalse,envGetLabel emEnv targ) - | BI_brtrue -> ilG.EmitAndLog(OpCodes.Brtrue ,envGetLabel emEnv targ) + | BI_beq -> ilG.EmitAndLog(OpCodes.Beq, envGetLabel emEnv targ) + | BI_bge -> ilG.EmitAndLog(OpCodes.Bge , envGetLabel emEnv targ) + | BI_bge_un -> ilG.EmitAndLog(OpCodes.Bge_Un , envGetLabel emEnv targ) + | BI_bgt -> ilG.EmitAndLog(OpCodes.Bgt , envGetLabel emEnv targ) + | BI_bgt_un -> ilG.EmitAndLog(OpCodes.Bgt_Un , envGetLabel emEnv targ) + | BI_ble -> ilG.EmitAndLog(OpCodes.Ble , envGetLabel emEnv targ) + | BI_ble_un -> ilG.EmitAndLog(OpCodes.Ble_Un , envGetLabel emEnv targ) + | BI_blt -> ilG.EmitAndLog(OpCodes.Blt , envGetLabel emEnv targ) + | BI_blt_un -> ilG.EmitAndLog(OpCodes.Blt_Un , envGetLabel emEnv targ) + | BI_bne_un -> ilG.EmitAndLog(OpCodes.Bne_Un , envGetLabel emEnv targ) + | BI_brfalse -> ilG.EmitAndLog(OpCodes.Brfalse, envGetLabel emEnv targ) + | BI_brtrue -> ilG.EmitAndLog(OpCodes.Brtrue , envGetLabel emEnv targ) /// Emit the volatile. prefix @@ -911,9 +906,9 @@ let emitInstrVolatile (ilG:ILGenerator) = function /// Emit the align. prefix let emitInstrAlign (ilG:ILGenerator) = function | 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) + | Unaligned1 -> ilG.Emit(OpCodes.Unaligned, 1L) // note: doc says use "long" overload! + | Unaligned2 -> ilG.Emit(OpCodes.Unaligned, 2L) + | Unaligned4 -> ilG.Emit(OpCodes.Unaligned, 3L) /// Emit the tail. prefix if necessary let emitInstrTail (ilG:ILGenerator) tail emitTheCall = @@ -923,7 +918,7 @@ let emitInstrTail (ilG:ILGenerator) tail 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 _vartyps -> failwith "emit: pending new varargs" // XXX - gap let emitSilverlightCheck (ilG:ILGenerator) = @@ -935,19 +930,19 @@ 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 _vartyps -> failwith "emitInstrCall: .ctor and varargs" else let minfo = convMethodSpec cenv emEnv mspec match varargs with - | None -> ilG.EmitAndLog(opCall,minfo) - | Some vartyps -> ilG.EmitCall (opCall,minfo,convTypesToArray cenv emEnv vartyps) + | None -> ilG.EmitAndLog(opCall, minfo) + | Some vartyps -> ilG.EmitCall (opCall, minfo, convTypesToArray cenv emEnv vartyps) ) let getGenericMethodDefinition q (ty:Type) = let gminfo = match q with - | Quotations.Patterns.Call(_,minfo,_) -> minfo.GetGenericMethodDefinition() + | Quotations.Patterns.Call(_, minfo, _) -> minfo.GetGenericMethodDefinition() | _ -> failwith "unexpected failure decoding quotation at ilreflect startup" gminfo.MakeGenericMethod [| ty |] @@ -983,57 +978,57 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = | AI_cgt_un -> ilG.EmitAndLog(OpCodes.Cgt_Un) | AI_clt -> ilG.EmitAndLog(OpCodes.Clt) | AI_clt_un -> ilG.EmitAndLog(OpCodes.Clt_Un) - (* conversion *) - | AI_conv dt -> (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Conv_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_I8) - | DT_U -> ilG.EmitAndLog(OpCodes.Conv_U) - | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_U4) - | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_U8) - | DT_R -> ilG.EmitAndLog(OpCodes.Conv_R_Un) - | DT_R4 -> ilG.EmitAndLog(OpCodes.Conv_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Conv_R8) - | DT_REF -> failwith "AI_conv DT_REF?" // XXX - check - ) - (* conversion - ovf checks *) - | AI_conv_ovf dt -> (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I8) - | DT_U -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U) - | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U4) - | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U8) - | DT_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 -> (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_REF -> failwith "AI_conv_ovf_un DT_REF?" // XXX - check - ) + // conversion + | AI_conv dt -> + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Conv_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_I8) + | DT_U -> ilG.EmitAndLog(OpCodes.Conv_U) + | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_U1) + | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_U2) + | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_U4) + | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_U8) + | DT_R -> ilG.EmitAndLog(OpCodes.Conv_R_Un) + | DT_R4 -> ilG.EmitAndLog(OpCodes.Conv_R4) + | DT_R8 -> ilG.EmitAndLog(OpCodes.Conv_R8) + | DT_REF -> failwith "AI_conv DT_REF?" // XXX - check + // conversion - ovf checks + | AI_conv_ovf dt -> + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I8) + | DT_U -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U) + | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U1) + | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U2) + | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U4) + | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U8) + | DT_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 -> + 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_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) @@ -1054,158 +1049,198 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = | 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 (typ,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_REF -> ilG.EmitAndLog(OpCodes.Ldind_Ref)) - | I_ldloc u16 -> ilG.EmitAndLog(OpCodes.Ldloc ,int16 u16) - | I_ldloca u16 -> ilG.EmitAndLog(OpCodes.Ldloca,int16 u16) - | I_starg u16 -> ilG.EmitAndLog(OpCodes.Starg ,int16 u16) - | I_stind (align,vol,dt) -> emitInstrAlign ilG align; - emitInstrVolatile ilG vol; - (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Stind_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Stind_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Stind_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Stind_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Stind_I8) - | DT_R -> failwith "emitInstr cenv: stind R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Stind_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Stind_R8) - | DT_U -> ilG.EmitAndLog(OpCodes.Stind_I) // NOTE: unsigned -> int conversion - | DT_U1 -> ilG.EmitAndLog(OpCodes.Stind_I1) // NOTE: follows code ilwrite.fs - | DT_U2 -> ilG.EmitAndLog(OpCodes.Stind_I2) // NOTE: is it ok? - | DT_U4 -> ilG.EmitAndLog(OpCodes.Stind_I4) // NOTE: it is generated by bytearray tests - | DT_U8 -> ilG.EmitAndLog(OpCodes.Stind_I8) // NOTE: unsigned -> int conversion - | DT_REF -> ilG.EmitAndLog(OpCodes.Stind_Ref)) - | I_stloc u16 -> ilG.EmitAndLog(OpCodes.Stloc,int16 u16) - | I_br targ -> ilG.EmitAndLog(OpCodes.Br,envGetLabel emEnv targ) - | I_jmp mspec -> ilG.EmitAndLog(OpCodes.Jmp,convMethodSpec cenv emEnv mspec) - | 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) -> emitSilverlightCheck ilG - emitInstrCall cenv emEnv ilG OpCodes.Call tail mspec varargs - | I_callvirt (tail,mspec,varargs) -> emitSilverlightCheck ilG - emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs - | I_callconstraint (tail,typ,mspec,varargs) -> ilG.Emit(OpCodes.Constrained,convType cenv emEnv typ); - emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs - | I_calli (tail,callsig,None) -> emitInstrTail ilG tail (fun () -> - ilG.EmitCalli(OpCodes.Calli, - convCallConv callsig.CallingConv, - convType cenv emEnv callsig.ReturnType, - convTypesToArray cenv emEnv callsig.ArgTypes, - Unchecked.defaultof)) - | I_calli (tail,callsig,Some vartyps) -> emitInstrTail ilG tail (fun () -> - ilG.EmitCalli(OpCodes.Calli, - convCallConv callsig.CallingConv, - convType cenv emEnv callsig.ReturnType, - convTypesToArray cenv emEnv callsig.ArgTypes, - convTypesToArray cenv emEnv vartyps)) - | I_ldftn mspec -> ilG.EmitAndLog(OpCodes.Ldftn,convMethodSpec cenv emEnv mspec) - | I_newobj (mspec,varargs) -> emitInstrNewobj cenv emEnv ilG mspec varargs + | 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 (typ, 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_REF -> ilG.EmitAndLog(OpCodes.Ldind_Ref) + | I_ldloc u16 -> ilG.EmitAndLog(OpCodes.Ldloc , int16 u16) + | I_ldloca u16 -> ilG.EmitAndLog(OpCodes.Ldloca, int16 u16) + | I_starg u16 -> ilG.EmitAndLog(OpCodes.Starg , int16 u16) + | I_stind (align, vol, dt) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Stind_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Stind_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Stind_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Stind_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Stind_I8) + | DT_R -> failwith "emitInstr cenv: stind R" + | DT_R4 -> ilG.EmitAndLog(OpCodes.Stind_R4) + | DT_R8 -> ilG.EmitAndLog(OpCodes.Stind_R8) + | DT_U -> ilG.EmitAndLog(OpCodes.Stind_I) // NOTE: unsigned -> int conversion + | DT_U1 -> ilG.EmitAndLog(OpCodes.Stind_I1) // NOTE: follows code ilwrite.fs + | DT_U2 -> ilG.EmitAndLog(OpCodes.Stind_I2) // NOTE: is it ok? + | DT_U4 -> ilG.EmitAndLog(OpCodes.Stind_I4) // NOTE: it is generated by bytearray tests + | DT_U8 -> ilG.EmitAndLog(OpCodes.Stind_I8) // NOTE: unsigned -> int conversion + | DT_REF -> ilG.EmitAndLog(OpCodes.Stind_Ref) + | I_stloc u16 -> ilG.EmitAndLog(OpCodes.Stloc, int16 u16) + | I_br targ -> ilG.EmitAndLog(OpCodes.Br, envGetLabel emEnv targ) + | I_jmp mspec -> ilG.EmitAndLog(OpCodes.Jmp, convMethodSpec cenv emEnv mspec) + | 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) -> + emitSilverlightCheck ilG + emitInstrCall cenv emEnv ilG OpCodes.Call tail mspec varargs + + | I_callvirt (tail, mspec, varargs) -> + emitSilverlightCheck ilG + emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs + + | I_callconstraint (tail, typ, mspec, varargs) -> + ilG.Emit(OpCodes.Constrained, convType cenv emEnv typ); + emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs + + | I_calli (tail, callsig, None) -> + emitInstrTail ilG tail (fun () -> + ilG.EmitCalli(OpCodes.Calli, + convCallConv callsig.CallingConv, + convType cenv emEnv callsig.ReturnType, + convTypesToArray cenv emEnv callsig.ArgTypes, + Unchecked.defaultof)) + + | I_calli (tail, callsig, Some vartyps) -> + emitInstrTail ilG tail (fun () -> + ilG.EmitCalli(OpCodes.Calli, + convCallConv callsig.CallingConv, + convType cenv emEnv callsig.ReturnType, + convTypesToArray cenv emEnv callsig.ArgTypes, + convTypesToArray cenv emEnv vartyps)) + + | I_ldftn mspec -> + ilG.EmitAndLog(OpCodes.Ldftn, convMethodSpec cenv emEnv mspec) + + | I_newobj (mspec, varargs) -> + emitInstrNewobj cenv emEnv ilG mspec varargs + | I_throw -> ilG.EmitAndLog(OpCodes.Throw) | I_endfinally -> ilG.EmitAndLog(OpCodes.Endfinally) | I_endfilter -> ilG.EmitAndLog(OpCodes.Endfilter) - | I_leave label -> ilG.EmitAndLog(OpCodes.Leave,envGetLabel emEnv label) - | I_ldsfld (vol,fspec) -> emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldsfld ,convFieldSpec cenv emEnv fspec) - | I_ldfld (align,vol,fspec) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldfld ,convFieldSpec cenv emEnv fspec) - | I_ldsflda fspec -> ilG.EmitAndLog(OpCodes.Ldsflda,convFieldSpec cenv emEnv fspec) - | I_ldflda fspec -> ilG.EmitAndLog(OpCodes.Ldflda ,convFieldSpec cenv emEnv fspec) - | I_stsfld (vol,fspec) -> emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Stsfld ,convFieldSpec cenv emEnv fspec) - | I_stfld (align,vol,fspec) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Stfld ,convFieldSpec cenv emEnv fspec) - | I_ldstr s -> ilG.EmitAndLog(OpCodes.Ldstr ,s) - | I_isinst typ -> ilG.EmitAndLog(OpCodes.Isinst ,convType cenv emEnv typ) - | I_castclass typ -> ilG.EmitAndLog(OpCodes.Castclass,convType cenv emEnv typ) - | I_ldtoken (ILToken.ILType typ) -> ilG.EmitAndLog(OpCodes.Ldtoken ,convTypeOrTypeDef cenv emEnv typ) - | I_ldtoken (ILToken.ILMethod mspec) -> ilG.EmitAndLog(OpCodes.Ldtoken ,convMethodSpec cenv emEnv mspec) - | I_ldtoken (ILToken.ILField fspec) -> ilG.EmitAndLog(OpCodes.Ldtoken ,convFieldSpec cenv emEnv fspec) - | I_ldvirtftn mspec -> ilG.EmitAndLog(OpCodes.Ldvirtftn,convMethodSpec cenv emEnv mspec) - (* Value type instructions *) - | I_cpobj typ -> ilG.EmitAndLog(OpCodes.Cpobj ,convType cenv emEnv typ) - | I_initobj typ -> ilG.EmitAndLog(OpCodes.Initobj ,convType cenv emEnv typ) - | I_ldobj (align,vol,typ) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldobj ,convType cenv emEnv typ) - | I_stobj (align,vol,typ) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Stobj ,convType cenv emEnv typ) - | I_box typ -> ilG.EmitAndLog(OpCodes.Box ,convType cenv emEnv typ) - | I_unbox typ -> ilG.EmitAndLog(OpCodes.Unbox ,convType cenv emEnv typ) - | I_unbox_any typ -> ilG.EmitAndLog(OpCodes.Unbox_Any,convType cenv emEnv typ) - | I_sizeof typ -> ilG.EmitAndLog(OpCodes.Sizeof ,convType cenv emEnv typ) + | I_leave label -> ilG.EmitAndLog(OpCodes.Leave, envGetLabel emEnv label) + | I_ldsfld (vol, fspec) -> emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldsfld , convFieldSpec cenv emEnv fspec) + | I_ldfld (align, vol, fspec) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldfld , convFieldSpec cenv emEnv fspec) + | I_ldsflda fspec -> ilG.EmitAndLog(OpCodes.Ldsflda, convFieldSpec cenv emEnv fspec) + | I_ldflda fspec -> ilG.EmitAndLog(OpCodes.Ldflda , convFieldSpec cenv emEnv fspec) + + | I_stsfld (vol, fspec) -> + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Stsfld, convFieldSpec cenv emEnv fspec) + + | 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 typ -> ilG.EmitAndLog(OpCodes.Isinst, convType cenv emEnv typ) + | I_castclass typ -> ilG.EmitAndLog(OpCodes.Castclass, convType cenv emEnv typ) + | I_ldtoken (ILToken.ILType typ) -> ilG.EmitAndLog(OpCodes.Ldtoken, convTypeOrTypeDef cenv emEnv typ) + | I_ldtoken (ILToken.ILMethod mspec) -> ilG.EmitAndLog(OpCodes.Ldtoken, convMethodSpec cenv emEnv mspec) + | I_ldtoken (ILToken.ILField fspec) -> ilG.EmitAndLog(OpCodes.Ldtoken, convFieldSpec cenv emEnv fspec) + | I_ldvirtftn mspec -> ilG.EmitAndLog(OpCodes.Ldvirtftn, convMethodSpec cenv emEnv mspec) + // Value type instructions + | I_cpobj typ -> ilG.EmitAndLog(OpCodes.Cpobj , convType cenv emEnv typ) + | I_initobj typ -> ilG.EmitAndLog(OpCodes.Initobj , convType cenv emEnv typ) + + | I_ldobj (align, vol, typ) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Ldobj , convType cenv emEnv typ) + + | I_stobj (align, vol, typ) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Stobj , convType cenv emEnv typ) + + | I_box typ -> ilG.EmitAndLog(OpCodes.Box , convType cenv emEnv typ) + | I_unbox typ -> ilG.EmitAndLog(OpCodes.Unbox , convType cenv emEnv typ) + | I_unbox_any typ -> ilG.EmitAndLog(OpCodes.Unbox_Any, convType cenv emEnv typ) + | I_sizeof typ -> ilG.EmitAndLog(OpCodes.Sizeof , convType cenv emEnv typ) + // Generalized array instructions. // In AbsIL these instructions include // both the single-dimensional variants (with ILArrayShape == ILArrayShape.SingleDimensional) // and calls to the "special" multi-dimensional "methods" such as - // newobj void string[,]::.ctor(int32, int32) - // call string string[,]::Get(int32, int32) - // call string& string[,]::Address(int32, int32) - // call void string[,]::Set(int32, int32,string) + // newobj void string[, ]::.ctor(int32, int32) + // call string string[, ]::Get(int32, int32) + // call string& string[, ]::Address(int32, int32) + // call void string[, ]::Set(int32, int32, string) // The IL reader transforms calls of this form to the corresponding // 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 -> (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_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_REF -> ilG.EmitAndLog(OpCodes.Stelem_Ref)) - | I_ldelema (ro,_isNativePtr,shape,typ) -> + | 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_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_REF -> ilG.EmitAndLog(OpCodes.Stelem_Ref) + + | I_ldelema (ro, _isNativePtr, shape, typ) -> if (ro = ReadonlyAddress) then ilG.EmitAndLog(OpCodes.Readonly); if (shape = ILArrayShape.SingleDimensional) - then ilG.EmitAndLog(OpCodes.Ldelema,convType cenv emEnv typ) + then ilG.EmitAndLog(OpCodes.Ldelema, convType cenv emEnv typ) else - let aty = convType cenv emEnv (ILType.Array(shape,typ)) + let aty = convType cenv emEnv (ILType.Array(shape, typ)) 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,typ) -> - if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Ldelem,convType cenv emEnv typ) + 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, typ) -> + if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Ldelem, convType cenv emEnv typ) else - let aty = convType cenv emEnv (ILType.Array(shape,typ)) + let aty = convType cenv emEnv (ILType.Array(shape, typ)) let ety = aty.GetElementType() let meth = #if ENABLE_MONO_SUPPORT @@ -1214,13 +1249,13 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = getArrayMethInfo shape.Rank ety else #endif - modB.GetArrayMethodAndLog(aty,"Get",System.Reflection.CallingConventions.HasThis,ety,Array.create shape.Rank (typeof) ) - ilG.EmitAndLog(OpCodes.Call,meth) + modB.GetArrayMethodAndLog(aty, "Get", System.Reflection.CallingConventions.HasThis, ety, Array.create shape.Rank (typeof) ) + ilG.EmitAndLog(OpCodes.Call, meth) - | I_stelem_any (shape,typ) -> - if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Stelem,convType cenv emEnv typ) + | I_stelem_any (shape, typ) -> + if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Stelem, convType cenv emEnv typ) else - let aty = convType cenv emEnv (ILType.Array(shape,typ)) + let aty = convType cenv emEnv (ILType.Array(shape, typ)) let ety = aty.GetElementType() let meth = #if ENABLE_MONO_SUPPORT @@ -1229,20 +1264,21 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = setArrayMethInfo shape.Rank ety else #endif - modB.GetArrayMethodAndLog(aty,"Set",System.Reflection.CallingConventions.HasThis,(null:Type),Array.append (Array.create shape.Rank (typeof)) (Array.ofList [ ety ])) - ilG.EmitAndLog(OpCodes.Call,meth) + modB.GetArrayMethodAndLog(aty, "Set", System.Reflection.CallingConventions.HasThis, (null:Type), Array.append (Array.create shape.Rank (typeof)) (Array.ofList [ ety ])) + ilG.EmitAndLog(OpCodes.Call, meth) - | I_newarr (shape,typ) -> + | I_newarr (shape, typ) -> if (shape = ILArrayShape.SingleDimensional) - then ilG.EmitAndLog(OpCodes.Newarr,convType cenv emEnv typ) + then ilG.EmitAndLog(OpCodes.Newarr, convType cenv emEnv typ) else - let aty = convType cenv emEnv (ILType.Array(shape,typ)) - let meth = modB.GetArrayMethodAndLog(aty,".ctor",System.Reflection.CallingConventions.HasThis,(null:Type),Array.create shape.Rank (typeof)) - ilG.EmitAndLog(OpCodes.Newobj,meth) + let aty = convType cenv emEnv (ILType.Array(shape, typ)) + 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 typ -> ilG.EmitAndLog(OpCodes.Mkrefany,convType cenv emEnv typ) + | I_mkrefany typ -> ilG.EmitAndLog(OpCodes.Mkrefany, convType cenv emEnv typ) | I_refanytype -> ilG.EmitAndLog(OpCodes.Refanytype) - | I_refanyval typ -> ilG.EmitAndLog(OpCodes.Refanyval,convType cenv emEnv typ) + | I_refanyval typ -> ilG.EmitAndLog(OpCodes.Refanyval, convType cenv emEnv typ) | I_rethrow -> ilG.EmitAndLog(OpCodes.Rethrow) | I_break -> ilG.EmitAndLog(OpCodes.Break) | I_seqpoint src -> @@ -1250,30 +1286,36 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = ignore src () #else - if cenv.generatePdb && not (src.Document.File.EndsWith("stdin",StringComparison.Ordinal)) then + if cenv.generatePdb && not (src.Document.File.EndsWith("stdin", StringComparison.Ordinal)) then let guid x = match x with None -> Guid.Empty | Some g -> Guid(g:byte[]) in let symDoc = modB.DefineDocumentAndLog(src.Document.File, guid src.Document.Language, guid src.Document.Vendor, guid src.Document.DocumentType) ilG.MarkSequencePointAndLog(symDoc, src.Line, src.Column, src.EndLine, src.EndColumn) #endif | 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) -> emitInstrAlign ilG align; - emitInstrVolatile ilG vol; - ilG.EmitAndLog(OpCodes.Initblk) - | EI_ldlen_multi (_,m) -> + + | I_cpblk (align, vol) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Cpblk) + + | I_initblk (align, vol) -> + emitInstrAlign ilG align; + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Initblk) + + | EI_ldlen_multi (_, m) -> emitInstr cenv modB emEnv ilG (mkLdcInt32 m); emitInstr cenv modB emEnv ilG (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [cenv.ilg.typ_Int32], cenv.ilg.typ_Int32))) - | i -> Printf.failwithf "the IL instruction %s cannot be emitted" (i.ToString()) + + | i -> failwithf "the IL instruction %s cannot be emitted" (i.ToString()) let emitCode cenv modB emEnv (ilG:ILGenerator) (code: ILCode) = // Pre-define the labels pending determining their actual marks let pc2lab = Dictionary() let emEnv = - (emEnv, code.Labels) ||> Seq.fold (fun emEnv (KeyValue(label,pc)) -> + (emEnv, code.Labels) ||> Seq.fold (fun emEnv (KeyValue(label, pc)) -> let lab = ilG.DefineLabelAndLog() pc2lab.[pc] <- (if pc2lab.ContainsKey pc then lab :: pc2lab.[pc] else [lab]) envSetLabel emEnv label lab) @@ -1286,22 +1328,25 @@ let emitCode cenv modB emEnv (ilG:ILGenerator) (code: ILCode) = pc2action.[pc] <- (if pc2action.ContainsKey pc then pc2action.[pc] @ [ action ] else [ action ]) for e in code.Exceptions do - let (startTry,_endTry) = e.Range + let (startTry, _endTry) = e.Range add startTry (fun () -> ilG.BeginExceptionBlockAndLog() |> ignore) match e.Clause with - | ILExceptionClause.Finally(startHandler,endHandler) -> + | ILExceptionClause.Finally(startHandler, endHandler) -> add startHandler ilG.BeginFinallyBlockAndLog add endHandler ilG.EndExceptionBlockAndLog - | ILExceptionClause.Fault(startHandler,endHandler) -> + + | ILExceptionClause.Fault(startHandler, endHandler) -> add startHandler ilG.BeginFaultBlockAndLog add endHandler ilG.EndExceptionBlockAndLog - | ILExceptionClause.FilterCatch((startFilter,_),(startHandler,endHandler)) -> + + | ILExceptionClause.FilterCatch((startFilter, _), (startHandler, endHandler)) -> add startFilter ilG.BeginExceptFilterBlockAndLog add startHandler (fun () -> ilG.BeginCatchBlockAndLog null) add endHandler ilG.EndExceptionBlockAndLog - | ILExceptionClause.TypeCatch(typ, (startHandler,endHandler)) -> + + | ILExceptionClause.TypeCatch(typ, (startHandler, endHandler)) -> add startHandler (fun () -> ilG.BeginCatchBlockAndLog (convType cenv emEnv typ)) add endHandler ilG.EndExceptionBlockAndLog @@ -1324,8 +1369,7 @@ let emitCode cenv modB emEnv (ilG:ILGenerator) (code: ILCode) = let emitLocal cenv emEnv (ilG : ILGenerator) (local: ILLocal) = let ty = convType cenv emEnv local.Type let locBuilder = ilG.DeclareLocalAndLog(ty, local.IsPinned) -#if FX_NO_PDB_WRITER -#else +#if !FX_NO_PDB_WRITER match local.DebugInfo with | Some(nm, start, finish) -> locBuilder.SetLocalSymInfo(nm, start, finish) | None -> () @@ -1351,7 +1395,7 @@ let convCustomAttr cenv emEnv cattr = | null -> failwithf "convCustomAttr: %+A" cattr.Method | res -> res let data = cattr.Data - (methInfo,data) + (methInfo, data) let emitCustomAttr cenv emEnv add cattr = add (convCustomAttr cenv emEnv cattr) let emitCustomAttrs cenv emEnv add (cattrs : ILAttributes) = List.iter (emitCustomAttr cenv emEnv add) cattrs.AsList @@ -1378,7 +1422,7 @@ let buildGenParamsPass1b cenv emEnv (genArgs : Type array) (gps : ILGenericParam let gpB = genpBs.[i] // the Constraints are either the parent (base) type or interfaces. let constraintTs = convTypes cenv emEnv gp.Constraints - let interfaceTs,baseTs = List.partition (fun (typ:System.Type) -> typ.IsInterface) constraintTs + let interfaceTs, baseTs = List.partition (fun (typ:System.Type) -> typ.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? @@ -1418,7 +1462,7 @@ let emitParameter cenv emEnv (defineParameter : int * ParameterAttributes * stri | Some name -> name | None -> "X" + string(i+1) - let parB = defineParameter(i,attrs,name) + let parB = defineParameter(i, attrs, name) emitCustomAttrs cenv emEnv (wrapCustomAttr parB.SetCustomAttribute) param.CustomAttrs //---------------------------------------------------------------------------- @@ -1476,7 +1520,7 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) let attrs = convMethodAttributes mdef let implflags = convMethodImplFlags mdef let cconv = convCallConv mdef.CallingConv - let mref = mkRefToILMethod (tref,mdef) + let mref = mkRefToILMethod (tref, mdef) let emEnv = if mdef.IsEntryPoint && isNil mdef.ParameterTypes then (* Bug 2209: Here, we collect the entry points generated by ilxgen corresponding to the top-level effects. @@ -1484,12 +1528,11 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) However, these user entry points functions must take string[] argument. By only adding entry points with no arguments, we only collect the top-level effects. *) - envAddEntryPt emEnv (typB,mdef.Name) + envAddEntryPt emEnv (typB, mdef.Name) else emEnv match mdef.mdBody.Contents with -#if FX_RESHAPED_REFEMIT -#else +#if !FX_RESHAPED_REFEMIT | MethodBody.PInvoke p -> let argtys = convTypesToArray cenv emEnv mdef.ParameterTypes let rty = convType cenv emEnv mdef.Return.Type @@ -1531,12 +1574,12 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) match mdef.Name with | ".cctor" | ".ctor" -> - let consB = typB.DefineConstructorAndLog(attrs,cconv,convTypesToArray cenv emEnv mdef.ParameterTypes) + let consB = typB.DefineConstructorAndLog(attrs, cconv, convTypesToArray cenv emEnv mdef.ParameterTypes) consB.SetImplementationFlagsAndLog(implflags); envBindConsRef emEnv mref consB | _name -> // The return/argument types may involve the generic parameters - let methB = typB.DefineMethodAndLog(mdef.Name,attrs,cconv) + let methB = typB.DefineMethodAndLog(mdef.Name, attrs, cconv) // Method generic type parameters buildGenParamsPass1 emEnv methB.DefineGenericParametersAndLog mdef.GenericParams; @@ -1556,7 +1599,7 @@ 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.mdBody.Contents with | MethodBody.PInvoke _p -> true @@ -1567,7 +1610,7 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho // Constructors can not have generic parameters assert isNil mdef.GenericParams // Value parameters - let defineParameter (i,attr,name) = consB.DefineParameterAndLog(i+1,attr,name) + let defineParameter (i, attr, name) = consB.DefineParameterAndLog(i+1, attr, name) mdef.Parameters |> List.iteri (emitParameter cenv emEnv defineParameter); // Body emitMethodBody cenv modB emEnv consB.GetILGenerator mdef.Name mdef.mdBody; @@ -1583,11 +1626,11 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho match mdef.Return.CustomAttrs.AsList with | [] -> () | _ -> - let retB = methB.DefineParameterAndLog(0,System.Reflection.ParameterAttributes.Retval,null) + let retB = methB.DefineParameterAndLog(0, System.Reflection.ParameterAttributes.Retval, null) emitCustomAttrs cenv emEnv (wrapCustomAttr retB.SetCustomAttribute) mdef.Return.CustomAttrs // Value parameters - let defineParameter (i,attr,name) = methB.DefineParameterAndLog(i+1,attr,name) + let defineParameter (i, attr, name) = methB.DefineParameterAndLog(i+1, attr, name) mdef.Parameters |> List.iteri (fun a b -> emitParameter cenv emEnv defineParameter a b); // Body if not isPInvoke then @@ -1622,7 +1665,7 @@ let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) = match fdef.Data with | Some d -> typB.DefineInitializedData(fdef.Name, d, attrs) | None -> - typB.DefineFieldAndLog(fdef.Name,fieldT,attrs) + typB.DefineFieldAndLog(fdef.Name, fieldT, attrs) // set default value let emEnv = @@ -1644,34 +1687,34 @@ let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) = 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.Type) + let fref = mkILFieldRef (tref, fdef.Name, fdef.Type) envBindFieldRef emEnv fref fieldB let buildFieldPass3 cenv tref (_typB:TypeBuilder) emEnv (fdef : ILFieldDef) = - let fref = mkILFieldRef (tref,fdef.Name,fdef.Type) + let fref = mkILFieldRef (tref, fdef.Name, fdef.Type) let fieldB = envGetFieldB emEnv fref emitCustomAttrs cenv emEnv (wrapCustomAttr fieldB.SetCustomAttribute) fdef.CustomAttrs //---------------------------------------------------------------------------- -// buildPropertyPass2,3 +// buildPropertyPass2, 3 //---------------------------------------------------------------------------- let buildPropertyPass2 cenv tref (typB:TypeBuilder) emEnv (prop : ILPropertyDef) = let attrs = flagsIf prop.IsRTSpecialName PropertyAttributes.RTSpecialName ||| flagsIf prop.IsSpecialName PropertyAttributes.SpecialName - let propB = typB.DefinePropertyAndLog(prop.Name,attrs,convType cenv emEnv prop.Type,convTypesToArray cenv emEnv prop.Args) + let propB = typB.DefinePropertyAndLog(prop.Name, attrs, convType cenv emEnv prop.Type, 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)); // set default value prop.Init |> Option.iter (fun initial -> propB.SetConstant(convFieldInit initial)); // custom attributes - let pref = ILPropertyRef.Create (tref,prop.Name) + let pref = ILPropertyRef.Create (tref, prop.Name) envBindPropRef emEnv pref propB let buildPropertyPass3 cenv tref (_typB:TypeBuilder) emEnv (prop : ILPropertyDef) = - let pref = ILPropertyRef.Create (tref,prop.Name) + let pref = ILPropertyRef.Create (tref, prop.Name) let propB = envGetPropB emEnv pref emitCustomAttrs cenv emEnv (wrapCustomAttr propB.SetCustomAttribute) prop.CustomAttrs @@ -1684,7 +1727,7 @@ let buildEventPass3 cenv (typB:TypeBuilder) emEnv (eventDef : ILEventDef) = let attrs = flagsIf eventDef.IsSpecialName EventAttributes.SpecialName ||| flagsIf eventDef.IsRTSpecialName EventAttributes.RTSpecialName assert eventDef.Type.IsSome - let eventB = typB.DefineEventAndLog(eventDef.Name,attrs,convType cenv emEnv eventDef.Type.Value) + let eventB = typB.DefineEventAndLog(eventDef.Name, attrs, convType cenv emEnv eventDef.Type.Value) eventDef.AddMethod |> (fun mref -> eventB.SetAddOnMethod(envGetMethB emEnv mref)); eventDef.RemoveMethod |> (fun mref -> eventB.SetRemoveOnMethod(envGetMethB emEnv mref)); @@ -1698,10 +1741,10 @@ 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 (OverridesSpec (mref, dtyp)) = mimpl.Overrides let declMethTI = convType cenv emEnv dtyp let declMethInfo = convMethodRef cenv emEnv declMethTI mref - typB.DefineMethodOverride(bodyMethInfo,declMethInfo); + typB.DefineMethodOverride(bodyMethInfo, declMethInfo); emEnv //---------------------------------------------------------------------------- @@ -1747,14 +1790,14 @@ let typeAttributesOfTypeLayout cenv emEnv x = Some(convCustomAttr cenv emEnv (IL.mkILCustomAttribute cenv.ilg (tref1, - [mkILNonGenericValueTy tref2 ], - [ ILAttribElem.Int32 x ], + [mkILNonGenericValueTy tref2 ], + [ ILAttribElem.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 -> TypeAttributes.AutoLayout,None - | ILTypeDefLayout.Explicit p -> TypeAttributes.ExplicitLayout,(attr 0x02 p) + | ILTypeDefLayout.Auto -> TypeAttributes.AutoLayout, None + | ILTypeDefLayout.Explicit p -> TypeAttributes.ExplicitLayout, (attr 0x02 p) | ILTypeDefLayout.Sequential p -> TypeAttributes.SequentialLayout, (attr 0x00 p) @@ -1769,7 +1812,7 @@ let rec buildTypeDefPass1 cenv emEnv (modB:ModuleBuilder) rootTypeBuilder nestin // TypeAttributes let attrsKind = typeAttrbutesOfTypeDefKind tdef.tdKind let attrsAccess = typeAttrbutesOfTypeAccess tdef.Access - let attrsLayout,cattrsLayout = typeAttributesOfTypeLayout cenv emEnv tdef.Layout + let attrsLayout, cattrsLayout = typeAttributesOfTypeLayout cenv emEnv tdef.Layout let attrsEnc = typeAttributesOfTypeEncoding tdef.Encoding let attrsOther = flagsIf tdef.IsAbstract TypeAttributes.Abstract ||| flagsIf tdef.IsSealed TypeAttributes.Sealed ||| @@ -1780,19 +1823,19 @@ let rec buildTypeDefPass1 cenv emEnv (modB:ModuleBuilder) rootTypeBuilder nestin let attrsType = attrsKind ||| attrsAccess ||| attrsLayout ||| attrsEnc ||| attrsOther // 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; - // bind tref -> (typT,typB) - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) + // bind tref -> (typT, typB) + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typT = // Q: would it be ok to use typB :> Type ? // Maybe not, recall TypeBuilder maybe subtype of Type, but it is not THE Type. let nameInModule = tref.QualifiedName - modB.GetTypeAndLog(nameInModule,false,false) + modB.GetTypeAndLog(nameInModule, false, false) - let emEnv = envBindTypeRef emEnv tref (typT,typB,tdef) + let emEnv = envBindTypeRef emEnv tref (typT, typB, tdef) // recurse on nested types let nesting = nesting @ [tdef] let buildNestedType emEnv tdef = buildTypeTypeDef cenv emEnv modB typB nesting tdef @@ -1807,7 +1850,7 @@ 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 tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typB = envGetTypB emEnv tref let genArgs = getGenericArgumentsOfType (typB.AsType()) let emEnv = envPushTyvars emEnv genArgs @@ -1825,7 +1868,7 @@ let rec buildTypeDefPass1b cenv nesting emEnv (tdef : ILTypeDef) = //---------------------------------------------------------------------------- let rec buildTypeDefPass2 cenv nesting emEnv (tdef : ILTypeDef) = - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typB = envGetTypB emEnv tref let emEnv = envPushTyvars emEnv (getGenericArgumentsOfType (typB.AsType())) // add interface impls @@ -1845,7 +1888,7 @@ let rec buildTypeDefPass2 cenv nesting emEnv (tdef : ILTypeDef) = //---------------------------------------------------------------------------- let rec buildTypeDefPass3 cenv nesting modB emEnv (tdef : ILTypeDef) = - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typB = envGetTypB emEnv tref let emEnv = envPushTyvars emEnv (getGenericArgumentsOfType (typB.AsType())) // add method bodies, properties, events @@ -1904,7 +1947,7 @@ let rec buildTypeDefPass3 cenv nesting modB emEnv (tdef : ILTypeDef) = let getEnclosingTypeRefs (tref:ILTypeRef) = match tref.Enclosing with | [] -> [] - | h :: t -> List.scan (fun tr nm -> mkILTyRefInTyRef (tr,nm)) (mkILTyRef(tref.Scope, h)) t + | h :: t -> List.scan (fun tr nm -> mkILTyRefInTyRef (tr, nm)) (mkILTyRef(tref.Scope, h)) t [] type CollectTypes = ValueTypesOnly | All @@ -1916,7 +1959,7 @@ let rec getTypeRefsInType (allTypes: CollectTypes) typ acc = | ILType.TypeVar _ -> acc | ILType.Ptr eltType | ILType.Byref eltType -> getTypeRefsInType allTypes eltType acc - | ILType.Array (_,eltType) -> + | ILType.Array (_, eltType) -> match allTypes with | CollectTypes.ValueTypesOnly -> acc | CollectTypes.All -> getTypeRefsInType allTypes eltType acc @@ -1933,7 +1976,7 @@ let rec getTypeRefsInType (allTypes: CollectTypes) typ acc = let verbose2 = false -let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv tref = +let createTypeRef (visited : Dictionary<_, _>, created : Dictionary<_, _>) emEnv tref = let rec traverseTypeDef (tref:ILTypeRef) (tdef:ILTypeDef) = if verbose2 then dprintf "buildTypeDefPass4: Creating Enclosing Types of %s\n" tdef.Name; @@ -1993,7 +2036,7 @@ 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 @@ -2016,15 +2059,15 @@ let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv t traverseTypeRef tref -let rec buildTypeDefPass4 (visited,created) nesting emEnv (tdef : ILTypeDef) = +let rec buildTypeDefPass4 (visited, created) nesting emEnv (tdef : ILTypeDef) = if verbose2 then dprintf "buildTypeDefPass4 %s\n" tdef.Name; - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) - createTypeRef (visited,created) emEnv tref; + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) + createTypeRef (visited, created) emEnv tref; // nested types let nesting = nesting @ [tdef] - tdef.NestedTypes |> Seq.iter (buildTypeDefPass4 (visited,created) nesting emEnv) + tdef.NestedTypes |> Seq.iter (buildTypeDefPass4 (visited, created) nesting emEnv) //---------------------------------------------------------------------------- // buildModuleType @@ -2055,9 +2098,9 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde let emEnv = { emEnv with delayedFieldInits = [] } 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) + let visited = new Dictionary<_, _>(10) + let created = new Dictionary<_, _>(10) + 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 @@ -2068,7 +2111,7 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde match r.Location with | ILResourceLocation.Local bf -> modB.DefineManifestResourceAndLog(r.Name, new System.IO.MemoryStream(bf()), attribs) - | ILResourceLocation.File (mr,_) -> + | ILResourceLocation.File (mr, _) -> asmB.AddResourceFileAndLog(r.Name, mr.Name, attribs) | ILResourceLocation.Assembly _ -> failwith "references to resources other assemblies may not be emitted using System.Reflection"); @@ -2078,18 +2121,18 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde //---------------------------------------------------------------------------- // test hook //---------------------------------------------------------------------------- -let defineDynamicAssemblyAndLog(asmName,flags,asmDir:string) = +let defineDynamicAssemblyAndLog(asmName, flags, asmDir:string) = #if FX_NO_APP_DOMAINS - let asmB = AssemblyBuilder.DefineDynamicAssembly(asmName,flags) + let asmB = AssemblyBuilder.DefineDynamicAssembly(asmName, flags) #else let currentDom = System.AppDomain.CurrentDomain - let asmB = currentDom.DefineDynamicAssembly(asmName,flags,asmDir) + let asmB = currentDom.DefineDynamicAssembly(asmName, flags, asmDir) #endif if logRefEmitCalls then printfn "open System" printfn "open System.Reflection" printfn "open System.Reflection.Emit" - printfn "let assemblyBuilder%d = System.AppDomain.CurrentDomain.DefineDynamicAssembly(AssemblyName(Name=\"%s\"),enum %d,%A)" (abs <| hash asmB) asmName.Name (LanguagePrimitives.EnumToValue flags) asmDir + printfn "let assemblyBuilder%d = System.AppDomain.CurrentDomain.DefineDynamicAssembly(AssemblyName(Name=\"%s\"), enum %d, %A)" (abs <| hash asmB) asmName.Name (LanguagePrimitives.EnumToValue flags) asmDir asmB let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) = @@ -2104,15 +2147,15 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) #else else AssemblyBuilderAccess.RunAndSave #endif - let asmB = defineDynamicAssemblyAndLog(asmName,asmAccess,asmDir) + let asmB = defineDynamicAssemblyAndLog(asmName, asmAccess, asmDir) if not optimize then let daType = typeof; let daCtor = daType.GetConstructor [| typeof |] let daBuilder = new CustomAttributeBuilder(daCtor, [| System.Diagnostics.DebuggableAttribute.DebuggingModes.DisableOptimizations ||| System.Diagnostics.DebuggableAttribute.DebuggingModes.Default |]) asmB.SetCustomAttributeAndLog(daBuilder); - let modB = asmB.DefineDynamicModuleAndLog(assemblyName,filename,debugInfo) - asmB,modB + let modB = asmB.DefineDynamicModuleAndLog(assemblyName, filename, debugInfo) + asmB, modB let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder, modul : IL.ILModuleDef, debugInfo : bool, resolveAssemblyRef, tryFindSysILTypeRef) = let cenv = { ilg = ilg ; generatePdb = debugInfo; resolveAssemblyRef=resolveAssemblyRef; tryFindSysILTypeRef=tryFindSysILTypeRef } @@ -2124,17 +2167,17 @@ let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder // REVIEW: remainder of manifest emitCustomAttrs cenv emEnv asmB.SetCustomAttributeAndLog mani.CustomAttrs; // invoke entry point methods - let execEntryPtFun ((typB : TypeBuilder),methodName) () = + let execEntryPtFun ((typB : TypeBuilder), methodName) () = try - ignore (typB.InvokeMemberAndLog(methodName,BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static,[| |])); + ignore (typB.InvokeMemberAndLog(methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static, [| |])); None with | :? System.Reflection.TargetInvocationException as e -> Some(e.InnerException) - let emEnv,entryPts = envPopEntryPts emEnv + let emEnv, entryPts = envPopEntryPts emEnv let execs = List.map execEntryPtFun entryPts - emEnv,execs + emEnv, execs //---------------------------------------------------------------------------- diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 4751e059e34..81fcf5be8ae 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -49,7 +49,7 @@ let dw2 n = byte ((n >>> 16) &&& 0xFFL) let dw1 n = byte ((n >>> 8) &&& 0xFFL) let dw0 n = byte (n &&& 0xFFL) -let bitsOfSingle (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x),0) +let bitsOfSingle (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x), 0) let bitsOfDouble (x:float) = System.BitConverter.DoubleToInt64Bits(x) let emitBytesViaBuffer f = let bb = ByteBuffer.Create 10 in f bb; bb.Close() @@ -102,7 +102,7 @@ let getUncodedToken (tab:TableName) idx = ((tab.Index <<< 24) ||| idx) // From ECMA for UserStrings: // This final byte holds the value 1 if and only if any UTF16 character within the string has any bit set in its top byte, or its low byte is any of the following: -// 0x01-0x08, 0x0E-0x1F, 0x27, 0x2D, +// 0x01-0x08, 0x0E-0x1F, 0x27, 0x2D, // 0x7F. Otherwise, it holds 0. The 1 signifies Unicode characters that require handling beyond that normally provided for 8-bit encoding sets. // HOWEVER, there is a discrepancy here between the ECMA spec and the Microsoft C# implementation. @@ -370,13 +370,13 @@ type SharedRow(elems: RowElement[], hashCode: int) = let SharedRow(elems: RowElement[]) = new SharedRow(elems, hashRow elems) /// Special representation : Note, only hashing by name -let AssemblyRefRow(s1,s2,s3,s4,l1,b1,nameIdx,str2,b2) = +let AssemblyRefRow(s1, s2, s3, s4, l1, b1, nameIdx, str2, b2) = let hashCode = hash nameIdx let genericRow = [| UShort s1; UShort s2; UShort s3; UShort s4; ULong l1; Blob b1; StringE nameIdx; StringE str2; Blob b2 |] new SharedRow(genericRow, hashCode) /// Special representation the computes the hash more efficiently -let MemberRefRow(mrp:RowElement,nmIdx:StringIndex,blobIdx:BlobIndex) = +let MemberRefRow(mrp:RowElement, nmIdx:StringIndex, blobIdx:BlobIndex) = let hashCode = combineHash (hash blobIdx) (combineHash (hash nmIdx) (hash mrp)) let genericRow = [| mrp; StringE nmIdx; Blob blobIdx |] new SharedRow(genericRow, hashCode) @@ -423,12 +423,12 @@ type MetadataTable<'T> = mutable rows: ResizeArray<'T> } member x.Count = x.rows.Count - static member New(nm,hashEq) = + static member New(nm, hashEq) = { name=nm #if DEBUG lookups=0 #endif - dict = new Dictionary<_,_>(100, hashEq) + dict = new Dictionary<_, _>(100, hashEq) rows= new ResizeArray<_>() } member tbl.EntriesAsArray = @@ -459,7 +459,7 @@ type MetadataTable<'T> = tbl.lookups <- tbl.lookups + 1 #endif let mutable res = Unchecked.defaultof<_> - let ok = tbl.dict.TryGetValue(x,&res) + let ok = tbl.dict.TryGetValue(x, &res) if ok then res else tbl.AddSharedEntry x @@ -482,7 +482,7 @@ type MetadataTable<'T> = //--------------------------------------------------------------------- /// We use this key type to help find ILMethodDefs for MethodRefs -type MethodDefKey(tidx:int,garity:int,nm:string,rty:ILType,argtys:ILTypes,isStatic:bool) = +type MethodDefKey(tidx:int, garity:int, nm:string, rty:ILType, argtys:ILTypes, isStatic:bool) = // Precompute the hash. The hash doesn't include the return type or // argument types (only argument type count). This is very important, since // hashing these is way too expensive @@ -512,7 +512,7 @@ type MethodDefKey(tidx:int,garity:int,nm:string,rty:ILType,argtys:ILTypes,isStat | _ -> false /// We use this key type to help find ILFieldDefs for FieldRefs -type FieldDefKey(tidx:int,nm:string,ty:ILType) = +type FieldDefKey(tidx:int, nm:string, ty:ILType) = // precompute the hash. hash doesn't include the type let hashCode = hash tidx |> combineHash (hash nm) member key.TypeIdx = tidx @@ -572,14 +572,14 @@ type cenv = mutable entrypoint: (bool * int) option /// Caches - trefCache: Dictionary + trefCache: Dictionary /// The following are all used to generate unique items in the output tables: MetadataTable[] AssemblyRefs: MetadataTable fieldDefs: MetadataTable methodDefIdxsByKey: MetadataTable - methodDefIdxs: Dictionary + methodDefIdxs: Dictionary propertyDefs: MetadataTable eventDefs: MetadataTable typeDefs: MetadataTable @@ -591,7 +591,7 @@ type cenv = member cenv.GetTable (tab:TableName) = cenv.tables.[tab.Index] - member cenv.AddCode ((reqdStringFixupsOffset,requiredStringFixups),code) = + member cenv.AddCode ((reqdStringFixupsOffset, requiredStringFixups), code) = if align 4 cenv.nextCodeAddr <> cenv.nextCodeAddr then dprintn "warning: code not 4-byte aligned" cenv.requiredStringFixups <- (cenv.nextCodeAddr + reqdStringFixupsOffset, requiredStringFixups) :: cenv.requiredStringFixups cenv.codeChunks.EmitBytes code @@ -613,17 +613,17 @@ 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 - elif compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2,0 - else 1,0 + 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 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." - if compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2,5 - else 2,0 + if compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2, 5 + else 2, 0 let peOptionalHeaderByteByCLRVersion v = // A flag in the PE file optional header seems to depend on CLI version @@ -643,7 +643,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 @@ -670,8 +670,8 @@ let GetStringHeapIdxOption cenv sopt = | None -> 0 let GetTypeNameAsElemPair cenv n = - let (n1,n2) = splitTypeNameRight n - StringE (GetStringHeapIdxOption cenv n1), + let (n1, n2) = splitTypeNameRight n + StringE (GetStringHeapIdxOption cenv n1), StringE (GetStringHeapIdx cenv n2) //===================================================================== @@ -679,7 +679,7 @@ let GetTypeNameAsElemPair cenv n = //===================================================================== let rec GenTypeDefPass1 enc cenv (td:ILTypeDef) = - ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_,n)) -> n) (TdKey (enc,td.Name))) + ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_, n)) -> n) (TdKey (enc, td.Name))) GenTypeDefsPass1 (enc@[td.Name]) cenv td.NestedTypes.AsList and GenTypeDefsPass1 enc cenv tds = List.iter (GenTypeDefPass1 enc cenv) tds @@ -692,8 +692,8 @@ 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)) + 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)) 0 // -------------------------------------------------------------------- @@ -702,17 +702,17 @@ let rec GetIdxForTypeDef cenv key = let rec GetAssemblyRefAsRow cenv (aref:ILAssemblyRef) = AssemblyRefRow - ((match aref.Version with None -> 0us | Some (x,_,_,_) -> x), - (match aref.Version with None -> 0us | Some (_,y,_,_) -> y), - (match aref.Version with None -> 0us | Some (_,_,z,_) -> z), - (match aref.Version with None -> 0us | Some (_,_,_,w) -> w), + ((match aref.Version with None -> 0us | Some (x, _, _, _) -> x), + (match aref.Version with None -> 0us | Some (_, y, _, _) -> y), + (match aref.Version with None -> 0us | Some (_, _, z, _) -> z), + (match aref.Version with None -> 0us | Some (_, _, _, w) -> w), ((match aref.PublicKey with Some (PublicKey _) -> 0x0001 | _ -> 0x0000) - ||| (if aref.Retargetable then 0x0100 else 0x0000)), + ||| (if aref.Retargetable then 0x0100 else 0x0000)), BlobIndex (match aref.PublicKey with | 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), + | 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), BlobIndex (match aref.Hash with None -> 0 | Some s -> GetBytesAsBlobIdx cenv s)) and GetAssemblyRefAsIdx cenv aref = @@ -757,40 +757,40 @@ let GetScopeRefAsImplementationElem cenv scoref = // -------------------------------------------------------------------- let rec GetTypeRefAsTypeRefRow cenv (tref:ILTypeRef) = - let nselem,nelem = GetTypeNameAsElemPair cenv tref.Name - let rs1,rs2 = GetResolutionScopeAsElem cenv (tref.Scope,tref.Enclosing) - SharedRow [| ResolutionScope (rs1,rs2); nelem; nselem |] + let nselem, nelem = GetTypeNameAsElemPair cenv tref.Name + let rs1, rs2 = GetResolutionScopeAsElem cenv (tref.Scope, tref.Enclosing) + SharedRow [| ResolutionScope (rs1, rs2); nelem; nselem |] and GetTypeRefAsTypeRefIdx cenv tref = let mutable res = 0 - if cenv.trefCache.TryGetValue(tref,&res) then res else + if cenv.trefCache.TryGetValue(tref, &res) then res else let res = FindOrAddSharedRow cenv TableNames.TypeRef (GetTypeRefAsTypeRefRow cenv tref) cenv.trefCache.[tref] <- res res -and GetTypeDescAsTypeRefIdx cenv (scoref,enc,n) = - GetTypeRefAsTypeRefIdx cenv (mkILNestedTyRef (scoref,enc,n)) +and GetTypeDescAsTypeRefIdx cenv (scoref, enc, n) = + GetTypeRefAsTypeRefIdx cenv (mkILNestedTyRef (scoref, enc, n)) -and GetResolutionScopeAsElem cenv (scoref,enc) = +and GetResolutionScopeAsElem cenv (scoref, enc) = if isNil enc then match scoref with | ILScopeRef.Local -> (rs_Module, 1) | ILScopeRef.Assembly aref -> (rs_AssemblyRef, GetAssemblyRefAsIdx cenv aref) | ILScopeRef.Module mref -> (rs_ModuleRef, GetModuleRefAsIdx cenv mref) else - let enc2,n2 = List.frontAndBack enc - (rs_TypeRef, GetTypeDescAsTypeRefIdx cenv (scoref,enc2,n2)) + let enc2, n2 = List.frontAndBack enc + (rs_TypeRef, GetTypeDescAsTypeRefIdx cenv (scoref, enc2, n2)) -let emitTypeInfoAsTypeDefOrRefEncoded cenv (bb: ByteBuffer) (scoref,enc,nm) = +let emitTypeInfoAsTypeDefOrRefEncoded cenv (bb: ByteBuffer) (scoref, enc, nm) = if isScopeRefLocal scoref then - let idx = GetIdxForTypeDef cenv (TdKey(enc,nm)) + let idx = GetIdxForTypeDef cenv (TdKey(enc, nm)) bb.EmitZ32 (idx <<< 2) // ECMA 22.2.8 TypeDefOrRefEncoded - ILTypeDef else - let idx = GetTypeDescAsTypeRefIdx cenv (scoref,enc,nm) + let idx = GetTypeDescAsTypeRefIdx cenv (scoref, enc, nm) bb.EmitZ32 ((idx <<< 2) ||| 0x01) // ECMA 22.2.8 TypeDefOrRefEncoded - ILTypeRef -let getTypeDefOrRefAsUncodedToken (tag,idx) = +let getTypeDefOrRefAsUncodedToken (tag, idx) = let tab = if tag = tdor_TypeDef then TableNames.TypeDef elif tag = tdor_TypeRef then TableNames.TypeRef @@ -800,13 +800,13 @@ let getTypeDefOrRefAsUncodedToken (tag,idx) = // REVIEW: write into an accumuating buffer let EmitArrayShape (bb: ByteBuffer) (ILArrayShape shape) = - let sized = List.filter (function (_,Some _) -> true | _ -> false) shape - let lobounded = List.filter (function (Some _,_) -> true | _ -> false) shape + let sized = List.filter (function (_, Some _) -> true | _ -> false) shape + let lobounded = List.filter (function (Some _, _) -> true | _ -> false) shape bb.EmitZ32 shape.Length bb.EmitZ32 sized.Length - sized |> List.iter (function (_,Some sz) -> bb.EmitZ32 sz | _ -> failwith "?") + sized |> List.iter (function (_, Some sz) -> bb.EmitZ32 sz | _ -> failwith "?") bb.EmitZ32 lobounded.Length - lobounded |> List.iter (function (Some low,_) -> bb.EmitZ32 low | _ -> failwith "?") + lobounded |> List.iter (function (Some low, _) -> bb.EmitZ32 low | _ -> failwith "?") let hasthisToByte hasthis = match hasthis with @@ -814,7 +814,7 @@ let hasthisToByte hasthis = | ILThisConvention.InstanceExplicit -> e_IMAGE_CEE_CS_CALLCONV_INSTANCE_EXPLICIT | ILThisConvention.Static -> 0x00uy -let callconvToByte ntypars (Callconv (hasthis,bcc)) = +let callconvToByte ntypars (Callconv (hasthis, bcc)) = hasthisToByte hasthis ||| (if ntypars > 0 then e_IMAGE_CEE_CS_CALLCONV_GENERIC else 0x00uy) ||| (match bcc with @@ -827,21 +827,21 @@ let callconvToByte ntypars (Callconv (hasthis,bcc)) = // REVIEW: write into an accumuating buffer -let rec EmitTypeSpec cenv env (bb: ByteBuffer) (et,tspec:ILTypeSpec) = +let rec EmitTypeSpec cenv env (bb: ByteBuffer) (et, tspec:ILTypeSpec) = if isNil tspec.GenericArgs then bb.EmitByte et - emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope,tspec.Enclosing,tspec.Name) + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope, tspec.Enclosing, tspec.Name) else bb.EmitByte et_WITH bb.EmitByte et - emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope,tspec.Enclosing,tspec.Name) + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope, tspec.Enclosing, tspec.Name) bb.EmitZ32 tspec.GenericArgs.Length EmitTypes cenv env bb tspec.GenericArgs and GetTypeAsTypeDefOrRef cenv env (ty:ILType) = if isTypeLocal ty then let tref = ty.TypeRef - (tdor_TypeDef, GetIdxForTypeDef cenv (TdKey(tref.Enclosing,tref.Name))) + (tdor_TypeDef, GetIdxForTypeDef cenv (TdKey(tref.Enclosing, tref.Name))) elif ty.IsNominal && isNil ty.GenericArgs then (tdor_TypeRef, GetTypeRefAsTypeRefIdx cenv ty.TypeRef) else @@ -884,9 +884,9 @@ and EmitType cenv env bb ty = | typ when isILUIntPtrTy typ -> bb.EmitByte et_U | typ when isILTypedReferenceTy typ -> 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) -> + | 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 -> @@ -908,10 +908,10 @@ and EmitType cenv env bb ty = bb.EmitByte et_VOID | ILType.FunctionPointer x -> bb.EmitByte et_FNPTR - EmitCallsig cenv env bb (x.CallingConv,x.ArgTypes,x.ReturnType,None,0) - | ILType.Modified (req,tref,ty) -> + EmitCallsig cenv env bb (x.CallingConv, x.ArgTypes, x.ReturnType, None, 0) + | ILType.Modified (req, tref, ty) -> bb.EmitByte (if req then et_CMOD_REQD else et_CMOD_OPT) - emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tref.Scope, tref.Enclosing,tref.Name) + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tref.Scope, tref.Enclosing, tref.Name) EmitType cenv env bb ty | _ -> failwith "EmitType" @@ -920,7 +920,7 @@ and EmitLocalInfo cenv env (bb:ByteBuffer) (l:ILLocal) = bb.EmitByte et_PINNED EmitType cenv env bb l.Type -and EmitCallsig cenv env bb (callconv,args:ILTypes,ret,varargs:ILVarArgs,genarity) = +and EmitCallsig cenv env bb (callconv, args:ILTypes, ret, varargs:ILVarArgs, genarity) = bb.EmitByte (callconvToByte genarity callconv) if genarity > 0 then bb.EmitZ32 genarity bb.EmitZ32 ((args.Length + (match varargs with None -> 0 | Some l -> l.Length))) @@ -942,9 +942,9 @@ and EmitTypes cenv env bb (inst: ILTypes) = let GetTypeAsMemberRefParent cenv env ty = match GetTypeAsTypeDefOrRef cenv env ty with - | (tag,_) when tag = tdor_TypeDef -> dprintn "GetTypeAsMemberRefParent: mspec should have been encoded as mdtMethodDef?"; MemberRefParent (mrp_TypeRef, 1) - | (tag,tok) when tag = tdor_TypeRef -> MemberRefParent (mrp_TypeRef, tok) - | (tag,tok) when tag = tdor_TypeSpec -> MemberRefParent (mrp_TypeSpec, tok) + | (tag, _) when tag = tdor_TypeDef -> dprintn "GetTypeAsMemberRefParent: mspec should have been encoded as mdtMethodDef?"; MemberRefParent (mrp_TypeRef, 1) + | (tag, tok) when tag = tdor_TypeRef -> MemberRefParent (mrp_TypeRef, tok) + | (tag, tok) when tag = tdor_TypeSpec -> MemberRefParent (mrp_TypeSpec, tok) | _ -> failwith "GetTypeAsMemberRefParent" @@ -975,7 +975,7 @@ and EmitNativeType bb ty = else match ty with | ILNativeType.Empty -> () - | ILNativeType.Custom (guid,nativeTypeName,custMarshallerName,cookieString) -> + | ILNativeType.Custom (guid, nativeTypeName, custMarshallerName, cookieString) -> let u1 = System.Text.Encoding.UTF8.GetBytes nativeTypeName let u2 = System.Text.Encoding.UTF8.GetBytes custMarshallerName let u3 = cookieString @@ -992,7 +992,7 @@ and EmitNativeType bb ty = | ILNativeType.FixedArray i -> bb.EmitByte nt_FIXEDARRAY bb.EmitZ32 i - | (* COM interop *) ILNativeType.SafeArray (vt,name) -> + | (* COM interop *) ILNativeType.SafeArray (vt, name) -> bb.EmitByte nt_SAFEARRAY bb.EmitZ32 (GetVariantTypeAsInt32 vt) match name with @@ -1000,7 +1000,7 @@ and EmitNativeType bb ty = | 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 *) + | 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) @@ -1011,7 +1011,7 @@ and EmitNativeType bb ty = EmitNativeType bb ntt) match sizeinfo with | None -> () // chunk out with zeroes because some tools (e.g. asmmeta) read these poorly and expect further elements. - | Some (pnum,additive) -> + | Some (pnum, additive) -> // ParamNum bb.EmitZ32 pnum (* ElemMul *) (* z_u32 0x1l *) @@ -1091,7 +1091,7 @@ let GetTypeAccessFlags access = | ILTypeDefAccess.Nested ILMemberAccess.CompilerControlled -> failwith "bad type acccess" let rec GetTypeDefAsRow cenv env _enc (td:ILTypeDef) = - let nselem,nelem = GetTypeNameAsElemPair cenv td.Name + let nselem, nelem = GetTypeNameAsElemPair cenv td.Name let flags = if (isTypeNameForGlobalFunctions td.Name) then 0x00000000 else @@ -1134,7 +1134,7 @@ let rec GetTypeDefAsRow cenv env _enc (td:ILTypeDef) = nselem TypeDefOrRefOrSpec (tdorTag, tdorRow) SimpleIndex (TableNames.Field, cenv.fieldDefs.Count + 1) - SimpleIndex (TableNames.Method,cenv.methodDefIdxsByKey.Count + 1) |] + SimpleIndex (TableNames.Method, cenv.methodDefIdxsByKey.Count + 1) |] and GetTypeOptionAsTypeDefOrRef cenv env tyOpt = match tyOpt with @@ -1152,13 +1152,13 @@ and GetTypeDefAsEventMapRow cenv tidx = SimpleIndex (TableNames.Event, cenv.eventDefs.Count + 1) |] and GetKeyForFieldDef tidx (fd: ILFieldDef) = - FieldDefKey (tidx,fd.Name, fd.Type) + FieldDefKey (tidx, fd.Name, fd.Type) and GenFieldDefPass2 cenv tidx fd = ignore (cenv.fieldDefs.AddUniqueEntry "field" (fun (fdkey:FieldDefKey) -> fdkey.Name) (GetKeyForFieldDef tidx fd)) and GetKeyForMethodDef tidx (md: ILMethodDef) = - MethodDefKey (tidx,md.GenericParams.Length, md.Name, md.Return.Type, md.ParameterTypes, md.CallingConv.IsStatic) + MethodDefKey (tidx, md.GenericParams.Length, md.Name, md.Return.Type, md.ParameterTypes, md.CallingConv.IsStatic) and GenMethodDefPass2 cenv tidx md = let idx = @@ -1179,13 +1179,13 @@ and GetKeyForPropertyDef tidx (x: ILPropertyDef) = PropKey (tidx, x.Name, x.Type, x.Args) and GenPropertyDefPass2 cenv tidx x = - ignore (cenv.propertyDefs.AddUniqueEntry "property" (fun (PropKey (_,n,_,_)) -> n) (GetKeyForPropertyDef tidx x)) + ignore (cenv.propertyDefs.AddUniqueEntry "property" (fun (PropKey (_, n, _, _)) -> n) (GetKeyForPropertyDef tidx x)) and GetTypeAsImplementsRow cenv env tidx ty = - let tdorTag,tdorRow = GetTypeAsTypeDefOrRef cenv env ty + let tdorTag, tdorRow = GetTypeAsTypeDefOrRef cenv env ty UnsharedRow [| SimpleIndex (TableNames.TypeDef, tidx) - TypeDefOrRefOrSpec (tdorTag,tdorRow) |] + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] and GenImplementsPass2 cenv env tidx ty = AddUnsharedRow cenv TableNames.InterfaceImpl (GetTypeAsImplementsRow cenv env tidx ty) |> ignore @@ -1194,12 +1194,12 @@ and GetKeyForEvent tidx (x: ILEventDef) = EventKey (tidx, x.Name) and GenEventDefPass2 cenv tidx x = - ignore (cenv.eventDefs.AddUniqueEntry "event" (fun (EventKey(_,b)) -> b) (GetKeyForEvent tidx x)) + ignore (cenv.eventDefs.AddUniqueEntry "event" (fun (EventKey(_, b)) -> b) (GetKeyForEvent tidx x)) and GenTypeDefPass2 pidx enc cenv (td:ILTypeDef) = try let env = envForTypeDef td - let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Name)) let tidx2 = AddUnsharedRow cenv TableNames.TypeDef (GetTypeDefAsRow cenv env enc td) if tidx <> tidx2 then failwith "index of typedef on second pass does not match index on first pass" @@ -1253,12 +1253,12 @@ let FindMethodDefIdx cenv mdkey = else sofar) None) with | Some x -> x | None -> raise MethodDefNotFound - let (TdKey (tenc,tname)) = typeNameOfIdx mdkey.TypeIdx + let (TdKey (tenc, tname)) = typeNameOfIdx mdkey.TypeIdx dprintn ("The local method '"+(String.concat "." (tenc@[tname]))+"'::'"+mdkey.Name+"' was referenced but not declared") dprintn ("generic arity: "+string mdkey.GenericArity) - cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2,_)) -> + cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2, _)) -> if mdkey2.TypeIdx = mdkey.TypeIdx && mdkey.Name = mdkey2.Name then - let (TdKey (tenc2,tname2)) = typeNameOfIdx mdkey2.TypeIdx + let (TdKey (tenc2, tname2)) = typeNameOfIdx mdkey2.TypeIdx dprintn ("A method in '"+(String.concat "." (tenc2@[tname2]))+"' had the right name but the wrong signature:") dprintn ("generic arity: "+string mdkey2.GenericArity) dprintn (sprintf "mdkey2: %+A" mdkey2)) @@ -1271,7 +1271,7 @@ let rec GetMethodDefIdx cenv md = and FindFieldDefIdx cenv fdkey = try cenv.fieldDefs.GetTableEntry fdkey with :? KeyNotFoundException -> - errorR(InternalError("The local field "+fdkey.Name+" was referenced but not declared",range0)) + errorR(InternalError("The local field "+fdkey.Name+" was referenced but not declared", range0)) 1 and GetFieldDefAsFieldDefIdx cenv tidx fd = @@ -1289,28 +1289,28 @@ let GetMethodRefAsMethodDefIdx cenv (mref:ILMethodRef) = try if not (isTypeRefLocal tref) then failwithf "method referred to by method impl, event or property is not in a type defined in this module, method ref is %A" mref - let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing,tref.Name)) - let mdkey = MethodDefKey (tidx,mref.GenericArity, mref.Name, mref.ReturnType, mref.ArgTypes, mref.CallingConv.IsStatic) + let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing, tref.Name)) + 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 -let rec MethodRefInfoAsMemberRefRow cenv env fenv (nm,typ,callconv,args,ret,varargs,genarity) = - MemberRefRow(GetTypeAsMemberRefParent cenv env typ, - GetStringHeapIdx cenv nm, - GetMethodRefInfoAsBlobIdx cenv fenv (callconv,args,ret,varargs,genarity)) +let rec MethodRefInfoAsMemberRefRow cenv env fenv (nm, typ, callconv, args, ret, varargs, genarity) = + MemberRefRow(GetTypeAsMemberRefParent cenv env typ, + GetStringHeapIdx cenv nm, + GetMethodRefInfoAsBlobIdx cenv fenv (callconv, args, ret, varargs, genarity)) and GetMethodRefInfoAsBlobIdx cenv env info = GetBytesAsBlobIdx cenv (GetCallsigAsBytes cenv env info) -let GetMethodRefInfoAsMemberRefIdx cenv env ((_,typ,_,_,_,_,_) as minfo) = +let GetMethodRefInfoAsMemberRefIdx cenv env ((_, typ, _, _, _, _, _) as minfo) = let fenv = envForMethodRef env typ FindOrAddSharedRow cenv TableNames.MemberRef (MethodRefInfoAsMemberRefRow cenv env fenv minfo) -let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm,typ:ILType,cc,args,ret,varargs,genarity) as minfo) = +let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm, typ:ILType, cc, args, ret, varargs, genarity) as minfo) = if Option.isNone varargs && (isAlwaysMethodDef || isTypeLocal typ) then if not typ.IsNominal then failwith "GetMethodRefInfoAsMethodRefOrDef: unexpected local tref-typ" - try (mdor_MethodDef, GetMethodRefAsMethodDefIdx cenv (mkILMethRef (typ.TypeRef, cc, nm, genarity, args,ret))) + try (mdor_MethodDef, GetMethodRefAsMethodDefIdx cenv (mkILMethRef (typ.TypeRef, cc, nm, genarity, args, ret))) with MethodDefNotFound -> (mdor_MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) else (mdor_MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) @@ -1319,8 +1319,8 @@ let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm,typ:ILType, // ILMethodSpec --> ILMethodRef/ILMethodDef/ILMethodSpec // -------------------------------------------------------------------- -let rec GetMethodSpecInfoAsMethodSpecIdx cenv env (nm,typ,cc,args,ret,varargs,minst:ILGenericArgs) = - let mdorTag,mdorRow = GetMethodRefInfoAsMethodRefOrDef false cenv env (nm,typ,cc,args,ret,varargs,minst.Length) +let rec GetMethodSpecInfoAsMethodSpecIdx cenv env (nm, typ, cc, args, ret, varargs, minst:ILGenericArgs) = + let mdorTag, mdorRow = GetMethodRefInfoAsMethodRefOrDef false cenv env (nm, typ, cc, args, ret, varargs, minst.Length) let blob = emitBytesViaBuffer (fun bb -> bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_GENERICINST @@ -1328,17 +1328,17 @@ let rec GetMethodSpecInfoAsMethodSpecIdx cenv env (nm,typ,cc,args,ret,varargs,mi minst |> List.iter (EmitType cenv env bb)) FindOrAddSharedRow cenv TableNames.MethodSpec (SharedRow - [| MethodDefOrRef (mdorTag,mdorRow) + [| MethodDefOrRef (mdorTag, mdorRow) Blob (GetBytesAsBlobIdx cenv blob) |]) -and GetMethodDefOrRefAsUncodedToken (tag,idx) = +and GetMethodDefOrRefAsUncodedToken (tag, idx) = let tab = if tag = mdor_MethodDef then TableNames.Method elif tag = mdor_MemberRef then TableNames.MemberRef else failwith "GetMethodDefOrRefAsUncodedToken" getUncodedToken tab idx -and GetMethodSpecInfoAsUncodedToken cenv env ((_,_,_,_,_,_,minst:ILGenericArgs) as minfo) = +and GetMethodSpecInfoAsUncodedToken cenv env ((_, _, _, _, _, _, minst:ILGenericArgs) as minfo) = if minst.Length > 0 then getUncodedToken TableNames.MethodSpec (GetMethodSpecInfoAsMethodSpecIdx cenv env minfo) else @@ -1347,22 +1347,22 @@ and GetMethodSpecInfoAsUncodedToken cenv env ((_,_,_,_,_,_,minst:ILGenericArgs) and GetMethodSpecAsUncodedToken cenv env mspec = GetMethodSpecInfoAsUncodedToken cenv env (InfoOfMethodSpec mspec) -and GetMethodRefInfoOfMethodSpecInfo (nm,typ,cc,args,ret,varargs,minst:ILGenericArgs) = - (nm,typ,cc,args,ret,varargs,minst.Length) +and GetMethodRefInfoOfMethodSpecInfo (nm, typ, cc, args, ret, varargs, minst:ILGenericArgs) = + (nm, typ, cc, args, ret, varargs, minst.Length) -and GetMethodSpecAsMethodDefOrRef cenv env (mspec,varargs) = - GetMethodRefInfoAsMethodRefOrDef false cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec,varargs))) +and GetMethodSpecAsMethodDefOrRef cenv env (mspec, varargs) = + GetMethodRefInfoAsMethodRefOrDef false cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec, varargs))) -and GetMethodSpecAsMethodDef cenv env (mspec,varargs) = - GetMethodRefInfoAsMethodRefOrDef true cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec,varargs))) +and GetMethodSpecAsMethodDef cenv env (mspec, varargs) = + GetMethodRefInfoAsMethodRefOrDef true cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec, varargs))) -and InfoOfMethodSpec (mspec:ILMethodSpec,varargs) = - (mspec.Name, - mspec.EnclosingType, - mspec.CallingConv, - mspec.FormalArgTypes, - mspec.FormalReturnType, - varargs, +and InfoOfMethodSpec (mspec:ILMethodSpec, varargs) = + (mspec.Name, + mspec.EnclosingType, + mspec.CallingConv, + mspec.FormalArgTypes, + mspec.FormalReturnType, + varargs, mspec.GenericArgs) // -------------------------------------------------------------------- @@ -1452,8 +1452,8 @@ and GenSecurityDeclsPass3 cenv hds attrs = // -------------------------------------------------------------------- let rec GetFieldSpecAsMemberRefRow cenv env fenv (fspec:ILFieldSpec) = - MemberRefRow (GetTypeAsMemberRefParent cenv env fspec.EnclosingType, - GetStringHeapIdx cenv fspec.Name, + MemberRefRow (GetTypeAsMemberRefParent cenv env fspec.EnclosingType, + GetStringHeapIdx cenv fspec.Name, GetFieldSpecSigAsBlobIdx cenv fenv fspec) and GetFieldSpecAsMemberRefIdx cenv env fspec = @@ -1476,13 +1476,13 @@ and GetFieldSpecAsFieldDefOrRef cenv env (fspec:ILFieldSpec) = if isTypeLocal typ then if not typ.IsNominal then failwith "GetFieldSpecAsFieldDefOrRef: unexpected local tref-typ" let tref = typ.TypeRef - let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing,tref.Name)) - let fdkey = FieldDefKey (tidx,fspec.Name, fspec.FormalType) + let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing, tref.Name)) + let fdkey = FieldDefKey (tidx, fspec.Name, fspec.FormalType) (true, FindFieldDefIdx cenv fdkey) else (false, GetFieldSpecAsMemberRefIdx cenv env fspec) -and GetFieldDefOrRefAsUncodedToken (tag,idx) = +and GetFieldDefOrRefAsUncodedToken (tag, idx) = let tab = if tag then TableNames.Field else TableNames.MemberRef getUncodedToken tab idx @@ -1490,11 +1490,11 @@ and GetFieldDefOrRefAsUncodedToken (tag,idx) = // callsig --> StandAloneSig // -------------------------------------------------------------------- -let GetCallsigAsBlobIdx cenv env (callsig:ILCallingSignature,varargs) = +let GetCallsigAsBlobIdx cenv env (callsig:ILCallingSignature, varargs) = GetBytesAsBlobIdx cenv - (GetCallsigAsBytes cenv env (callsig.CallingConv, - callsig.ArgTypes, - callsig.ReturnType,varargs,0)) + (GetCallsigAsBytes cenv env (callsig.CallingConv, + callsig.ArgTypes, + callsig.ReturnType, varargs, 0)) let GetCallsigAsStandAloneSigRow cenv env x = SharedRow [| Blob (GetCallsigAsBlobIdx cenv env x) |] @@ -1551,7 +1551,7 @@ type CodeBuffer = code= ByteBuffer.Create 200 reqdBrFixups=[] reqdStringFixupsInMethod=[] - availBrFixups = Dictionary<_,_>(10, HashIdentity.Structural) + availBrFixups = Dictionary<_, _>(10, HashIdentity.Structural) seqpoints = new ResizeArray<_>(10) } @@ -1612,15 +1612,15 @@ module Codebuf = if c = 0 then i elif c < 0 then go n (i-1) else go (i+1) m go 0 (Array.length arr) - let applyBrFixups (origCode :byte[]) origExnClauses origReqdStringFixups (origAvailBrFixups: Dictionary) origReqdBrFixups origSeqPoints origScopes = - let orderedOrigReqdBrFixups = origReqdBrFixups |> List.sortBy (fun (_,fixuploc,_) -> fixuploc) + let applyBrFixups (origCode :byte[]) origExnClauses origReqdStringFixups (origAvailBrFixups: Dictionary) origReqdBrFixups origSeqPoints origScopes = + let orderedOrigReqdBrFixups = origReqdBrFixups |> List.sortBy (fun (_, fixuploc, _) -> fixuploc) 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 // gumpf that refers to fixed offsets in the code stream. - let newCode, newReqdBrFixups,adjuster = + let newCode, newReqdBrFixups, adjuster = let remainingReqdFixups = ref orderedOrigReqdBrFixups let origWhere = ref 0 let newWhere = ref 0 @@ -1637,7 +1637,7 @@ module Codebuf = let origEndOfNoBranchBlock = if doingLast then origCode.Length else - let (_,origStartOfInstr,_) = List.head !remainingReqdFixups + let (_, origStartOfInstr, _) = List.head !remainingReqdFixups origStartOfInstr // Copy over a chunk of non-branching code @@ -1646,7 +1646,7 @@ module Codebuf = // Record how to adjust addresses in this range, including the branch instruction // we write below, or the end of the method if we're doing the last bblock - adjustments := (origStartOfNoBranchBlock,origEndOfNoBranchBlock,newStartOfNoBranchBlock) :: !adjustments + adjustments := (origStartOfNoBranchBlock, origEndOfNoBranchBlock, newStartOfNoBranchBlock) :: !adjustments // Increment locations to the branch instruction we're really interested in origWhere := origEndOfNoBranchBlock @@ -1656,7 +1656,7 @@ module Codebuf = if doingLast then doneLast := true else - let (i,origStartOfInstr,tgs:ILCodeLabel list) = List.head !remainingReqdFixups + let (i, origStartOfInstr, tgs:ILCodeLabel list) = List.head !remainingReqdFixups remainingReqdFixups := List.tail !remainingReqdFixups if origCode.[origStartOfInstr] <> 0x11uy then failwith "br fixup sanity check failed (1)" let i_length = if fst i = i_switch then 5 else 1 @@ -1667,8 +1667,8 @@ module Codebuf = let newEndOfInstrIfBig = !newWhere + i_length + 4 * tgs.Length let short = - match i,tgs with - | (_,Some i_short),[tg] + match i, tgs with + | (_, Some i_short), [tg] when begin // Use the original offsets to compute if the branch is small or large. This is @@ -1684,7 +1684,7 @@ module Codebuf = -> newCode.EmitIntAsByte i_short true - | (i_long,_),_ -> + | (i_long, _), _ -> newCode.EmitIntAsByte i_long (if i_long = i_switch then newCode.EmitInt32 tgs.Length) @@ -1714,11 +1714,11 @@ module Codebuf = let arr = Array.ofList (List.rev !adjustments) fun addr -> let i = - try binaryChop (fun (a1,a2,_) -> if addr < a1 then -1 elif addr > a2 then 1 else 0) arr + try binaryChop (fun (a1, a2, _) -> if addr < a1 then -1 elif addr > a2 then 1 else 0) arr with :? KeyNotFoundException -> failwith ("adjuster: address "+string addr+" is out of range") - let (origStartOfNoBranchBlock,_,newStartOfNoBranchBlock) = arr.[i] + let (origStartOfNoBranchBlock, _, newStartOfNoBranchBlock) = arr.[i] addr - (origStartOfNoBranchBlock - newStartOfNoBranchBlock) newCode.Close(), @@ -1727,16 +1727,16 @@ module Codebuf = // Now adjust everything let newAvailBrFixups = - let tab = Dictionary<_,_>(10, HashIdentity.Structural) - for (KeyValue(tglab,origBrDest)) in origAvailBrFixups do + let tab = Dictionary<_, _>(10, HashIdentity.Structural) + for (KeyValue(tglab, origBrDest)) in origAvailBrFixups do tab.[tglab] <- adjuster origBrDest tab - let newReqdStringFixups = List.map (fun (origFixupLoc,stok) -> adjuster origFixupLoc,stok) origReqdStringFixups + 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 let newExnClauses = - origExnClauses |> List.map (fun (st1,sz1,st2,sz2,kind) -> - (adjuster st1,(adjuster (st1 + sz1) - adjuster st1), - adjuster st2,(adjuster (st2 + sz2) - adjuster st2), + origExnClauses |> List.map (fun (st1, sz1, st2, sz2, kind) -> + (adjuster st1, (adjuster (st1 + sz1) - adjuster st1), + adjuster st2, (adjuster (st2 + sz2) - adjuster st2), (match kind with | FinallyClause | FaultClause | TypeFilterClause _ -> kind | FilterClause n -> FilterClause (adjuster n)))) @@ -1749,7 +1749,7 @@ module Codebuf = List.map remap origScopes // Now apply the adjusted fixups in the new code - newReqdBrFixups |> List.iter (fun (newFixupLoc,endOfInstr,tg, small) -> + newReqdBrFixups |> List.iter (fun (newFixupLoc, endOfInstr, tg, small) -> if not (newAvailBrFixups.ContainsKey tg) then failwith ("target "+formatCodeLabel tg+" not found in new fixups") try @@ -1783,10 +1783,10 @@ module Codebuf = // for all instructions. // -------------------------------------------------------------------- - let encodingsForNoArgInstrs = Dictionary<_,_>(300, HashIdentity.Structural) + let encodingsForNoArgInstrs = Dictionary<_, _>(300, HashIdentity.Structural) let _ = List.iter - (fun (x,mk) -> encodingsForNoArgInstrs.[mk] <- x) + (fun (x, mk) -> encodingsForNoArgInstrs.[mk] <- x) (noArgInstrs.Force()) let encodingsOfNoArgInstr si = encodingsForNoArgInstrs.[si] @@ -1819,7 +1819,7 @@ module Codebuf = emitInstrCode codebuf i codebuf.EmitUncodedToken (GetFieldDefOrRefAsUncodedToken (GetFieldSpecAsFieldDefOrRef cenv env fspec)) - let emitShortUInt16Instr codebuf (i_short,i) x = + let emitShortUInt16Instr codebuf (i_short, i) x = let n = int32 x if n <= 255 then emitInstrCode codebuf i_short @@ -1828,7 +1828,7 @@ module Codebuf = emitInstrCode codebuf i codebuf.EmitUInt16 x - let emitShortInt32Instr codebuf (i_short,i) x = + let emitShortInt32Instr codebuf (i_short, i) x = if x >= (-128) && x <= 127 then emitInstrCode codebuf i_short codebuf.EmitByte (if x < 0x0 then x + 256 else x) @@ -1860,55 +1860,55 @@ 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_br tg -> codebuf.RecordReqdBrFixup (i_br, Some i_br_s) tg | 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_leave tg -> codebuf.RecordReqdBrFixup (i_leave, Some i_leave_s) tg + | I_call (tl, mspec, varargs) -> emitTailness cenv codebuf tl - emitMethodSpecInstr cenv codebuf env i_call (mspec,varargs) + 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) + 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) + emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) //emitAfterTailcall codebuf tl - | I_newobj (mspec,varargs) -> - emitMethodSpecInstr cenv codebuf env i_newobj (mspec,varargs) + | I_newobj (mspec, varargs) -> + emitMethodSpecInstr cenv codebuf env i_newobj (mspec, varargs) | I_ldftn mspec -> - emitMethodSpecInstr cenv codebuf env i_ldftn (mspec,None) + emitMethodSpecInstr cenv codebuf env i_ldftn (mspec, None) | I_ldvirtftn mspec -> - emitMethodSpecInstr cenv codebuf env i_ldvirtftn (mspec,None) + 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))) + 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 | (AI_ldc (DT_I4, ILConst.I4 x)) -> - emitShortInt32Instr codebuf (i_ldc_i4_s,i_ldc_i4) x + emitShortInt32Instr codebuf (i_ldc_i4_s, i_ldc_i4) x | (AI_ldc (DT_I8, ILConst.I8 x)) -> emitInstrCode codebuf i_ldc_i8 codebuf.EmitInt64 x @@ -1919,7 +1919,7 @@ 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 @@ -1966,7 +1966,7 @@ module Codebuf = | 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 @@ -1981,24 +1981,24 @@ module Codebuf = | 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 -> 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 -> 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 @@ -2008,20 +2008,20 @@ module Codebuf = (match tok with | ILToken.ILType typ -> match GetTypeAsTypeDefOrRef cenv env typ with - | (tag,idx) when tag = tdor_TypeDef -> getUncodedToken TableNames.TypeDef idx - | (tag,idx) when tag = tdor_TypeRef -> getUncodedToken TableNames.TypeRef idx - | (tag,idx) when tag = tdor_TypeSpec -> getUncodedToken TableNames.TypeSpec idx + | (tag, idx) when tag = tdor_TypeDef -> getUncodedToken TableNames.TypeDef idx + | (tag, idx) when tag = tdor_TypeRef -> getUncodedToken TableNames.TypeRef idx + | (tag, idx) when tag = tdor_TypeSpec -> getUncodedToken TableNames.TypeSpec idx | _ -> failwith "?" | ILToken.ILMethod mspec -> - match GetMethodSpecAsMethodDefOrRef cenv env (mspec,None) with - | (tag,idx) when tag = mdor_MethodDef -> getUncodedToken TableNames.Method idx - | (tag,idx) when tag = mdor_MemberRef -> getUncodedToken TableNames.MemberRef idx + match GetMethodSpecAsMethodDefOrRef cenv env (mspec, None) with + | (tag, idx) when tag = mdor_MethodDef -> getUncodedToken TableNames.Method idx + | (tag, idx) when tag = mdor_MemberRef -> getUncodedToken TableNames.MemberRef idx | _ -> failwith "?" | ILToken.ILField fspec -> match GetFieldSpecAsFieldDefOrRef cenv env fspec with - | (true,idx) -> getUncodedToken TableNames.Field idx - | (false,idx) -> getUncodedToken TableNames.MemberRef idx) + | (true, idx) -> getUncodedToken TableNames.Field idx + | (false, idx) -> getUncodedToken TableNames.MemberRef idx) | I_ldstr s -> emitInstrCode codebuf i_ldstr codebuf.RecordReqdStringFixup (GetUserStringHeapIdx cenv s) @@ -2030,59 +2030,59 @@ module Codebuf = | 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) -> + | I_newarr (shape, ty) -> if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_newarr ty else let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) - emitMethodSpecInfoInstr cenv codebuf env i_newobj (".ctor",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ILType.Void,None,[]) + emitMethodSpecInfoInstr cenv codebuf env i_newobj (".ctor", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Void, None, []) - | I_stelem_any (shape,ty) -> + | I_stelem_any (shape, ty) -> 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) - emitMethodSpecInfoInstr cenv codebuf env i_call ("Set",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ILType.Void,None,[]) + emitMethodSpecInfoInstr cenv codebuf env i_call ("Set", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Void, None, []) - | I_ldelem_any (shape,ty) -> + | I_ldelem_any (shape, ty) -> if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_ldelem_any ty else 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,[]) + 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 emitTypeInstr cenv codebuf env i_ldelema ty else 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,[]) + 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_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) -> - emitShortInt32Instr codebuf (i_ldc_i4_s,i_ldc_i4) m + | 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" - let mkScopeNode cenv (localSigs: _[]) (startOffset,endOffset,ls: ILLocalDebugMapping list,childScopes) = + let mkScopeNode cenv (localSigs: _[]) (startOffset, endOffset, ls: ILLocalDebugMapping list, childScopes) = if isNil ls || not cenv.generatePdb then childScopes else [ { Children= Array.ofList childScopes @@ -2098,7 +2098,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 @@ -2106,11 +2106,11 @@ module Codebuf = match cl with | ILExceptionClause.Finally r1 -> [r1] | ILExceptionClause.Fault r1 -> [r1] - | ILExceptionClause.FilterCatch (r1,r2) -> [r1;r2] - | ILExceptionClause.TypeCatch (_ty,r1) -> [r1] + | ILExceptionClause.FilterCatch (r1, r2) -> [r1;r2] + | ILExceptionClause.TypeCatch (_ty, r1) -> [r1] - let labelsToRange (lab2pc : Dictionary) p = let (l1,l2) = p in lab2pc.[l1], lab2pc.[l2] + let labelsToRange (lab2pc : Dictionary) p = let (l1, l2) = p in lab2pc.[l1], lab2pc.[l2] let labelRangeInsideLabelRange lab2pc ls1 ls2 = rangeInsideRange (labelsToRange lab2pc ls1) (labelsToRange lab2pc ls2) @@ -2120,16 +2120,16 @@ module Codebuf = let addToRoot roots x = // Look to see if 'x' is inside one of the roots let roots, found = - (false, roots) ||> List.mapFold (fun found (r,children) -> - if found then ((r,children),true) - elif contains x r then ((r,x::children),true) - else ((r,children),false)) + (false, roots) ||> List.mapFold (fun found (r, children) -> + if found then ((r, children), true) + elif contains x r then ((r, x::children), true) + else ((r, children), false)) if found then roots else // Find the ones that 'x' encompasses and collapse them - let yes, others = roots |> List.partition (fun (r,_) -> contains r x) - (x, yes |> List.collect (fun (r,ch) -> r :: ch)) :: others + let yes, others = roots |> List.partition (fun (r, _) -> contains r x) + (x, yes |> List.collect (fun (r, ch) -> r :: ch)) :: others ([], vs) ||> List.fold addToRoot @@ -2150,20 +2150,20 @@ module Codebuf = let roots = findRoots tryspec_inside_tryspec exs let trees = - roots |> List.map (fun (cl,ch) -> + roots |> List.map (fun (cl, ch) -> let r1 = labelsToRange lab2pc cl.Range - let conv ((s1,e1),(s2,e2)) x = pc2pos.[s1], pc2pos.[e1] - pc2pos.[s1], pc2pos.[s2], pc2pos.[e2] - pc2pos.[s2], x + let conv ((s1, e1), (s2, e2)) x = pc2pos.[s1], pc2pos.[e1] - pc2pos.[s1], pc2pos.[s2], pc2pos.[e2] - pc2pos.[s2], x let children = makeSEHTree cenv env pc2pos lab2pc ch let n = match cl.Clause with | ILExceptionClause.Finally r2 -> - conv (r1,labelsToRange lab2pc r2) ExceptionClauseKind.FinallyClause + conv (r1, labelsToRange lab2pc r2) ExceptionClauseKind.FinallyClause | ILExceptionClause.Fault r2 -> - conv (r1,labelsToRange lab2pc r2) ExceptionClauseKind.FaultClause - | ILExceptionClause.FilterCatch ((filterStart,_),r3) -> - conv (r1,labelsToRange lab2pc r3) (ExceptionClauseKind.FilterClause (pc2pos.[lab2pc.[filterStart]])) - | ILExceptionClause.TypeCatch (typ,r2) -> - conv (r1,labelsToRange lab2pc r2) (TypeFilterClause (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env typ))) + conv (r1, labelsToRange lab2pc r2) ExceptionClauseKind.FaultClause + | ILExceptionClause.FilterCatch ((filterStart, _), r3) -> + conv (r1, labelsToRange lab2pc r3) (ExceptionClauseKind.FilterClause (pc2pos.[lab2pc.[filterStart]])) + | ILExceptionClause.TypeCatch (typ, r2) -> + conv (r1, labelsToRange lab2pc r2) (TypeFilterClause (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env typ))) SEHTree.Node (Some n, children) ) trees @@ -2175,16 +2175,16 @@ module Codebuf = let roots = findRoots localInsideLocal exs let trees = - roots |> List.collect (fun (cl,ch) -> - let (s1,e1) = labelsToRange lab2pc cl.Range - let (s1,e1) = pc2pos.[s1], pc2pos.[e1] + roots |> List.collect (fun (cl, ch) -> + let (s1, e1) = labelsToRange lab2pc cl.Range + let (s1, e1) = pc2pos.[s1], pc2pos.[e1] let children = makeLocalsTree cenv localSigs pc2pos lab2pc ch - mkScopeNode cenv localSigs (s1,e1,cl.DebugMappings,children)) + mkScopeNode cenv localSigs (s1, e1, cl.DebugMappings, children)) trees // Emit the SEH tree - let rec emitExceptionHandlerTree (codebuf: CodeBuffer) (Node (x,childSEH)) = + let rec emitExceptionHandlerTree (codebuf: CodeBuffer) (Node (x, childSEH)) = List.iter (emitExceptionHandlerTree codebuf) childSEH // internal first x |> Option.iter codebuf.EmitExceptionClause @@ -2194,7 +2194,7 @@ module Codebuf = // Build a table mapping Abstract IL pcs to positions in the generated code buffer let pc2pos = Array.zeroCreate (instrs.Length+1) let pc2labs = Dictionary() - for (KeyValue(lab,pc)) in code.Labels do + for (KeyValue(lab, pc)) in code.Labels do if pc2labs.ContainsKey pc then pc2labs.[pc] <- lab :: pc2labs.[pc] else pc2labs.[pc] <- [lab] // Emit the instructions @@ -2235,7 +2235,7 @@ module Codebuf = EndOffset=newCode.Length Locals=[| |] } - (newReqdStringFixups,newExnClauses, newCode, newSeqPoints, rootScope) + (newReqdStringFixups, newExnClauses, newCode, newSeqPoints, rootScope) // -------------------------------------------------------------------- // ILMethodBody --> bytes @@ -2256,7 +2256,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = else [| |] - let requiredStringFixups,seh,code,seqpoints, scopes = Codebuf.EmitTopCode cenv localSigs env mname il.Code + let requiredStringFixups, seh, code, seqpoints, scopes = Codebuf.EmitTopCode cenv localSigs env mname il.Code let codeSize = code.Length let methbuf = ByteBuffer.Create (codeSize * 3) // Do we use the tiny format? @@ -2264,7 +2264,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = // Use Tiny format let alignedCodeSize = align 4 (codeSize + 1) let codePadding = (alignedCodeSize - (codeSize + 1)) - let requiredStringFixups' = (1,requiredStringFixups) + let requiredStringFixups' = (1, requiredStringFixups) methbuf.EmitByte (byte codeSize <<< 2 ||| e_CorILMethod_TinyFormat) methbuf.EmitBytes code methbuf.EmitPadding codePadding @@ -2297,7 +2297,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = let smallSize = (seh.Length * 12 + 4) let canUseSmall = smallSize <= 0xFF && - seh |> List.forall (fun (st1,sz1,st2,sz2,_) -> + seh |> List.forall (fun (st1, sz1, st2, sz2, _) -> st1 <= 0xFFFF && st2 <= 0xFFFF && sz1 <= 0xFF && sz2 <= 0xFF) let kindAsInt32 k = @@ -2317,7 +2317,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = methbuf.EmitByte (b0 smallSize) methbuf.EmitByte 0x00uy methbuf.EmitByte 0x00uy - seh |> List.iter (fun (st1,sz1,st2,sz2,kind) -> + seh |> List.iter (fun (st1, sz1, st2, sz2, kind) -> let k32 = kindAsInt32 kind methbuf.EmitInt32AsUInt16 k32 methbuf.EmitInt32AsUInt16 st1 @@ -2331,7 +2331,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = methbuf.EmitByte (b0 bigSize) methbuf.EmitByte (b1 bigSize) methbuf.EmitByte (b2 bigSize) - seh |> List.iter (fun (st1,sz1,st2,sz2,kind) -> + seh |> List.iter (fun (st1, sz1, st2, sz2, kind) -> let k32 = kindAsInt32 kind methbuf.EmitInt32 k32 methbuf.EmitInt32 st1 @@ -2340,7 +2340,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = methbuf.EmitInt32 sz2 methbuf.EmitInt32 (kindAsExtraInt32 kind)) - let requiredStringFixups' = (12,requiredStringFixups) + let requiredStringFixups' = (12, requiredStringFixups) localToken, (requiredStringFixups', methbuf.Close()), seqpoints, scopes @@ -2369,7 +2369,7 @@ and GetFieldDefSigAsBlobIdx cenv env fd = GetFieldDefTypeAsBlobIdx cenv env fd.T and GenFieldDefPass3 cenv env fd = let fidx = AddUnsharedRow cenv TableNames.Field (GetFieldDefAsFieldDefRow cenv env fd) - GenCustomAttrsPass3Or4 cenv (hca_FieldDef,fidx) fd.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_FieldDef, fidx) fd.CustomAttrs // Write FieldRVA table - fixups into data section done later match fd.Data with | None -> () @@ -2377,7 +2377,7 @@ and GenFieldDefPass3 cenv env fd = let offs = cenv.data.Position cenv.data.EmitBytes b AddUnsharedRow cenv TableNames.FieldRVA - (UnsharedRow [| Data (offs, false); SimpleIndex (TableNames.Field,fidx) |]) |> ignore + (UnsharedRow [| Data (offs, false); SimpleIndex (TableNames.Field, fidx) |]) |> ignore // Write FieldMarshal table match fd.Marshal with | None -> () @@ -2416,7 +2416,7 @@ let rec GetGenericParamAsGenericParamRow cenv _env idx owner gp = (if gp.HasNotNullableValueTypeConstraint then 0x0008 else 0x0000) ||| (if gp.HasDefaultConstructorConstraint then 0x0010 else 0x0000) - let mdVersionMajor,_ = metadataSchemaVersionSupportedByCLRVersion cenv.desiredMetadataVersion + let mdVersionMajor, _ = metadataSchemaVersionSupportedByCLRVersion cenv.desiredMetadataVersion if (mdVersionMajor = 1) then SharedRow [| UShort (uint16 idx) @@ -2432,10 +2432,10 @@ let rec GetGenericParamAsGenericParamRow cenv _env idx owner gp = StringE (GetStringHeapIdx cenv gp.Name) |] and GenTypeAsGenericParamConstraintRow cenv env gpidx ty = - let tdorTag,tdorRow = GetTypeAsTypeDefOrRef cenv env ty + let tdorTag, tdorRow = GetTypeAsTypeDefOrRef cenv env ty UnsharedRow [| SimpleIndex (TableNames.GenericParam, gpidx) - TypeDefOrRefOrSpec (tdorTag,tdorRow) |] + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] and GenGenericParamConstraintPass4 cenv env gpidx ty = AddUnsharedRow cenv TableNames.GenericParamConstraint (GenTypeAsGenericParamConstraintRow cenv env gpidx ty) |> ignore @@ -2474,7 +2474,7 @@ and GenParamPass3 cenv env seq (param: ILParameter) = then () else let pidx = AddUnsharedRow cenv TableNames.Param (GetParamAsParamRow cenv env seq param) - GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) param.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ParamDef, pidx) param.CustomAttrs // Write FieldRVA table - fixups into data section done later match param.Marshal with | None -> () @@ -2501,7 +2501,7 @@ let GenReturnAsParamRow (returnv : ILReturn) = let GenReturnPass3 cenv (returnv: ILReturn) = if Option.isSome returnv.Marshal || not (isNil returnv.CustomAttrs.AsList) then let pidx = AddUnsharedRow cenv TableNames.Param (GenReturnAsParamRow returnv) - GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) returnv.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ParamDef, pidx) returnv.CustomAttrs match returnv.Marshal with | None -> () | Some ntyp -> @@ -2586,7 +2586,7 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = Some ({ Document=doc Line=m.Line - Column=m.Column }, + Column=m.Column }, { Document=doc Line=m.EndLine Column=m.EndColumn }) @@ -2616,10 +2616,10 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = UShort (uint16 flags) StringE (GetStringHeapIdx cenv md.Name) Blob (GenMethodDefSigAsBlobIdx cenv env md) - SimpleIndex(TableNames.Param,cenv.GetTable(TableNames.Param).Count + 1) |] + SimpleIndex(TableNames.Param, cenv.GetTable(TableNames.Param).Count + 1) |] let GenMethodImplPass3 cenv env _tgparams tidx mimpl = - let midxTag, midxRow = GetMethodSpecAsMethodDef cenv env (mimpl.OverrideBy,None) + let midxTag, midxRow = GetMethodSpecAsMethodDef cenv env (mimpl.OverrideBy, None) let midx2Tag, midx2Row = GetOverridesSpecAsMethodDefOrRef cenv env mimpl.Overrides AddUnsharedRow cenv TableNames.MethodImpl (UnsharedRow @@ -2633,8 +2633,8 @@ let GenMethodDefPass3 cenv env (md:ILMethodDef) = if midx <> idx2 then failwith "index of method def on pass 3 does not match index on pass 2" GenReturnPass3 cenv md.Return md.Parameters |> List.iteri (fun n param -> GenParamPass3 cenv env (n+1) param) - md.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_MethodDef,midx) - md.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_MethodDef,midx) + md.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_MethodDef, midx) + md.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_MethodDef, midx) md.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_MethodDef, midx) gp) match md.mdBody.Contents with | MethodBody.PInvoke attr -> @@ -2668,7 +2668,7 @@ let GenMethodDefPass3 cenv env (md:ILMethodDef) = AddUnsharedRow cenv TableNames.ImplMap (UnsharedRow [| UShort (uint16 flags) - MemberForwarded (mf_MethodDef,midx) + MemberForwarded (mf_MethodDef, midx) StringE (GetStringHeapIdx cenv attr.Name) SimpleIndex (TableNames.ModuleRef, GetModuleRefAsIdx cenv attr.Where) |]) |> ignore | _ -> () @@ -2683,7 +2683,7 @@ let GenPropertyMethodSemanticsPass3 cenv pidx kind mref = AddUnsharedRow cenv TableNames.MethodSemantics (UnsharedRow [| UShort (uint16 kind) - SimpleIndex (TableNames.Method,midx) + SimpleIndex (TableNames.Method, midx) HasSemantics (hs_Property, pidx) |]) |> ignore let rec GetPropertySigAsBlobIdx cenv env prop = @@ -2721,14 +2721,14 @@ and GenPropertyPass3 cenv env prop = [| GetFieldInitFlags i HasConstant (hc_Property, pidx) Blob (GetFieldInitAsBlobIdx cenv i) |]) |> ignore - GenCustomAttrsPass3Or4 cenv (hca_Property,pidx) prop.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_Property, pidx) prop.CustomAttrs let rec GenEventMethodSemanticsPass3 cenv eidx kind mref = let addIdx = try GetMethodRefAsMethodDefIdx cenv mref with MethodDefNotFound -> 1 AddUnsharedRow cenv TableNames.MethodSemantics (UnsharedRow [| UShort (uint16 kind) - SimpleIndex (TableNames.Method,addIdx) + SimpleIndex (TableNames.Method, addIdx) HasSemantics (hs_Event, eidx) |]) |> ignore /// ILEventDef --> Event Row + MethodSemantics entries @@ -2740,7 +2740,7 @@ and GenEventAsEventRow cenv env (md: ILEventDef) = UnsharedRow [| UShort (uint16 flags) StringE (GetStringHeapIdx cenv md.Name) - TypeDefOrRefOrSpec (tdorTag,tdorRow) |] + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] and GenEventPass3 cenv env (md: ILEventDef) = let eidx = AddUnsharedRow cenv TableNames.Event (GenEventAsEventRow cenv env md) @@ -2748,7 +2748,7 @@ and GenEventPass3 cenv env (md: ILEventDef) = md.RemoveMethod |> GenEventMethodSemanticsPass3 cenv eidx 0x0010 Option.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0020) md.FireMethod List.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0004) md.OtherMethods - GenCustomAttrsPass3Or4 cenv (hca_Event,eidx) md.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_Event, eidx) md.CustomAttrs // -------------------------------------------------------------------- @@ -2756,7 +2756,7 @@ and GenEventPass3 cenv env (md: ILEventDef) = // -------------------------------------------------------------------- let rec GetResourceAsManifestResourceRow cenv r = - let data,impl = + let data, impl = match r.Location with | ILResourceLocation.Local bf -> let b = bf() @@ -2769,8 +2769,8 @@ let rec GetResourceAsManifestResourceRow cenv r = cenv.resources.EmitPadding pad cenv.resources.EmitInt32 resourceSize cenv.resources.EmitBytes b - Data (alignedOffset,true), (i_File, 0) - | ILResourceLocation.File (mref,offset) -> ULong offset, (i_File, GetModuleRefAsFileIdx cenv mref) + Data (alignedOffset, true), (i_File, 0) + | ILResourceLocation.File (mref, offset) -> ULong offset, (i_File, GetModuleRefAsFileIdx cenv mref) | ILResourceLocation.Assembly aref -> ULong 0x0, (i_AssemblyRef, GetAssemblyRefAsIdx cenv aref) UnsharedRow [| data @@ -2780,7 +2780,7 @@ let rec GetResourceAsManifestResourceRow cenv r = and GenResourcePass3 cenv r = let idx = AddUnsharedRow cenv TableNames.ManifestResource (GetResourceAsManifestResourceRow cenv r) - GenCustomAttrsPass3Or4 cenv (hca_ManifestResource,idx) r.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ManifestResource, idx) r.CustomAttrs // -------------------------------------------------------------------- // ILTypeDef --> generate ILFieldDef, ILMethodDef, ILPropertyDef etc. rows @@ -2789,7 +2789,7 @@ and GenResourcePass3 cenv r = let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) = try let env = envForTypeDef td - let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Name)) td.Properties.AsList |> List.iter (GenPropertyPass3 cenv env) td.Events.AsList |> List.iter (GenEventPass3 cenv env) td.Fields.AsList |> List.iter (GenFieldDefPass3 cenv env) @@ -2806,9 +2806,9 @@ let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) = ULong (defaultArg layout.Size 0x0) SimpleIndex (TableNames.TypeDef, tidx) |]) |> ignore - td.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_TypeDef,tidx) - td.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_TypeDef,tidx) - td.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_TypeDef,tidx) gp) + td.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_TypeDef, tidx) + td.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_TypeDef, tidx) + 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) @@ -2824,9 +2824,9 @@ and GenTypeDefsPass3 enc cenv tds = let rec GenTypeDefPass4 enc cenv (td:ILTypeDef) = try let env = envForTypeDef td - let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Name)) td.Methods |> Seq.iter (GenMethodDefPass4 cenv env) - List.iteri (fun n gp -> GenGenericParamPass4 cenv env n (tomd_TypeDef,tidx) gp) td.GenericParams + List.iteri (fun n gp -> GenGenericParamPass4 cenv env n (tomd_TypeDef, tidx) gp) td.GenericParams GenTypeDefsPass4 (enc@[td.Name]) cenv td.NestedTypes.AsList with e -> failwith ("Error in pass4 for type "+td.Name+", error: "+e.Message) @@ -2853,14 +2853,14 @@ let rec GenNestedExportedTypePass3 cenv cidx (ce: ILNestedExportedType) = StringE (GetStringHeapIdx cenv ce.Name) StringE 0 Implementation (i_ExportedType, cidx) |]) - GenCustomAttrsPass3Or4 cenv (hca_ExportedType,nidx) ce.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ExportedType, nidx) ce.CustomAttrs GenNestedExportedTypesPass3 cenv nidx ce.Nested and GenNestedExportedTypesPass3 cenv nidx (nce: ILNestedExportedTypes) = nce.AsList |> List.iter (GenNestedExportedTypePass3 cenv nidx) and GenExportedTypePass3 cenv (ce: ILExportedTypeOrForwarder) = - let nselem,nelem = GetTypeNameAsElemPair cenv ce.Name + let nselem, nelem = GetTypeNameAsElemPair cenv ce.Name let flags = GetTypeAccessFlags ce.Access let flags = if ce.IsForwarder then 0x00200000 ||| flags else flags let impl = GetScopeRefAsImplementationElem cenv ce.ScopeRef @@ -2872,7 +2872,7 @@ and GenExportedTypePass3 cenv (ce: ILExportedTypeOrForwarder) = nelem nselem Implementation (fst impl, snd impl) |]) - GenCustomAttrsPass3Or4 cenv (hca_ExportedType,cidx) ce.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ExportedType, cidx) ce.CustomAttrs GenNestedExportedTypesPass3 cenv cidx ce.Nested and GenExportedTypesPass3 cenv (ce: ILExportedTypesAndForwarders) = @@ -2885,10 +2885,10 @@ and GenExportedTypesPass3 cenv (ce: ILExportedTypesAndForwarders) = and GetManifsetAsAssemblyRow cenv m = UnsharedRow [|ULong m.AuxModuleHashAlgorithm - UShort (match m.Version with None -> 0us | Some (x,_,_,_) -> x) - UShort (match m.Version with None -> 0us | Some (_,y,_,_) -> y) - UShort (match m.Version with None -> 0us | Some (_,_,z,_) -> z) - UShort (match m.Version with None -> 0us | Some (_,_,_,w) -> w) + UShort (match m.Version with None -> 0us | Some (x, _, _, _) -> x) + UShort (match m.Version with None -> 0us | Some (_, y, _, _) -> y) + UShort (match m.Version with None -> 0us | Some (_, _, z, _) -> z) + UShort (match m.Version with None -> 0us | Some (_, _, _, w) -> w) ULong ( (match m.AssemblyLongevity with | ILAssemblyLongevity.Unspecified -> 0x0000 @@ -2908,8 +2908,8 @@ and GetManifsetAsAssemblyRow cenv m = and GenManifestPass3 cenv m = let aidx = AddUnsharedRow cenv TableNames.Assembly (GetManifsetAsAssemblyRow cenv m) - GenSecurityDeclsPass3 cenv (hds_Assembly,aidx) m.SecurityDecls.AsList - GenCustomAttrsPass3Or4 cenv (hca_Assembly,aidx) m.CustomAttrs + GenSecurityDeclsPass3 cenv (hds_Assembly, aidx) m.SecurityDecls.AsList + GenCustomAttrsPass3Or4 cenv (hca_Assembly, aidx) m.CustomAttrs GenExportedTypesPass3 cenv m.ExportedTypes // Record the entrypoint decl if needed. match m.EntrypointElsewhere with @@ -2972,7 +2972,7 @@ let GenModule (cenv : cenv) (modul: ILModuleDef) = (match modul.Manifest with None -> () | Some m -> GenManifestPass3 cenv m) GenTypeDefsPass3 [] cenv tds reportTime cenv.showTimes "Module Generation Pass 3" - GenCustomAttrsPass3Or4 cenv (hca_Module,midx) modul.CustomAttrs + 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 @@ -2981,7 +2981,7 @@ let GenModule (cenv : cenv) (modul: ILModuleDef) = GenTypeDefsPass4 [] cenv tds reportTime cenv.showTimes "Module Generation Pass 4" -let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILGlobals, emitTailcalls, deterministic, showTimes) (m : ILModuleDef) cilStartAddress = +let generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg : ILGlobals, emitTailcalls, deterministic, showTimes) (m : ILModuleDef) cilStartAddress = let isDll = m.IsDLL let cenv = @@ -3007,29 +3007,29 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG i = TableNames.MethodSpec.Index || i = TableNames.StandAloneSig.Index || i = TableNames.GenericParam.Index) then - MetadataTable.Shared (MetadataTable.New ("row table "+string i,EqualityComparer.Default)) + MetadataTable.Shared (MetadataTable.New ("row table "+string i, EqualityComparer.Default)) else - MetadataTable.Unshared (MetadataTable.New ("row table "+string i,EqualityComparer.Default))) + MetadataTable.Unshared (MetadataTable.New ("row table "+string i, EqualityComparer.Default))) - AssemblyRefs = MetadataTable<_>.New("ILAssemblyRef",EqualityComparer.Default) - documents=MetadataTable<_>.New("pdbdocs",EqualityComparer.Default) - trefCache=new Dictionary<_,_>(100) + AssemblyRefs = MetadataTable<_>.New("ILAssemblyRef", EqualityComparer.Default) + documents=MetadataTable<_>.New("pdbdocs", EqualityComparer.Default) + trefCache=new Dictionary<_, _>(100) pdbinfo= new ResizeArray<_>(200) moduleGuid= Array.zeroCreate 16 - fieldDefs= MetadataTable<_>.New("field defs",EqualityComparer.Default) - methodDefIdxsByKey = MetadataTable<_>.New("method defs",EqualityComparer.Default) + fieldDefs= MetadataTable<_>.New("field defs", EqualityComparer.Default) + methodDefIdxsByKey = MetadataTable<_>.New("method defs", EqualityComparer.Default) // This uses reference identity on ILMethodDef objects - methodDefIdxs = new Dictionary<_,_>(100, HashIdentity.Reference) - propertyDefs = MetadataTable<_>.New("property defs",EqualityComparer.Default) - eventDefs = MetadataTable<_>.New("event defs",EqualityComparer.Default) - typeDefs = MetadataTable<_>.New("type defs",EqualityComparer.Default) + methodDefIdxs = new Dictionary<_, _>(100, HashIdentity.Reference) + propertyDefs = MetadataTable<_>.New("property defs", EqualityComparer.Default) + eventDefs = MetadataTable<_>.New("event defs", EqualityComparer.Default) + typeDefs = MetadataTable<_>.New("type defs", EqualityComparer.Default) entrypoint=None generatePdb=generatePdb // These must use structural comparison since they are keyed by arrays - guids=MetadataTable<_>.New("guids",HashIdentity.Structural) - blobs= MetadataTable<_>.New("blobs",HashIdentity.Structural) - strings= MetadataTable<_>.New("strings",EqualityComparer.Default) - userStrings= MetadataTable<_>.New("user strings",EqualityComparer.Default) } + guids=MetadataTable<_>.New("guids", HashIdentity.Structural) + blobs= MetadataTable<_>.New("blobs", HashIdentity.Structural) + strings= MetadataTable<_>.New("strings", EqualityComparer.Default) + userStrings= MetadataTable<_>.New("user strings", EqualityComparer.Default) } // Now the main compilation step GenModule cenv m @@ -3037,7 +3037,7 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG // .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) -> + | Some (epHere, tok) -> if isDll then 0x0 else getUncodedToken (if epHere then TableNames.Method else TableNames.File) tok | None -> @@ -3082,14 +3082,14 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG // New return the results let data = cenv.data.Close() let resources = cenv.resources.Close() - (strings,userStrings,blobs,guids,tables,entryPointToken,code,cenv.requiredStringFixups,data,resources,pdbData,mappings) + (strings, userStrings, blobs, guids, tables, entryPointToken, code, cenv.requiredStringFixups, data, resources, pdbData, mappings) //===================================================================== // TABLES+BLOBS --> PHYSICAL METADATA+BLOBS //===================================================================== -let chunk sz next = ({addr=next; size=sz},next + sz) -let nochunk next = ({addr= 0x0;size= 0x0; } ,next) +let chunk sz next = ({addr=next; size=sz}, next + sz) +let nochunk next = ({addr= 0x0;size= 0x0; } , next) let count f arr = Array.fold (fun x y -> x + f y) 0x0 arr @@ -3110,13 +3110,13 @@ module FileSystemUtilites = let monoPosix = Assembly.Load("Mono.Posix, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756") if progress then eprintf "loading type Mono.Unix.UnixFileInfo...\n" let monoUnixFileInfo = monoPosix.GetType("Mono.Unix.UnixFileSystemInfo") - let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box filename |],CultureInfo.InvariantCulture) - let prevPermissions = monoUnixFileInfo.InvokeMember("get_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| |],CultureInfo.InvariantCulture) + let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box filename |], CultureInfo.InvariantCulture) + let prevPermissions = monoUnixFileInfo.InvokeMember("get_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| |], CultureInfo.InvariantCulture) let prevPermissionsValue = prevPermissions |> unbox let newPermissionsValue = prevPermissionsValue ||| 0x000001ED let newPermissions = Enum.ToObject(prevPermissions.GetType(), newPermissionsValue) // Add 0x000001ED (UserReadWriteExecute, GroupReadExecute, OtherReadExecute) to the access permissions on Unix - monoUnixFileInfo.InvokeMember("set_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| newPermissions |],CultureInfo.InvariantCulture) |> ignore + monoUnixFileInfo.InvokeMember("set_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| newPermissions |], CultureInfo.InvariantCulture) |> ignore with e -> if progress then eprintf "failure: %s...\n" (e.ToString()) // Fail silently @@ -3126,7 +3126,7 @@ module FileSystemUtilites = #endif () -let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls,deterministic,showTimes) modul cilStartAddress = +let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailcalls, deterministic, showTimes) modul cilStartAddress = // When we know the real RVAs of the data section we fixup the references for the FieldRVA table. // These references are stored as offsets into the metadata we return from this function @@ -3134,8 +3134,8 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls let next = cilStartAddress - let strings,userStrings,blobs,guids,tables,entryPointToken,code,requiredStringFixups,data,resources,pdbData,mappings = - generateIL requiredDataFixups (desiredMetadataVersion,generatePdb,ilg,emitTailcalls,deterministic,showTimes) modul cilStartAddress + let strings, userStrings, blobs, guids, tables, entryPointToken, code, requiredStringFixups, data, resources, pdbData, mappings = + generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg, emitTailcalls, deterministic, showTimes) modul cilStartAddress reportTime showTimes "Generated Tables and Code" let tableSize (tab: TableName) = tables.[tab.Index].Count @@ -3143,19 +3143,19 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // Now place the code let codeSize = code.Length let alignedCodeSize = align 0x4 codeSize - let codep,next = chunk codeSize next + let codep, next = chunk codeSize next let codePadding = Array.create (alignedCodeSize - codeSize) 0x0uy - let _codePaddingChunk,next = chunk codePadding.Length next + let _codePaddingChunk, next = chunk codePadding.Length next // Now layout the chunks of metadata and IL - let metadataHeaderStartChunk,_next = chunk 0x10 next + let metadataHeaderStartChunk, _next = chunk 0x10 next let numStreams = 0x05 let (mdtableVersionMajor, mdtableVersionMinor) = metadataSchemaVersionSupportedByCLRVersion desiredMetadataVersion let version = - let (a,b,c,_) = desiredMetadataVersion + let (a, b, c, _) = desiredMetadataVersion System.Text.Encoding.UTF8.GetBytes (sprintf "v%d.%d.%d" a b c) @@ -3164,13 +3164,13 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // 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 _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 _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 tablesStreamStart = next @@ -3191,13 +3191,13 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls let blobsBig = blobsStreamPaddedSize >= 0x10000 // 64bit bitvector indicating which tables are in the metadata. - let (valid1,valid2),_ = - (((0,0), 0), tables) ||> Array.fold (fun ((valid1,valid2) as valid,n) rows -> + 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 n < 32 then valid1 ||| (1 <<< n ) else valid1), (if n >= 32 then valid2 ||| (1 <<< (n-32)) else valid2) ) - (valid,n+1)) + (valid, n+1)) // 64bit bitvector indicating which tables are sorted. // Constant - REVIEW: make symbolic! compute from sorted table info! @@ -3419,15 +3419,15 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // QUERY: extra 4 empty bytes in array.exe - why? Include some extra padding after // the tables just in case there is a mistake in the ECMA spec. let tablesStreamPaddedSize = align 4 (tablesStreamUnpaddedSize + 4) - let tablesChunk,next = chunk tablesStreamPaddedSize next + let tablesChunk, next = chunk tablesStreamPaddedSize next let tablesStreamPadding = tablesChunk.size - tablesStreamUnpaddedSize - let stringsChunk,next = chunk stringsStreamPaddedSize next + let stringsChunk, next = chunk stringsStreamPaddedSize next let stringsStreamPadding = stringsChunk.size - stringsStreamUnpaddedSize - let userStringsChunk,next = chunk userStringsStreamPaddedSize next + let userStringsChunk, next = chunk userStringsStreamPaddedSize next let userStringsStreamPadding = userStringsChunk.size - userStringsStreamUnpaddedSize - let guidsChunk,next = chunk (0x10 * guids.Length) next - let blobsChunk,_next = chunk blobsStreamPaddedSize next + let guidsChunk, next = chunk (0x10 * guids.Length) next + let blobsChunk, _next = chunk blobsStreamPaddedSize next let blobsStreamPadding = blobsChunk.size - blobsStreamUnpaddedSize reportTime showTimes "Layout Metadata" @@ -3508,7 +3508,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // Now we know the user string tables etc. we can fixup the // uses of strings in the code for (codeStartAddr, l) in requiredStringFixups do - for (codeOffset,userStringIndex) in l do + for (codeOffset, userStringIndex) in l do 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) checkFixup32 code locInCode 0xdeadbeef; @@ -3517,7 +3517,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls applyFixup32 code locInCode token reportTime showTimes "Fixup Metadata"; - entryPointToken,code, codePadding,metadata,data,resources,!requiredDataFixups,pdbData,mappings,guidStart + entryPointToken, code, codePadding, metadata, data, resources, !requiredDataFixups, pdbData, mappings, guidStart //--------------------------------------------------------------------- // PHYSICAL METADATA+BLOBS --> PHYSICAL PE FORMAT @@ -3575,7 +3575,7 @@ let writeDirectory os dict = writeInt32 os (if dict.size = 0x0 then 0x0 else dict.addr); writeInt32 os dict.size -let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk,0,chunk.Length) +let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk, 0, chunk.Length) let writeBinaryAndReportMappings (outfile, ilg: ILGlobals, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB, @@ -3587,7 +3587,7 @@ let writeBinaryAndReportMappings (outfile, let isDll = modul.IsDLL let signer = - match signer,modul.Manifest with + match signer, modul.Manifest with | Some _, _ -> signer | _, None -> signer | None, Some {PublicKey=Some pubkey} -> @@ -3627,7 +3627,7 @@ let writeBinaryAndReportMappings (outfile, with e -> failwith ("Could not open file for writing (binary mode): " + outfile) - let pdbData,pdbOpt,debugDirectoryChunk,debugDataChunk,debugEmbeddedPdbChunk,textV2P,mappings = + let pdbData, pdbOpt, debugDirectoryChunk, debugDataChunk, debugEmbeddedPdbChunk, textV2P, mappings = try let imageBaseReal = modul.ImageBase // FIXED CHOICE @@ -3646,25 +3646,25 @@ let writeBinaryAndReportMappings (outfile, let next = headerAddr let msdosHeaderSize = 0x80 - let msdosHeaderChunk,next = chunk msdosHeaderSize next + let msdosHeaderChunk, next = chunk msdosHeaderSize next let peSignatureSize = 0x04 - let peSignatureChunk,next = chunk peSignatureSize next + let peSignatureChunk, next = chunk peSignatureSize next let peFileHeaderSize = 0x14 - let peFileHeaderChunk,next = chunk peFileHeaderSize next + let peFileHeaderChunk, next = chunk peFileHeaderSize next let peOptionalHeaderSize = if modul.Is64Bit then 0xf0 else 0xe0 - let peOptionalHeaderChunk,next = chunk peOptionalHeaderSize next + let peOptionalHeaderChunk, next = chunk peOptionalHeaderSize next let textSectionHeaderSize = 0x28 - let textSectionHeaderChunk,next = chunk textSectionHeaderSize next + let textSectionHeaderChunk, next = chunk textSectionHeaderSize next let dataSectionHeaderSize = 0x28 - let dataSectionHeaderChunk,next = chunk dataSectionHeaderSize next + let dataSectionHeaderChunk, next = chunk dataSectionHeaderSize next let relocSectionHeaderSize = 0x28 - let relocSectionHeaderChunk,next = chunk relocSectionHeaderSize next + let relocSectionHeaderChunk, next = chunk relocSectionHeaderSize next let headerSize = next - headerAddr let nextPhys = align alignPhys (headerSectionPhysLoc + headerSize) @@ -3677,10 +3677,10 @@ let writeBinaryAndReportMappings (outfile, let textSectionAddr = next let next = textSectionAddr - let importAddrTableChunk,next = chunk 0x08 next + let importAddrTableChunk, next = chunk 0x08 next let cliHeaderPadding = (if isItanium then (align 16 next) else next) - next let next = next + cliHeaderPadding - let cliHeaderChunk,next = chunk 0x48 next + let cliHeaderChunk, next = chunk 0x48 next let desiredMetadataVersion = if modul.MetadataVersion <> "" then @@ -3691,43 +3691,43 @@ let writeBinaryAndReportMappings (outfile, | ILScopeRef.Module(_) -> failwith "Expected mscorlib to be ILScopeRef.Assembly was ILScopeRef.Module" | ILScopeRef.Assembly(aref) -> match aref.Version with - | Some (2us,_,_,_) -> parseILVersion "2.0.50727.0" + | Some (2us, _, _, _) -> parseILVersion "2.0.50727.0" | Some v -> v | None -> failwith "Expected msorlib to have a version number" - let entryPointToken,code,codePadding,metadata,data,resources,requiredDataFixups,pdbData,mappings,guidStart = - writeILMetadataAndCode ((pdbfile <> None), desiredMetadataVersion, ilg,emitTailcalls, deterministic, showTimes) modul next + let entryPointToken, code, codePadding, metadata, data, resources, requiredDataFixups, pdbData, mappings, guidStart = + writeILMetadataAndCode ((pdbfile <> None), desiredMetadataVersion, ilg, emitTailcalls, deterministic, showTimes) modul next reportTime showTimes "Generated IL and metadata"; - let _codeChunk,next = chunk code.Length next - let _codePaddingChunk,next = chunk codePadding.Length next + let _codeChunk, next = chunk code.Length next + let _codePaddingChunk, next = chunk codePadding.Length next - let metadataChunk,next = chunk metadata.Length next + let metadataChunk, next = chunk metadata.Length next - let strongnameChunk,next = + let strongnameChunk, next = match signer with | None -> nochunk next | Some s -> chunk s.SignatureSize next - let resourcesChunk,next = chunk resources.Length next + let resourcesChunk, next = chunk resources.Length next - let rawdataChunk,next = chunk data.Length next + let rawdataChunk, next = chunk data.Length next - let vtfixupsChunk,next = nochunk next // Note: only needed for mixed mode assemblies + let vtfixupsChunk, next = nochunk next // Note: only needed for mixed mode assemblies let importTableChunkPrePadding = (if isItanium then (align 16 next) else next) - next let next = next + importTableChunkPrePadding - let importTableChunk,next = chunk 0x28 next - let importLookupTableChunk,next = chunk 0x14 next - let importNameHintTableChunk,next = chunk 0x0e next - let mscoreeStringChunk,next = chunk 0x0c next + let importTableChunk, next = chunk 0x28 next + let importLookupTableChunk, next = chunk 0x14 next + let importNameHintTableChunk, next = chunk 0x0e next + let mscoreeStringChunk, next = chunk 0x0c next let next = align 0x10 (next + 0x05) - 0x05 let importTableChunk = { addr=importTableChunk.addr; size = next - importTableChunk.addr} let importTableChunkPadding = importTableChunk.size - (0x28 + 0x14 + 0x0e + 0x0c) let next = next + 0x03 - let entrypointCodeChunk,next = chunk 0x06 next - let globalpointerCodeChunk,next = chunk (if isItanium then 0x8 else 0x0) next + let entrypointCodeChunk, next = chunk 0x06 next + let globalpointerCodeChunk, next = chunk (if isItanium then 0x8 else 0x0) next let pdbOpt = match portablePDB with @@ -3736,7 +3736,7 @@ let writeBinaryAndReportMappings (outfile, if embeddedPDB then Some (compressPortablePdbStream uncompressedLength contentId stream) else Some (pdbStream) | _ -> None - let debugDirectoryChunk,next = + let debugDirectoryChunk, next = chunk (if pdbfile = None then 0x0 else if embeddedPDB && portablePDB then @@ -3749,17 +3749,17 @@ let writeBinaryAndReportMappings (outfile, // 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 - let debugDataChunk,next = + let debugDataChunk, next = chunk (align 0x4 (match pdbfile with | None -> 0 | Some f -> (24 + System.Text.Encoding.Unicode.GetByteCount(f) // See bug 748444 + debugDataJustInCase))) next - let debugEmbeddedPdbChunk,next = + let debugEmbeddedPdbChunk, next = let streamLength = match pdbOpt with - | Some (_,_,stream) -> int(stream.Length) + | Some (_, _, stream) -> int(stream.Length) | None -> 0 chunk (align 0x4 (match embeddedPDB with | true -> 8 + streamLength @@ -3799,9 +3799,9 @@ let writeBinaryAndReportMappings (outfile, #endif let nativeResourcesSize = nativeResources.Length - let nativeResourcesChunk,next = chunk nativeResourcesSize next + let nativeResourcesChunk, next = chunk nativeResourcesSize next - let dummydatap,next = chunk (if next = dataSectionAddr then 0x01 else 0x0) next + let dummydatap, next = chunk (if next = dataSectionAddr then 0x01 else 0x0) next let dataSectionSize = next - dataSectionAddr let nextPhys = align alignPhys (dataSectionPhysLoc + dataSectionSize) @@ -3811,7 +3811,7 @@ let writeBinaryAndReportMappings (outfile, // .RELOC SECTION base reloc table: 0x0c size let relocSectionPhysLoc = nextPhys let relocSectionAddr = next - let baseRelocTableChunk,next = chunk 0x0c next + let baseRelocTableChunk, next = chunk 0x0c next let relocSectionSize = next - relocSectionAddr let nextPhys = align alignPhys (relocSectionPhysLoc + relocSectionSize) @@ -3822,7 +3822,7 @@ let writeBinaryAndReportMappings (outfile, // references into the data section from the metadata tables. begin requiredDataFixups |> List.iter - (fun (metadataOffset32,(dataOffset,kind)) -> + (fun (metadataOffset32, (dataOffset, kind)) -> let metadataOffset = metadataOffset32 if metadataOffset < 0 || metadataOffset >= metadata.Length - 4 then failwith "data RVA fixup: fixup located outside metadata"; checkFixup32 metadata metadataOffset 0xdeaddddd; @@ -4094,7 +4094,7 @@ let writeBinaryAndReportMappings (outfile, (if modul.Is32BitPreferred then 0x00020003 else 0x00) ||| (if (match signer with None -> false | Some s -> s.IsFullySigned) then 0x08 else 0x00) - let headerVersionMajor,headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion + let headerVersionMajor, headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion writePadding os "pad to cli header" cliHeaderPadding write (Some (textV2P cliHeaderChunk.addr)) os "cli header" [| |] @@ -4232,7 +4232,7 @@ let writeBinaryAndReportMappings (outfile, FileSystemUtilites.setExecutablePermission outfile with _ -> () - pdbData,pdbOpt,debugDirectoryChunk,debugDataChunk,debugEmbeddedPdbChunk,textV2P,mappings + pdbData, pdbOpt, debugDirectoryChunk, debugDataChunk, debugEmbeddedPdbChunk, textV2P, mappings // Looks like a finally with e -> diff --git a/src/absil/ilx.fs b/src/absil/ilx.fs index 7aa1f1cc1af..afe285ae73f 100644 --- a/src/absil/ilx.fs +++ b/src/absil/ilx.fs @@ -49,13 +49,13 @@ type IlxUnionRef = type IlxUnionSpec = | IlxUnionSpec of IlxUnionRef * ILGenericArgs - member x.EnclosingType = let (IlxUnionSpec(IlxUnionRef(bx,tref,_,_,_),inst)) = x in mkILNamedTy bx tref inst - member x.Boxity = let (IlxUnionSpec(IlxUnionRef(bx,_,_,_,_),_)) = x in bx - member x.TypeRef = let (IlxUnionSpec(IlxUnionRef(_,tref,_,_,_),_)) = x in tref - member x.GenericArgs = let (IlxUnionSpec(_,inst)) = x in inst - member x.AlternativesArray = let (IlxUnionSpec(IlxUnionRef(_,_,alts,_,_),_)) = x in alts - member x.IsNullPermitted = let (IlxUnionSpec(IlxUnionRef(_,_,_,np,_),_)) = x in np - member x.HasHelpers = let (IlxUnionSpec(IlxUnionRef(_,_,_,_,b),_)) = x in b + member x.EnclosingType = let (IlxUnionSpec(IlxUnionRef(bx, tref, _, _, _), inst)) = x in mkILNamedTy bx tref inst + member x.Boxity = let (IlxUnionSpec(IlxUnionRef(bx, _, _, _, _), _)) = x in bx + member x.TypeRef = let (IlxUnionSpec(IlxUnionRef(_, tref, _, _, _), _)) = x in tref + member x.GenericArgs = let (IlxUnionSpec(_, inst)) = x in inst + member x.AlternativesArray = let (IlxUnionSpec(IlxUnionRef(_, _, alts, _, _), _)) = x in alts + member x.IsNullPermitted = let (IlxUnionSpec(IlxUnionRef(_, _, _, np, _), _)) = x in np + member x.HasHelpers = let (IlxUnionSpec(IlxUnionRef(_, _, _, _, b), _)) = x in b member x.Alternatives = Array.toList x.AlternativesArray member x.Alternative idx = x.AlternativesArray.[idx] member x.FieldDef idx fidx = x.Alternative(idx).FieldDef(fidx) @@ -72,15 +72,15 @@ type IlxClosureApps = | Apps_done of ILType let rec instAppsAux n inst = function - Apps_tyapp (ty,rty) -> Apps_tyapp(instILTypeAux n inst ty, instAppsAux n inst rty) - | Apps_app (dty,rty) -> Apps_app(instILTypeAux n inst dty, instAppsAux n inst rty) + Apps_tyapp (ty, rty) -> Apps_tyapp(instILTypeAux n inst ty, instAppsAux n inst rty) + | Apps_app (dty, rty) -> Apps_app(instILTypeAux n inst dty, instAppsAux n inst rty) | Apps_done rty -> Apps_done(instILTypeAux n inst rty) let rec instLambdasAux n inst = function - | Lambdas_forall (b,rty) -> + | Lambdas_forall (b, rty) -> Lambdas_forall(b, instLambdasAux n inst rty) - | Lambdas_lambda (p,rty) -> - Lambdas_lambda({ p with Type=instILTypeAux n inst p.Type},instLambdasAux n inst rty) + | Lambdas_lambda (p, rty) -> + Lambdas_lambda({ p with Type=instILTypeAux n inst p.Type}, instLambdasAux n inst rty) | Lambdas_return rty -> Lambdas_return(instILTypeAux n inst rty) let instLambdas i t = instLambdasAux 0 i t @@ -90,7 +90,7 @@ type IlxClosureFreeVar = fvCompilerGenerated:bool fvType: ILType } -let mkILFreeVar (name,compgen,ty) = +let mkILFreeVar (name, compgen, ty) = { fvName=name fvCompilerGenerated=compgen fvType=ty } @@ -101,19 +101,19 @@ type IlxClosureRef = type IlxClosureSpec = | IlxClosureSpec of IlxClosureRef * ILGenericArgs * ILType - member x.TypeRef = let (IlxClosureRef(tref,_,_)) = x.ClosureRef in tref - member x.ILType = let (IlxClosureSpec(_,_,ty)) = x in ty - member x.ClosureRef = let (IlxClosureSpec(cloref,_,_)) = x in cloref - member x.FormalFreeVars = let (IlxClosureRef(_,_,fvs)) = x.ClosureRef in fvs - member x.FormalLambdas = let (IlxClosureRef(_,lambdas,_)) = x.ClosureRef in lambdas - member x.GenericArgs = let (IlxClosureSpec(_,inst,_)) = x in inst + member x.TypeRef = let (IlxClosureRef(tref, _, _)) = x.ClosureRef in tref + member x.ILType = let (IlxClosureSpec(_, _, ty)) = x in ty + member x.ClosureRef = let (IlxClosureSpec(cloref, _, _)) = x in cloref + member x.FormalFreeVars = let (IlxClosureRef(_, _, fvs)) = x.ClosureRef in fvs + member x.FormalLambdas = let (IlxClosureRef(_, lambdas, _)) = x.ClosureRef in lambdas + member x.GenericArgs = let (IlxClosureSpec(_, inst, _)) = x in inst static member Create (cloref, inst) = - let (IlxClosureRef(tref,_,_)) = cloref + let (IlxClosureRef(tref, _, _)) = cloref IlxClosureSpec(cloref, inst, mkILBoxedType (mkILTySpec (tref, inst))) member clospec.Constructor = let cloTy = clospec.ILType let fields = clospec.FormalFreeVars - mkILCtorMethSpecForTy (cloTy,fields |> Array.map (fun fv -> fv.fvType) |> Array.toList) + mkILCtorMethSpecForTy (cloTy, fields |> Array.map (fun fv -> fv.fvType) |> Array.toList) // Define an extension of the IL algebra of type definitions @@ -141,7 +141,7 @@ type IlxUnionInfo = // Define these as extensions of the IL types // -------------------------------------------------------------------- -let destTyFuncApp = function Apps_tyapp (b,c) -> b,c | _ -> failwith "destTyFuncApp" +let destTyFuncApp = function Apps_tyapp (b, c) -> b, c | _ -> failwith "destTyFuncApp" let mkILFormalCloRef gparams csig = IlxClosureSpec.Create(csig, mkILFormalGenericArgs 0 gparams) diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index fde22b1b7cf..d854d897573 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -6,7 +6,6 @@ module public Microsoft.FSharp.Compiler.ErrorLogger module internal Microsoft.FSharp.Compiler.ErrorLogger #endif - open Internal.Utilities open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics @@ -52,7 +51,7 @@ exception ReportedError of exn option with let rec findOriginalException err = match err with | ReportedError (Some err) -> err - | WrappedError(err,_) -> findOriginalException err + | WrappedError(err, _) -> findOriginalException err | _ -> err type Suggestions = unit -> Set @@ -75,20 +74,20 @@ let StopProcessing<'T> = StopProcessingExn None exception NumberedError of (int * string) * range with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | NumberedError((_,msg),_) -> msg + | NumberedError((_, msg), _) -> msg | _ -> "impossible" exception Error of (int * string) * range with // int is e.g. 191 in FS0191 // eventually remove this type, it is a transitional artifact of the old unnumbered error style override this.Message = match this :> exn with - | Error((_,msg),_) -> msg + | Error((_, msg), _) -> msg | _ -> "impossible" exception InternalError of msg: string * range with override this.Message = match this :> exn with - | InternalError(msg,m) -> msg + m.ToString() + | InternalError(msg, m) -> msg + m.ToString() | _ -> "impossible" exception UserCompilerMessage of string * int * range @@ -107,7 +106,7 @@ exception UnresolvedPathReference of (*assemblyname*) string * (*path*) string * exception ErrorWithSuggestions of (int * string) * range * string * Suggestions with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | ErrorWithSuggestions((_,msg),_,_,_) -> msg + | ErrorWithSuggestions((_, msg), _, _, _) -> msg | _ -> "impossible" @@ -122,7 +121,7 @@ let inline protectAssemblyExplorationF dflt f = try f() with - | UnresolvedPathReferenceNoRange (asmName, path) -> dflt(asmName,path) + | UnresolvedPathReferenceNoRange (asmName, path) -> dflt(asmName, path) | _ -> reraise() let inline protectAssemblyExplorationNoReraise dflt1 dflt2 f = @@ -139,10 +138,10 @@ let rec AttachRange m (exn:exn) = match exn with // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException -> AttachRange m exn.InnerException - | UnresolvedReferenceNoRange(a) -> UnresolvedReferenceError(a,m) - | UnresolvedPathReferenceNoRange(a,p) -> UnresolvedPathReference(a,p,m) - | Failure(msg) -> InternalError(msg^" (Failure)",m) - | :? System.ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)",m) + | UnresolvedReferenceNoRange(a) -> UnresolvedReferenceError(a, m) + | UnresolvedPathReferenceNoRange(a, p) -> UnresolvedPathReference(a, p, m) + | Failure(msg) -> InternalError(msg^" (Failure)", m) + | :? System.ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) | notARangeDual -> notARangeDual @@ -203,7 +202,7 @@ type PhasedDiagnostic = { Exception:exn; Phase:BuildPhase } /// Construct a phased error - static member Create(exn:exn,phase:BuildPhase) : PhasedDiagnostic = + static member Create(exn:exn, phase:BuildPhase) : PhasedDiagnostic = // FUTURE: renable this assert, which has historically triggered in some compiler service scenarios // System.Diagnostics.Debug.Assert(phase<>BuildPhase.DefaultPhase, sprintf "Compile error seen with no phase to attribute it to.%A %s %s" phase exn.Message exn.StackTrace ) {Exception = exn; Phase=phase} @@ -283,13 +282,13 @@ type ErrorLogger(nameForDebugging:string) = let DiscardErrorsLogger = { new ErrorLogger("DiscardErrorsLogger") with - member x.DiagnosticSink(phasedError,isError) = () + member x.DiagnosticSink(phasedError, isError) = () member x.ErrorCount = 0 } let AssertFalseErrorLogger = { new ErrorLogger("AssertFalseErrorLogger") with // TODO: renable these asserts in the compiler service - member x.DiagnosticSink(phasedError,isError) = (* assert false; *) () + member x.DiagnosticSink(phasedError, isError) = (* assert false; *) () member x.ErrorCount = (* assert false; *) 0 } @@ -371,8 +370,8 @@ module ErrorLoggerExtensions = member x.ErrorR exn = match exn with - | InternalError (s,_) - | Failure s as exn -> System.Diagnostics.Debug.Assert(false,sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) + | InternalError (s, _) + | Failure s as exn -> System.Diagnostics.Debug.Assert(false, sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) | _ -> () match exn with @@ -380,7 +379,7 @@ module ErrorLoggerExtensions = | ReportedError _ -> PreserveStackTrace(exn) raise exn - | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn,CompileThreadStatic.BuildPhase), true) + | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), true) member x.Warning exn = match exn with @@ -388,7 +387,7 @@ module ErrorLoggerExtensions = | ReportedError _ -> PreserveStackTrace(exn) raise exn - | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn,CompileThreadStatic.BuildPhase), false) + | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), false) member x.Error exn = x.ErrorR exn @@ -405,10 +404,10 @@ module ErrorLoggerExtensions = (* Don't send ThreadAbortException down the error channel *) #if FX_REDUCED_EXCEPTIONS #else - | :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException),_) -> () + | :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException), _) -> () #endif - | ReportedError _ | WrappedError(ReportedError _,_) -> () - | StopProcessing | WrappedError(StopProcessing,_) -> + | ReportedError _ | WrappedError(ReportedError _, _) -> () + | StopProcessing | WrappedError(StopProcessing, _) -> PreserveStackTrace(exn) raise exn | _ -> @@ -416,7 +415,7 @@ module ErrorLoggerExtensions = x.ErrorR (AttachRange m exn) // may raise exceptions, e.g. an fsi error sink raises StopProcessing. ReraiseIfWatsonable(exn) with - | ReportedError _ | WrappedError(ReportedError _,_) -> () + | ReportedError _ | WrappedError(ReportedError _, _) -> () member x.StopProcessingRecovery (exn:exn) (m:range) = // Do standard error recovery. @@ -424,12 +423,12 @@ module ErrorLoggerExtensions = // Additionally ignore/catch ReportedError. // Can throw other exceptions raised by the DiagnosticSink(exn) handler. match exn with - | StopProcessing | WrappedError(StopProcessing,_) -> () // suppress, so skip error recovery. + | StopProcessing | WrappedError(StopProcessing, _) -> () // suppress, so skip error recovery. | _ -> try x.ErrorRecovery exn m with - | StopProcessing | WrappedError(StopProcessing,_) -> () // catch, e.g. raised by DiagnosticSink. - | ReportedError _ | WrappedError(ReportedError _,_) -> () // catch, but not expected unless ErrorRecovery is changed. + | StopProcessing | WrappedError(StopProcessing, _) -> () // catch, e.g. raised by DiagnosticSink. + | ReportedError _ | WrappedError(ReportedError _, _) -> () // catch, but not expected unless ErrorRecovery is changed. member x.ErrorRecoveryNoRange (exn:exn) = x.ErrorRecovery exn range0 @@ -488,7 +487,7 @@ let errorRecoveryNoRange exn = CompileThreadStatic.ErrorLogger.ErrorRecoveryNoRa let report f = f() -let deprecatedWithError s m = errorR(Deprecated(s,m)) +let deprecatedWithError s m = errorR(Deprecated(s, m)) // Note: global state, but only for compiling FSharp.Core.dll let mutable reportLibraryOnlyFeatures = true @@ -502,7 +501,7 @@ let suppressErrorReporting f = try let errorLogger = { new ErrorLogger("suppressErrorReporting") with - member x.DiagnosticSink(_phasedError,_isError) = () + member x.DiagnosticSink(_phasedError, _isError) = () member x.ErrorCount = 0 } SetThreadErrorLoggerNoUnwind(errorLogger) f() @@ -530,30 +529,30 @@ let ReportWarnings warns = let CommitOperationResult res = match res with - | OkResult (warns,res) -> ReportWarnings warns; res - | ErrorResult (warns,err) -> ReportWarnings warns; error err + | OkResult (warns, res) -> ReportWarnings warns; res + | ErrorResult (warns, err) -> ReportWarnings warns; error err let RaiseOperationResult res : unit = CommitOperationResult res -let ErrorD err = ErrorResult([],err) -let WarnD err = OkResult([err],()) -let CompleteD = OkResult([],()) -let ResultD x = OkResult([],x) +let ErrorD err = ErrorResult([], err) +let WarnD err = OkResult([err], ()) +let CompleteD = OkResult([], ()) +let ResultD x = OkResult([], x) let CheckNoErrorsAndGetWarnings res = match res with - | OkResult (warns,_) -> Some warns + | OkResult (warns, _) -> Some warns | ErrorResult _ -> None /// The bind in the monad. Stop on first error. Accumulate warnings and continue. let (++) res f = match res with - | OkResult([],res) -> (* tailcall *) f res - | OkResult(warns,res) -> + | OkResult([], res) -> (* tailcall *) f res + | OkResult(warns, res) -> match f res with - | OkResult(warns2,res2) -> OkResult(warns@warns2, res2) - | ErrorResult(warns2,err) -> ErrorResult(warns@warns2, err) - | ErrorResult(warns,err) -> - ErrorResult(warns,err) + | OkResult(warns2, res2) -> OkResult(warns@warns2, res2) + | ErrorResult(warns2, err) -> ErrorResult(warns@warns2, err) + | ErrorResult(warns, err) -> + ErrorResult(warns, err) /// Stop on first error. Accumulate warnings and continue. let rec IterateD f xs = @@ -572,11 +571,11 @@ let MapD f xs = loop [] xs type TrackErrorsBuilder() = - member x.Bind(res,k) = res ++ k + member x.Bind(res, k) = res ++ k member x.Return res = ResultD res member x.ReturnFrom res = res - member x.For(seq,k) = IterateD k seq - member x.While(gd,k) = WhileD gd k + member x.For(seq, k) = IterateD k seq + member x.While(gd, k) = WhileD gd k member x.Zero() = CompleteD let trackErrors = TrackErrorsBuilder() @@ -594,14 +593,14 @@ let IterateIdxD f xs = /// Stop on first error. Accumulate warnings and continue. let rec Iterate2D f xs ys = - match xs,ys with - | [],[] -> CompleteD + match xs, ys with + | [], [] -> CompleteD | h1 :: t1, h2::t2 -> f h1 h2 ++ (fun () -> Iterate2D f t1 t2) | _ -> failwith "Iterate2D" let TryD f g = match f() with - | ErrorResult(warns,err) -> (OkResult(warns,())) ++ (fun () -> g err) + | ErrorResult(warns, err) -> (OkResult(warns, ())) ++ (fun () -> g err) | res -> res let rec RepeatWhileD ndeep body = body ndeep ++ (fun x -> if x then RepeatWhileD (ndeep+1) body else CompleteD) diff --git a/src/fsharp/ErrorResolutionHints.fs b/src/fsharp/ErrorResolutionHints.fs index d7fab22057f..4b3e47617c1 100644 --- a/src/fsharp/ErrorResolutionHints.fs +++ b/src/fsharp/ErrorResolutionHints.fs @@ -13,7 +13,7 @@ let minStringLengthForThreshold = 3 /// We report a candidate if its edit distance is <= the threshold. /// The threshold is set to about a quarter of the number of characters. let IsInEditDistanceProximity idText suggestion = - let editDistance = EditDistance.CalcEditDistance(idText,suggestion) + let editDistance = EditDistance.CalcEditDistance(idText, suggestion) let threshold = match idText.Length with | x when x < 5 -> 1 @@ -48,16 +48,16 @@ let FilterPredictions (idText:string) (suggestionF:ErrorLogger.Suggestions) = let suggestedText = suggestion.ToUpperInvariant() let similarity = EditDistance.JaroWinklerDistance uppercaseText suggestedText if similarity >= highConfidenceThreshold || suggestion.EndsWith ("." + idText) then - Some(similarity,suggestion) + Some(similarity, suggestion) elif similarity < minThresholdForSuggestions && suggestedText.Length > minStringLengthForThreshold then None elif IsInEditDistanceProximity uppercaseText suggestedText then - Some(similarity,suggestion) + Some(similarity, suggestion) else None) |> Seq.sortByDescending fst - |> Seq.mapi (fun i x -> i,x) - |> Seq.takeWhile (fun (i,_) -> i < maxSuggestions) + |> Seq.mapi (fun i x -> i, x) + |> Seq.takeWhile (fun (i, _) -> i < maxSuggestions) |> Seq.map snd |> Seq.toList diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index 26916e6d83d..1ab013976cb 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -10,16 +10,18 @@ module public Microsoft.FSharp.Compiler.PrettyNaming #else module internal Microsoft.FSharp.Compiler.PrettyNaming #endif -open Internal.Utilities - open Microsoft.FSharp.Compiler - open Microsoft.FSharp.Compiler.AbstractIL.Internal - open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library - open System.Globalization + open System open System.Collections.Generic open System.Collections.Concurrent + open System.Globalization + open System.Text + + open Microsoft.FSharp.Compiler + open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library - module TaggedTextOps = Internal.Utilities.StructuredFormat.TaggedTextOps - module LayoutOps = Internal.Utilities.StructuredFormat.LayoutOps + open Internal.Utilities + open Internal.Utilities.StructuredFormat + open Internal.Utilities.StructuredFormat.LayoutOps #if FX_RESHAPED_REFLECTION open Microsoft.FSharp.Core.ReflectionAdapters @@ -38,89 +40,89 @@ open Internal.Utilities let [] opNamePrefix = "op_" let private opNameTable = - [|("[]", "op_Nil"); - ("::", "op_ColonColon"); - ("+", "op_Addition"); - ("~%", "op_Splice"); - ("~%%", "op_SpliceUntyped"); - ("~++", "op_Increment"); - ("~--", "op_Decrement"); - ("-", "op_Subtraction"); - ("*", "op_Multiply"); - ("**", "op_Exponentiation"); - ("/", "op_Division"); - ("@", "op_Append"); - ("^", "op_Concatenate"); - ("%", "op_Modulus"); - ("&&&", "op_BitwiseAnd"); - ("|||", "op_BitwiseOr"); - ("^^^", "op_ExclusiveOr"); - ("<<<", "op_LeftShift"); - ("~~~", "op_LogicalNot"); - (">>>", "op_RightShift"); - ("~+", "op_UnaryPlus"); - ("~-", "op_UnaryNegation"); - ("~&", "op_AddressOf"); - ("~&&", "op_IntegerAddressOf"); - ("&&", "op_BooleanAnd"); - ("||", "op_BooleanOr"); - ("<=", "op_LessThanOrEqual"); - ("=","op_Equality"); - ("<>","op_Inequality"); - (">=", "op_GreaterThanOrEqual"); - ("<", "op_LessThan"); - (">", "op_GreaterThan"); - ("|>", "op_PipeRight"); - ("||>", "op_PipeRight2"); - ("|||>", "op_PipeRight3"); - ("<|", "op_PipeLeft"); - ("<||", "op_PipeLeft2"); - ("<|||", "op_PipeLeft3"); - ("!", "op_Dereference"); - (">>", "op_ComposeRight"); - ("<<", "op_ComposeLeft"); - ("<< >>", "op_TypedQuotationUnicode"); - ("<<| |>>", "op_ChevronsBar"); - ("<@ @>", "op_Quotation"); - ("<@@ @@>", "op_QuotationUntyped"); - ("+=", "op_AdditionAssignment"); - ("-=", "op_SubtractionAssignment"); - ("*=", "op_MultiplyAssignment"); - ("/=", "op_DivisionAssignment"); - ("..", "op_Range"); - (".. ..", "op_RangeStep"); - (qmark, "op_Dynamic"); - (qmarkSet, "op_DynamicAssignment"); - (parenGet, "op_ArrayLookup"); - (parenSet, "op_ArrayAssign"); + [|("[]", "op_Nil") + ("::", "op_ColonColon") + ("+", "op_Addition") + ("~%", "op_Splice") + ("~%%", "op_SpliceUntyped") + ("~++", "op_Increment") + ("~--", "op_Decrement") + ("-", "op_Subtraction") + ("*", "op_Multiply") + ("**", "op_Exponentiation") + ("/", "op_Division") + ("@", "op_Append") + ("^", "op_Concatenate") + ("%", "op_Modulus") + ("&&&", "op_BitwiseAnd") + ("|||", "op_BitwiseOr") + ("^^^", "op_ExclusiveOr") + ("<<<", "op_LeftShift") + ("~~~", "op_LogicalNot") + (">>>", "op_RightShift") + ("~+", "op_UnaryPlus") + ("~-", "op_UnaryNegation") + ("~&", "op_AddressOf") + ("~&&", "op_IntegerAddressOf") + ("&&", "op_BooleanAnd") + ("||", "op_BooleanOr") + ("<=", "op_LessThanOrEqual") + ("=","op_Equality") + ("<>","op_Inequality") + (">=", "op_GreaterThanOrEqual") + ("<", "op_LessThan") + (">", "op_GreaterThan") + ("|>", "op_PipeRight") + ("||>", "op_PipeRight2") + ("|||>", "op_PipeRight3") + ("<|", "op_PipeLeft") + ("<||", "op_PipeLeft2") + ("<|||", "op_PipeLeft3") + ("!", "op_Dereference") + (">>", "op_ComposeRight") + ("<<", "op_ComposeLeft") + ("<< >>", "op_TypedQuotationUnicode") + ("<<| |>>", "op_ChevronsBar") + ("<@ @>", "op_Quotation") + ("<@@ @@>", "op_QuotationUntyped") + ("+=", "op_AdditionAssignment") + ("-=", "op_SubtractionAssignment") + ("*=", "op_MultiplyAssignment") + ("/=", "op_DivisionAssignment") + ("..", "op_Range") + (".. ..", "op_RangeStep") + (qmark, "op_Dynamic") + (qmarkSet, "op_DynamicAssignment") + (parenGet, "op_ArrayLookup") + (parenSet, "op_ArrayAssign") |] let private opCharTranslateTable = - [|( '>', "Greater"); - ( '<', "Less"); - ( '+', "Plus"); - ( '-', "Minus"); - ( '*', "Multiply"); - ( '=', "Equals"); - ( '~', "Twiddle"); - ( '%', "Percent"); - ( '.', "Dot"); - ( '$', "Dollar"); - ( '&', "Amp"); - ( '|', "Bar"); - ( '@', "At"); - ( '#', "Hash"); - ( '^', "Hat"); - ( '!', "Bang"); - ( '?', "Qmark"); - ( '/', "Divide"); - ( ':', "Colon"); - ( '(', "LParen"); - ( ',', "Comma"); - ( ')', "RParen"); - ( ' ', "Space"); - ( '[', "LBrack"); - ( ']', "RBrack"); |] + [|( '>', "Greater") + ( '<', "Less") + ( '+', "Plus") + ( '-', "Minus") + ( '*', "Multiply") + ( '=', "Equals") + ( '~', "Twiddle") + ( '%', "Percent") + ( '.', "Dot") + ( '$', "Dollar") + ( '&', "Amp") + ( '|', "Bar") + ( '@', "At") + ( '#', "Hash") + ( '^', "Hat") + ( '!', "Bang") + ( '?', "Qmark") + ( '/', "Divide") + ( ':', "Colon") + ( '(', "LParen") + ( ',', "Comma") + ( ')', "RParen") + ( ' ', "Space") + ( '[', "LBrack") + ( ']', "RBrack") |] /// The set of characters usable in custom operators. let private opCharSet = @@ -144,17 +146,16 @@ open Internal.Utilities res let IsMangledOpName (n:string) = - n.StartsWith (opNamePrefix, System.StringComparison.Ordinal) + n.StartsWith (opNamePrefix, StringComparison.Ordinal) - // +++ GLOBAL STATE /// Compiles a custom operator into a mangled operator name. /// For example, "!%" becomes "op_DereferencePercent". - /// This function should only be used for custom operators; + /// This function should only be used for custom operators /// if an operator is or potentially may be a built-in operator, /// use the 'CompileOpName' function instead. let private compileCustomOpName = let t2 = - let t2 = Dictionary<_,_> (opCharTranslateTable.Length) + let t2 = Dictionary<_, _> (opCharTranslateTable.Length) for x, y in opCharTranslateTable do t2.Add (x, y) t2 @@ -168,13 +169,13 @@ open Internal.Utilities /// Memoize compilation of custom operators. /// They're typically used more than once so this avoids some CPU and GC overhead. - let compiledOperators = ConcurrentDictionary<_,string> (System.StringComparer.Ordinal) + let compiledOperators = ConcurrentDictionary<_, string> (StringComparer.Ordinal) fun opp -> // Has this operator already been compiled? compiledOperators.GetOrAdd(opp, fun (op:string) -> let opLength = op.Length - let sb = new System.Text.StringBuilder (opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) + let sb = new Text.StringBuilder (opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) for i = 0 to opLength - 1 do let c = op.[i] match t2.TryGetValue c with @@ -189,14 +190,13 @@ open Internal.Utilities // Cache the compiled name so it can be reused. opName) - // +++ GLOBAL STATE /// Compiles an operator into a mangled operator name. /// For example, "!%" becomes "op_DereferencePercent". /// This function accepts both built-in and custom operators. let CompileOpName = /// Maps the built-in F# operators to their mangled operator names. let standardOpNames = - let opNames = Dictionary<_,_> (opNameTable.Length, System.StringComparer.Ordinal) + let opNames = Dictionary<_, _> (opNameTable.Length, StringComparer.Ordinal) for x, y in opNameTable do opNames.Add (x, y) opNames @@ -209,16 +209,15 @@ open Internal.Utilities compileCustomOpName op else op - // +++ GLOBAL STATE /// Decompiles the mangled name of a custom operator back into an operator. /// For example, "op_DereferencePercent" becomes "!%". - /// This function should only be used for mangled names of custom operators; + /// This function should only be used for mangled names of custom operators /// if a mangled name potentially represents a built-in operator, /// use the 'DecompileOpName' function instead. let private decompileCustomOpName = // Memoize this operation. Custom operators are typically used more than once // so this avoids repeating decompilation. - let decompiledOperators = ConcurrentDictionary<_,_> (System.StringComparer.Ordinal) + let decompiledOperators = ConcurrentDictionary<_, _> (StringComparer.Ordinal) /// The minimum length of the name for a custom operator character. /// This value is used when initializing StringBuilders to avoid resizing. @@ -236,9 +235,9 @@ open Internal.Utilities let opNameLen = opName.Length /// Function which decompiles the mangled operator name back into a string of operator characters. - /// Returns None if the name contains text which doesn't correspond to an operator; + /// Returns None if the name contains text which doesn't correspond to an operator /// otherwise returns Some containing the original operator. - let rec decompile (sb : System.Text.StringBuilder) idx = + let rec decompile (sb : StringBuilder) idx = // Have we reached the end of 'opName'? if idx = opNameLen then // Finished decompiling. @@ -256,7 +255,7 @@ open Internal.Utilities if opNameLen - idx < opCharNameLen then false else // Does 'opCharName' match the current position in 'opName'? - System.String.Compare (opName, idx, opCharName, 0, opCharNameLen, System.StringComparison.Ordinal) = 0) + String.Compare (opName, idx, opCharName, 0, opCharNameLen, StringComparison.Ordinal) = 0) match choice with | None -> @@ -274,19 +273,19 @@ open Internal.Utilities /// The maximum number of operator characters that could be contained in the /// decompiled operator given the length of the mangled custom operator name. let maxPossibleOpCharCount = (opNameLen - opNamePrefixLen) / minOperatorNameLength - System.Text.StringBuilder (maxPossibleOpCharCount) + StringBuilder (maxPossibleOpCharCount) // Start decompiling just after the operator prefix. decompile sb opNamePrefixLen - // +++ GLOBAL STATE + /// Decompiles a mangled operator name back into an operator. /// For example, "op_DereferencePercent" becomes "!%". /// This function accepts mangled names for both built-in and custom operators. let DecompileOpName = /// Maps the mangled operator names of built-in F# operators back to the operators. let standardOps = - let ops = Dictionary (opNameTable.Length, System.StringComparer.Ordinal) + let ops = Dictionary (opNameTable.Length, StringComparer.Ordinal) for x, y in opNameTable do ops.Add(y,x) ops @@ -305,14 +304,13 @@ open Internal.Utilities if IsOperatorOrBacktickedName nm then "( " + nm + " )" else nm - open LayoutOps - let DemangleOperatorNameAsLayout nonOpTagged nm = let nm = DecompileOpName nm if IsOperatorOrBacktickedName nm then wordL (TaggedTextOps.tagPunctuation "(") ^^ wordL (TaggedTextOps.tagOperator nm) ^^ wordL (TaggedTextOps.tagPunctuation ")") - else LayoutOps.wordL (nonOpTagged nm) + else wordL (nonOpTagged nm) let opNameCons = CompileOpName "::" + let opNameNil = CompileOpName "[]" let opNameEquals = CompileOpName "=" let opNameEqualsNullable = CompileOpName "=?" @@ -323,7 +321,7 @@ open Internal.Utilities let IsIdentifierFirstCharacter c = if c = '_' then true else - match System.Char.GetUnicodeCategory c with + match Char.GetUnicodeCategory c with // Letters | UnicodeCategory.UppercaseLetter | UnicodeCategory.LowercaseLetter @@ -337,7 +335,7 @@ open Internal.Utilities let IsIdentifierPartCharacter c = if c = '\'' then true // Tick else - match System.Char.GetUnicodeCategory c with + match Char.GetUnicodeCategory c with // Letters | UnicodeCategory.UppercaseLetter | UnicodeCategory.LowercaseLetter @@ -360,7 +358,7 @@ open Internal.Utilities || IsIdentifierPartCharacter c let IsValidPrefixOperatorUse s = - if System.String.IsNullOrEmpty s then false else + if String.IsNullOrEmpty s then false else match s with | "?+" | "?-" | "+" | "-" | "+." | "-." | "%" | "%%" | "&" | "&&" -> true | _ -> @@ -370,7 +368,7 @@ open Internal.Utilities || (s.[0] = '~' && String.forall (fun c -> c = '~') s) let IsValidPrefixOperatorDefinitionName s = - if System.String.IsNullOrEmpty s then false else + if String.IsNullOrEmpty s then false else match s with | "~?+" | "~?-" | "~+" | "~-" | "~+." | "~-." | "~%" | "~%%" | "~&" | "~&&" -> true | _ -> @@ -380,7 +378,7 @@ open Internal.Utilities || (s.[0] = '~' && String.forall (fun c -> c = '~') s) let IsPrefixOperator s = - if System.String.IsNullOrEmpty s then false else + if String.IsNullOrEmpty s then false else let s = DecompileOpName s match s with | "~?+" | "~?-" | "~+" | "~-" | "~+." | "~-." | "~%" | "~%%" | "~&" | "~&&" -> true @@ -391,7 +389,7 @@ open Internal.Utilities || (s.[0] = '~' && String.forall (fun c -> c = '~') s) let IsPunctuation s = - if System.String.IsNullOrEmpty s then false else + if String.IsNullOrEmpty s then false else match s with | "," | ";" | "|" | ":" | "." | "*" | "(" | ")" @@ -407,12 +405,16 @@ open Internal.Utilities (DecompileOpName s = qmarkSet) let IsInfixOperator = + /// EQUALS, INFIX_COMPARE_OP, LESS, GREATER let relational = [| "=";"!=";"<";">";"$"|] + /// INFIX_AT_HAT_OP let concat = [| "@";"^" |] + /// PLUS_MINUS_OP, MINUS let plusMinus = [| "+"; "-" |] + /// PERCENT_OP, STAR, INFIX_STAR_DIV_MOD_OP let otherMath = [| "*";"/";"%" |] @@ -429,13 +431,12 @@ open Internal.Utilities // This function recognises these "infix operator" names. let s = DecompileOpName s let skipIgnoredChars = s.TrimStart(ignoredChars) - let afterSkipStartsWith prefix = skipIgnoredChars.StartsWith(prefix,System.StringComparison.Ordinal) + let afterSkipStartsWith prefix = skipIgnoredChars.StartsWith(prefix,StringComparison.Ordinal) let afterSkipStarts prefixes = Array.exists afterSkipStartsWith prefixes // The following conditions follow the declExpr infix clauses. // The test corresponds to the lexer definition for the token. s = ":=" || // COLON_EQUALS afterSkipStartsWith "|" || // BAR_BAR, INFIX_BAR_OP - (* REVIEW: OR is deadcode, now called BAR? *) // OR afterSkipStartsWith "&" || // AMP, AMP_AMP, INFIX_AMP_OP afterSkipStarts relational || // EQUALS, INFIX_COMPARE_OP, LESS, GREATER s = "$" || // DOLLAR @@ -461,6 +462,7 @@ open Internal.Utilities Other let [] private compilerGeneratedMarker = "@" + let [] private compilerGeneratedMarkerChar = '@' let IsCompilerGeneratedName (nm:string) = @@ -483,6 +485,7 @@ open Internal.Utilities //------------------------------------------------------------------------- let [] private mangledGenericTypeNameSym = '`' + let IsMangledGenericName (n:string) = n.IndexOf mangledGenericTypeNameSym <> -1 && (* check what comes after the symbol is a number *) @@ -493,6 +496,7 @@ open Internal.Utilities res type NameArityPair = NameArityPair of string * int + let DecodeGenericTypeName n = if IsMangledGenericName n then let pos = n.LastIndexOf mangledGenericTypeNameSym @@ -507,16 +511,7 @@ open Internal.Utilities n.Substring(0,pos) else n - //------------------------------------------------------------------------- - // Property name mangling. - // Expecting s to be in the form (as returned by qualifiedMangledNameOfTyconRef) of: - // get_P or set_P - // Names/Space/Class/NLPath-get_P or Names/Space/Class/NLPath.set_P - // Required to return "P" - //------------------------------------------------------------------------- - let private chopStringTo (s:string) (c:char) = - (* chopStringTo "abcdef" 'c' --> "def" *) match s.IndexOf c with | -1 -> s | idx -> @@ -527,13 +522,13 @@ open Internal.Utilities let TryChopPropertyName (s: string) = // extract the logical name from any mangled name produced by MakeMemberDataAndMangledNameForMemberVal if s.Length <= 4 then None else - if s.StartsWith("get_", System.StringComparison.Ordinal) || - s.StartsWith("set_", System.StringComparison.Ordinal) + if s.StartsWith("get_", StringComparison.Ordinal) || + s.StartsWith("set_", StringComparison.Ordinal) then Some (s.Substring(4, s.Length - 4)) else let s = chopStringTo s '.' - if s.StartsWith("get_", System.StringComparison.Ordinal) || - s.StartsWith("set_", System.StringComparison.Ordinal) + if s.StartsWith("get_", StringComparison.Ordinal) || + s.StartsWith("set_", StringComparison.Ordinal) then Some (s.Substring(4, s.Length - 4)) else None @@ -546,11 +541,11 @@ open Internal.Utilities | Some res -> res let SplitNamesForILPath (s : string) : string list = - if s.StartsWith("``",System.StringComparison.Ordinal) && s.EndsWith("``",System.StringComparison.Ordinal) && s.Length > 4 then [s.Substring(2, s.Length-4)] // identifier is enclosed in `` .. ``, so it is only a single element (this is very approximate) + if s.StartsWith("``",StringComparison.Ordinal) && s.EndsWith("``",StringComparison.Ordinal) && s.Length > 4 then [s.Substring(2, s.Length-4)] // identifier is enclosed in `` .. ``, so it is only a single element (this is very approximate) else s.Split [| '.' ; '`' |] |> Array.toList // '.' chops members / namespaces / modules; '`' chops generic parameters for .NET types - // Return a string array delimited by the given separator. - // Note that a quoted string is not going to be mangled into pieces. + /// Return a string array delimited by the given separator. + /// Note that a quoted string is not going to be mangled into pieces. let private splitAroundQuotation (text:string) (separator:char) = let length = text.Length let isNotQuotedQuotation n = n > 0 && text.[n-1] <> '\\' @@ -560,20 +555,20 @@ open Internal.Utilities // split when seeing a separator | c, false when c = separator -> split (i+1, "", cur::group, false) // keep reading if a separator is inside quotation - | c, true when c = separator -> split (i+1, cur+(System.Char.ToString c), group, true) + | c, true when c = separator -> split (i+1, cur+(Char.ToString c), group, true) // open or close quotation | '\"', _ when isNotQuotedQuotation i -> split (i+1, cur+"\"", group, not insideQuotation) // keep reading - | c, _ -> split (i+1, cur+(System.Char.ToString c), group, insideQuotation) + | c, _ -> split (i+1, cur+(Char.ToString c), group, insideQuotation) split (0, "", [], false) |> Array.ofList - // Return a string array delimited by the given separator up to the maximum number. - // Note that a quoted string is not going to be mangled into pieces. + /// Return a string array delimited by the given separator up to the maximum number. + /// Note that a quoted string is not going to be mangled into pieces. let private splitAroundQuotationWithCount (text:string) (separator:char) (count:int)= if count <= 1 then [| text |] else let mangledText = splitAroundQuotation text separator match mangledText.Length > count with - | true -> Array.append (mangledText.[0..(count-2)]) ([| mangledText.[(count-1)..] |> String.concat (System.Char.ToString separator) |]) + | true -> Array.append (mangledText.[0..(count-2)]) ([| mangledText.[(count-1)..] |> String.concat (Char.ToString separator) |]) | false -> mangledText let [] FSharpModuleSuffix = "Module" @@ -606,9 +601,13 @@ open Internal.Utilities type ActivePatternInfo = | APInfo of bool * (string * Range.range) list * Range.range + member x.IsTotal = let (APInfo(p,_,_)) = x in p + member x.ActiveTags = let (APInfo(_,tags,_)) = x in List.map fst tags + member x.ActiveTagsWithRanges = let (APInfo(_,tags,_)) = x in tags + member x.Range = let (APInfo(_,_,m)) = x in m let ActivePatternInfoOfValName nm (m:Range.range) = @@ -646,9 +645,9 @@ open Internal.Utilities Some(nm,v) | _ -> None - // Demangle the static parameters exception InvalidMangledStaticArg of string + /// Demangle the static parameters let demangleProvidedTypeName (typeLogicalName:string) = if typeLogicalName.Contains "," then let pieces = splitAroundQuotation typeLogicalName ',' @@ -663,7 +662,8 @@ open Internal.Utilities else typeLogicalName, [| |] - let mangleProvidedTypeName (typeLogicalName,nonDefaultArgs) = + /// Mangle the static parameters for a provided type or method + let mangleProvidedTypeName (typeLogicalName, nonDefaultArgs) = let nonDefaultArgsText = nonDefaultArgs |> Array.map mangleStaticStringArg @@ -675,7 +675,8 @@ open Internal.Utilities typeLogicalName + "," + nonDefaultArgsText - let computeMangledNameWithoutDefaultArgValues(nm,staticArgs,defaultArgValues) = + /// Mangle the static parameters for a provided type or method + let computeMangledNameWithoutDefaultArgValues(nm, staticArgs, defaultArgValues) = let nonDefaultArgs = (staticArgs,defaultArgValues) ||> Array.zip diff --git a/src/fsharp/range.fs b/src/fsharp/range.fs index 6713d117de4..f627e00157c 100755 --- a/src/fsharp/range.fs +++ b/src/fsharp/range.fs @@ -30,7 +30,7 @@ let inline (lsr) (x:int) (y:int) = int32 (uint32 x >>> y) [] [] type pos(code:int32) = - new (l,c) = + new (l, c) = let l = max 0 l let c = max 0 c let p = ( c &&& posColumnMask) @@ -106,15 +106,15 @@ let _ = assert (isSyntheticMask = mask64 isSyntheticShift isSyntheticBitCount) // This is just a standard unique-index table type FileIndexTable() = let indexToFileTable = new ResizeArray<_>(11) - let fileToIndexTable = new Dictionary(11) + let fileToIndexTable = new Dictionary(11) member t.FileToIndex f = let mutable res = 0 - let ok = fileToIndexTable.TryGetValue(f,&res) + let ok = fileToIndexTable.TryGetValue(f, &res) if ok then res else lock fileToIndexTable (fun () -> let mutable res = 0 in - let ok = fileToIndexTable.TryGetValue(f,&res) in + let ok = fileToIndexTable.TryGetValue(f, &res) in if ok then res else let n = indexToFileTable.Count in @@ -137,20 +137,20 @@ let fileIndexTable = new FileIndexTable() let fileIndexOfFile f = fileIndexTable.FileToIndex(f) % maxFileIndex let fileOfFileIndex n = fileIndexTable.IndexToFile(n) -let mkPos l c = pos (l,c) +let mkPos l c = pos (l, c) [] [] type range(code:int64) = static member Zero = range(0L) - new (fidx,bl,bc,el,ec) = + new (fidx, bl, bc, el, ec) = range( int64 fidx ||| (int64 bl <<< startLineShift) ||| (int64 bc <<< startColumnShift) ||| (int64 (el-bl) <<< heightShift) ||| (int64 ec <<< endColumnShift) ) - new (fidx, b:pos, e:pos) = range(fidx,b.Line,b.Column,e.Line,e.Column) + new (fidx, b:pos, e:pos) = range(fidx, b.Line, b.Column, e.Line, e.Column) member r.StartLine = int32((code &&& startLineMask) >>> startLineShift) member r.StartColumn = int32((code &&& startColumnMask) >>> startColumnShift) @@ -175,9 +175,9 @@ let mkFileIndexRange fi b e = range (fi, b, e) (* end representation, start derived ops *) -let posOrder = Order.orderOn (fun (p:pos) -> p.Line, p.Column) (Pair.order (Int32.order,Int32.order)) +let posOrder = Order.orderOn (fun (p:pos) -> p.Line, p.Column) (Pair.order (Int32.order, Int32.order)) (* rangeOrder: not a total order, but enough to sort on ranges *) -let rangeOrder = Order.orderOn (fun (r:range) -> r.FileName, r.Start) (Pair.order (String.order,posOrder)) +let rangeOrder = Order.orderOn (fun (r:range) -> r.FileName, r.Start) (Pair.order (String.order, posOrder)) let outputPos (os:TextWriter) (m:pos) = fprintf os "(%d,%d)" m.Line m.Column let outputRange (os:TextWriter) (m:range) = fprintf os "%s%a-%a" m.FileName outputPos m.Start outputPos m.End @@ -219,12 +219,12 @@ let rangeStartup = rangeN "startup" 1 let rangeCmdArgs = rangeN "commandLineArgs" 0 let trimRangeToLine (r:range) = - let startL,startC = r.StartLine,r.StartColumn - let endL ,_endC = r.EndLine,r.EndColumn + let startL, startC = r.StartLine, r.StartColumn + let endL , _endC = r.EndLine, r.EndColumn if endL <= startL then r else - let endL,endC = startL+1,0 (* Trim to the start of the next line (we do not know the end of the current line) *) + let endL, endC = startL+1, 0 (* Trim to the start of the next line (we do not know the end of the current line) *) range (r.FileIndex, startL, startC, endL, endC) (* For Diagnostics *) From 5cde9d325b31ee2c84f3ac7ef233a4c05447f474 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 3 Oct 2017 21:58:38 +0100 Subject: [PATCH 3/4] whitespace and comments --- src/ilx/EraseClosures.fs | 515 +++++++++++++++++++-------------------- 1 file changed, 256 insertions(+), 259 deletions(-) diff --git a/src/ilx/EraseClosures.fs b/src/ilx/EraseClosures.fs index 43aeb42147d..8a789a74408 100644 --- a/src/ilx/EraseClosures.fs +++ b/src/ilx/EraseClosures.fs @@ -21,16 +21,14 @@ open Microsoft.FSharp.Compiler.PrettyNaming // -------------------------------------------------------------------- let notlazy v = Lazy.CreateFromValue v -let logging = false -let _ = if logging then dprintn "*** warning: Clo2_erase.logging is on" let rec stripUpTo n test dest x = - if n = 0 then ([],x) else + if n = 0 then ([], x) else if test x then - let l,r = dest x - let ls,res = stripUpTo (n-1) test dest r - (l::ls),res - else ([],x) + let l, r = dest x + let ls, res = stripUpTo (n-1) test dest r + (l::ls), res + else ([], x) // -------------------------------------------------------------------- // Flags. These need to match the various classes etc. in the @@ -42,9 +40,9 @@ let rec stripUpTo n test dest x = // the closure environment. // -------------------------------------------------------------------- -let destTyLambda = function Lambdas_forall(l,r) -> (l,r) | _ -> failwith "no" -let isTyLambda = function Lambdas_forall(_l,_r) -> true | _ -> false -let isTyApp = function Apps_tyapp (_b,_c) ->true | _ -> false +let destTyLambda = function Lambdas_forall(l, r) -> (l, r) | _ -> failwith "no" +let isTyLambda = function Lambdas_forall _ -> true | _ -> false +let isTyApp = function Apps_tyapp _ -> true | _ -> false let stripTyLambdasUpTo n lambdas = stripUpTo n isTyLambda destTyLambda lambdas @@ -63,16 +61,16 @@ let stripTyLambdasUpTo n lambdas = stripUpTo n isTyLambda destTyLambda lambdas // and type applications are never mixed in a single step. let stripSupportedIndirectCall apps = match apps with - | Apps_app(x,Apps_app(y,Apps_app(z,Apps_app(w,Apps_app(v,rest))))) -> [],[x;y;z;w;v],rest - | Apps_app(x,Apps_app(y,Apps_app(z,Apps_app(w,rest)))) -> [],[x;y;z;w],rest - | Apps_app(x,Apps_app(y,Apps_app(z,rest))) -> [],[x;y;z],rest - | Apps_app(x,Apps_app(y,rest)) -> [],[x;y],rest - | Apps_app(x,rest) -> [],[x],rest + | Apps_app(x, Apps_app(y, Apps_app(z, Apps_app(w, Apps_app(v, rest))))) -> [], [x;y;z;w;v], rest + | Apps_app(x, Apps_app(y, Apps_app(z, Apps_app(w, rest)))) -> [], [x;y;z;w], rest + | Apps_app(x, Apps_app(y, Apps_app(z, rest))) -> [], [x;y;z], rest + | Apps_app(x, Apps_app(y, rest)) -> [], [x;y], rest + | Apps_app(x, rest) -> [], [x], rest | Apps_tyapp _ -> let maxTyApps = 1 - let tys,rest = stripUpTo maxTyApps isTyApp destTyFuncApp apps - tys,[],rest - | rest -> [],[],rest + let tys, rest = stripUpTo maxTyApps isTyApp destTyFuncApp apps + tys, [], rest + | rest -> [], [], rest // Supported conventions for baking closures: // 0 @@ -86,24 +84,24 @@ let stripSupportedIndirectCall apps = // and type applications are never mixed in a single step. let stripSupportedAbstraction lambdas = match lambdas with - | Lambdas_lambda(x,Lambdas_lambda(y,Lambdas_lambda(z,Lambdas_lambda(w,Lambdas_lambda(v,rest))))) -> [],[ x;y;z;w;v ],rest - | Lambdas_lambda(x,Lambdas_lambda(y,Lambdas_lambda(z,Lambdas_lambda(w,rest)))) -> [],[ x;y;z;w ],rest - | Lambdas_lambda(x,Lambdas_lambda(y,Lambdas_lambda(z,rest))) -> [],[ x;y;z ],rest - | Lambdas_lambda(x,Lambdas_lambda(y,rest)) -> [],[ x;y ],rest - | Lambdas_lambda(x,rest) -> [],[ x ],rest + | Lambdas_lambda(x, Lambdas_lambda(y, Lambdas_lambda(z, Lambdas_lambda(w, Lambdas_lambda(v, rest))))) -> [], [ x;y;z;w;v ], rest + | Lambdas_lambda(x, Lambdas_lambda(y, Lambdas_lambda(z, Lambdas_lambda(w, rest)))) -> [], [ x;y;z;w ], rest + | Lambdas_lambda(x, Lambdas_lambda(y, Lambdas_lambda(z, rest))) -> [], [ x;y;z ], rest + | Lambdas_lambda(x, Lambdas_lambda(y, rest)) -> [], [ x;y ], rest + | Lambdas_lambda(x, rest) -> [], [ x ], rest | Lambdas_forall _ -> let maxTyApps = 1 - let tys,rest = stripTyLambdasUpTo maxTyApps lambdas - tys,[ ],rest - | rest -> [],[ ],rest + let tys, rest = stripTyLambdasUpTo maxTyApps lambdas + tys, [ ], rest + | rest -> [], [ ], rest // This must correspond to stripSupportedAbstraction let isSupportedDirectCall apps = match apps with - | Apps_app (_,Apps_done _) -> true - | Apps_app (_,Apps_app (_, Apps_done _)) -> true - | Apps_app (_,Apps_app (_,Apps_app (_, Apps_done _))) -> true - | Apps_app (_,Apps_app (_,Apps_app (_, Apps_app (_, Apps_done _)))) -> true + | Apps_app (_, Apps_done _) -> true + | Apps_app (_, Apps_app (_, Apps_done _)) -> true + | Apps_app (_, Apps_app (_, Apps_app (_, Apps_done _))) -> true + | Apps_app (_, Apps_app (_, Apps_app (_, Apps_app (_, Apps_done _)))) -> true | Apps_tyapp _ -> false | _ -> false @@ -113,9 +111,9 @@ let isSupportedDirectCall apps = // -------------------------------------------------------------------- let mkFuncTypeRef n = - if n = 1 then mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (),IlxSettings.ilxNamespace () + ".FSharpFunc`2") - else mkILNestedTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), - [IlxSettings.ilxNamespace () + ".OptimizedClosures"], + if n = 1 then mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), IlxSettings.ilxNamespace () + ".FSharpFunc`2") + else mkILNestedTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), + [IlxSettings.ilxNamespace () + ".OptimizedClosures"], "FSharpFunc`"+ string (n + 1)) type cenv = { ilg:ILGlobals @@ -128,16 +126,15 @@ type cenv = let addMethodGeneratedAttrsToTypeDef cenv tdef = { tdef with Methods = tdef.Methods.AsList |> List.map (fun md -> md |> cenv.addMethodGeneratedAttrs) |> mkILMethods } -let newIlxPubCloEnv(ilg,addMethodGeneratedAttrs,addFieldGeneratedAttrs,addFieldNeverAttrs) = - { ilg=ilg; - tref_Func= Array.init 10 (fun i -> mkFuncTypeRef(i+1)); - mkILTyFuncTy=ILType.Boxed (mkILNonGenericTySpec (mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), IlxSettings.ilxNamespace () + ".FSharpTypeFunc"))) - addMethodGeneratedAttrs=addMethodGeneratedAttrs - addFieldGeneratedAttrs=addFieldGeneratedAttrs - addFieldNeverAttrs=addFieldNeverAttrs} +let newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) = + { ilg = ilg + tref_Func = Array.init 10 (fun i -> mkFuncTypeRef(i+1)) + mkILTyFuncTy = ILType.Boxed (mkILNonGenericTySpec (mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), IlxSettings.ilxNamespace () + ".FSharpTypeFunc"))) + addMethodGeneratedAttrs = addMethodGeneratedAttrs + addFieldGeneratedAttrs = addFieldGeneratedAttrs + addFieldNeverAttrs = addFieldNeverAttrs } let mkILTyFuncTy cenv = cenv.mkILTyFuncTy - let mkILFuncTy cenv dty rty = mkILBoxedTy cenv.tref_Func.[0] [dty;rty] let mkILCurriedFuncTy cenv dtys rty = List.foldBack (mkILFuncTy cenv) dtys rty @@ -149,47 +146,47 @@ let typ_Func cenv (dtys: ILType list) rty = let rec mkTyOfApps cenv apps = match apps with | Apps_tyapp _ -> cenv.mkILTyFuncTy - | Apps_app (dty,rest) -> mkILFuncTy cenv dty (mkTyOfApps cenv rest) + | Apps_app (dty, rest) -> mkILFuncTy cenv dty (mkTyOfApps cenv rest) | Apps_done rty -> rty let rec mkTyOfLambdas cenv lam = match lam with | Lambdas_return rty -> rty - | Lambdas_lambda (d,r) -> mkILFuncTy cenv d.Type (mkTyOfLambdas cenv r) + | Lambdas_lambda (d, r) -> mkILFuncTy cenv d.Type (mkTyOfLambdas cenv r) | Lambdas_forall _ -> cenv.mkILTyFuncTy // -------------------------------------------------------------------- // Method to call for a particular multi-application // -------------------------------------------------------------------- -let mkMethSpecForMultiApp cenv (argtys': ILType list,rty) = +let mkMethSpecForMultiApp cenv (argtys': ILType list, rty) = let n = argtys'.Length let formalArgTys = List.mapi (fun i _ -> ILType.TypeVar (uint16 i)) argtys' let formalRetTy = ILType.TypeVar (uint16 n) let inst = argtys'@[rty] if n = 1 then true, - (mkILNonGenericInstanceMethSpecInTy (mkILBoxedTy cenv.tref_Func.[0] inst,"Invoke",formalArgTys, formalRetTy)) + (mkILNonGenericInstanceMethSpecInTy (mkILBoxedTy cenv.tref_Func.[0] inst, "Invoke", formalArgTys, formalRetTy)) else false, (mkILStaticMethSpecInTy - (mkILFuncTy cenv inst.[0] inst.[1], - "InvokeFast", - [mkILCurriedFuncTy cenv formalArgTys formalRetTy]@formalArgTys, - formalRetTy, + (mkILFuncTy cenv inst.[0] inst.[1], + "InvokeFast", + [mkILCurriedFuncTy cenv formalArgTys formalRetTy]@formalArgTys, + formalRetTy, inst.Tail.Tail)) -let mkCallBlockForMultiValueApp cenv doTailCall (args',rty') = - let callvirt,mr = mkMethSpecForMultiApp cenv (args',rty') - [ ( if callvirt then I_callvirt (doTailCall,mr, None) else I_call (doTailCall,mr, None) ) ] +let mkCallBlockForMultiValueApp cenv doTailCall (args', rty') = + let callvirt, mr = mkMethSpecForMultiApp cenv (args', rty') + [ ( if callvirt then I_callvirt (doTailCall, mr, None) else I_call (doTailCall, mr, None) ) ] let mkMethSpecForClosureCall cenv (clospec: IlxClosureSpec) = - let tyargsl,argtys,rstruct = stripSupportedAbstraction clospec.FormalLambdas + let tyargsl, argtys, rstruct = stripSupportedAbstraction clospec.FormalLambdas if not (isNil tyargsl) then failwith "mkMethSpecForClosureCall: internal error" let rty' = mkTyOfLambdas cenv rstruct let argtys' = typesOfILParams argtys let minst' = clospec.GenericArgs - (mkILInstanceMethSpecInTy(clospec.ILType,"Invoke",argtys',rty',minst')) + (mkILInstanceMethSpecInTy(clospec.ILType, "Invoke", argtys', rty', minst')) // -------------------------------------------------------------------- @@ -198,106 +195,106 @@ let mkMethSpecForClosureCall cenv (clospec: IlxClosureSpec) = let mkLdFreeVar (clospec: IlxClosureSpec) (fv: IlxClosureFreeVar) = - [ mkLdarg0; mkNormalLdfld (mkILFieldSpecInTy (clospec.ILType,fv.fvName,fv.fvType) ) ] + [ mkLdarg0; mkNormalLdfld (mkILFieldSpecInTy (clospec.ILType, fv.fvName, fv.fvType) ) ] let mkCallFunc cenv allocLocal numThisGenParams tl apps = - // "callfunc" and "callclo" instructions become a series of indirect - // calls or a single direct call. - let varCount = numThisGenParams - - // Unwind the stack until the arguments given in the apps have - // all been popped off. The apps given to this function is - // what remains after the first "strip" of suitable arguments for the - // first call. - // Loaders and storers are returned in groups. Storers are used to pop - // the arguments off the stack that correspond to all the arguments in - // the apps, and the loaders are used to load them back on. - let rec unwind apps = - match apps with - | Apps_tyapp (actual,rest) -> - let rest = instAppsAux varCount [ actual ] rest - let storers,loaders = unwind rest - [] :: storers, [] :: loaders - | Apps_app (arg,rest) -> - let storers, loaders = unwind rest - let argStorers,argLoaders = - let locn = allocLocal arg - [mkStloc locn], [mkLdloc locn] - argStorers :: storers, argLoaders :: loaders - | Apps_done _ -> - [],[] + // "callfunc" and "callclo" instructions become a series of indirect + // calls or a single direct call. + let varCount = numThisGenParams + + // Unwind the stack until the arguments given in the apps have + // all been popped off. The apps given to this function is + // what remains after the first "strip" of suitable arguments for the + // first call. + // Loaders and storers are returned in groups. Storers are used to pop + // the arguments off the stack that correspond to all the arguments in + // the apps, and the loaders are used to load them back on. + let rec unwind apps = + match apps with + | Apps_tyapp (actual, rest) -> + let rest = instAppsAux varCount [ actual ] rest + let storers, loaders = unwind rest + [] :: storers, [] :: loaders + | Apps_app (arg, rest) -> + let storers, loaders = unwind rest + let argStorers, argLoaders = + let locn = allocLocal arg + [mkStloc locn], [mkLdloc locn] + argStorers :: storers, argLoaders :: loaders + | Apps_done _ -> + [], [] - let rec computePreCall fst n rest (loaders: ILInstr list) = - if fst then - let storers,(loaders2 : ILInstr list list) = unwind rest - (List.rev (List.concat storers) : ILInstr list) , List.concat loaders2 - else - stripUpTo n (function (_x::_y) -> true | _ -> false) (function (x::y) -> (x,y) | _ -> failwith "no!") loaders + let rec computePreCall fst n rest (loaders: ILInstr list) = + if fst then + let storers, (loaders2 : ILInstr list list) = unwind rest + (List.rev (List.concat storers) : ILInstr list) , List.concat loaders2 + else + stripUpTo n (function (_x::_y) -> true | _ -> false) (function (x::y) -> (x, y) | _ -> failwith "no!") loaders - let rec buildApp fst loaders apps = - // Strip off one valid indirect call. [fst] indicates if this is the - // first indirect call we're making. The code below makes use of the - // fact that term and type applications are never currently mixed for - // direct calls. - match stripSupportedIndirectCall apps with - // Type applications: REVIEW: get rid of curried tyapps - just tuple them - | tyargs,[],_ when not (isNil tyargs) -> - // strip again, instantiating as we go. we could do this while we count. - let (revInstTyArgs, rest') = - (([],apps), tyargs) ||> List.fold (fun (revArgsSoFar,cs) _ -> - let actual,rest' = destTyFuncApp cs - let rest'' = instAppsAux varCount [ actual ] rest' - ((actual :: revArgsSoFar),rest'')) - let instTyargs = List.rev revInstTyArgs - let precall,loaders' = computePreCall fst 0 rest' loaders - let doTailCall = andTailness tl false - let instrs1 = - precall @ - [ I_callvirt (doTailCall, (mkILInstanceMethSpecInTy (cenv.mkILTyFuncTy,"Specialize",[],cenv.ilg.typ_Object, instTyargs)), None) ] - let instrs1 = - // TyFunc are represented as Specialize<_> methods returning an object. - // For value types, recover result via unbox and load. - // For reference types, recover via cast. - let rtnTy = mkTyOfApps cenv rest' - instrs1 @ [ I_unbox_any rtnTy] - if doTailCall = Tailcall then instrs1 - else instrs1 @ buildApp false loaders' rest' - - // Term applications - | [],args,rest when not (isNil args) -> - let precall,loaders' = computePreCall fst args.Length rest loaders - let isLast = (match rest with Apps_done _ -> true | _ -> false) - let rty = mkTyOfApps cenv rest - let doTailCall = andTailness tl isLast - - let preCallBlock = precall - - if doTailCall = Tailcall then - let callBlock = mkCallBlockForMultiValueApp cenv doTailCall (args,rty) - preCallBlock @ callBlock - else - let callBlock = mkCallBlockForMultiValueApp cenv doTailCall (args,rty) - let restBlock = buildApp false loaders' rest - preCallBlock @ callBlock @ restBlock - - | [],[],Apps_done _rty -> [ ] - | _ -> failwith "*** Error: internal error: unknown indirect calling convention returned by stripSupportedIndirectCall" + let rec buildApp fst loaders apps = + // Strip off one valid indirect call. [fst] indicates if this is the + // first indirect call we're making. The code below makes use of the + // fact that term and type applications are never currently mixed for + // direct calls. + match stripSupportedIndirectCall apps with + // Type applications: REVIEW: get rid of curried tyapps - just tuple them + | tyargs, [], _ when not (isNil tyargs) -> + // strip again, instantiating as we go. we could do this while we count. + let (revInstTyArgs, rest') = + (([], apps), tyargs) ||> List.fold (fun (revArgsSoFar, cs) _ -> + let actual, rest' = destTyFuncApp cs + let rest'' = instAppsAux varCount [ actual ] rest' + ((actual :: revArgsSoFar), rest'')) + let instTyargs = List.rev revInstTyArgs + let precall, loaders' = computePreCall fst 0 rest' loaders + let doTailCall = andTailness tl false + let instrs1 = + precall @ + [ I_callvirt (doTailCall, (mkILInstanceMethSpecInTy (cenv.mkILTyFuncTy, "Specialize", [], cenv.ilg.typ_Object, instTyargs)), None) ] + let instrs1 = + // TyFunc are represented as Specialize<_> methods returning an object. + // For value types, recover result via unbox and load. + // For reference types, recover via cast. + let rtnTy = mkTyOfApps cenv rest' + instrs1 @ [ I_unbox_any rtnTy] + if doTailCall = Tailcall then instrs1 + else instrs1 @ buildApp false loaders' rest' + + // Term applications + | [], args, rest when not (isNil args) -> + let precall, loaders' = computePreCall fst args.Length rest loaders + let isLast = (match rest with Apps_done _ -> true | _ -> false) + let rty = mkTyOfApps cenv rest + let doTailCall = andTailness tl isLast + + let preCallBlock = precall + + if doTailCall = Tailcall then + let callBlock = mkCallBlockForMultiValueApp cenv doTailCall (args, rty) + preCallBlock @ callBlock + else + let callBlock = mkCallBlockForMultiValueApp cenv doTailCall (args, rty) + let restBlock = buildApp false loaders' rest + preCallBlock @ callBlock @ restBlock + + | [], [], Apps_done _rty -> [ ] + | _ -> failwith "*** Error: internal error: unknown indirect calling convention returned by stripSupportedIndirectCall" - buildApp true [] apps + buildApp true [] apps // Fix up I_ret instruction. Generalise to selected instr. Remove tailcalls. let convReturnInstr ty instr = match instr with | I_ret -> [I_box ty;I_ret] - | I_call (_,mspec,varargs) -> [I_call (Normalcall,mspec,varargs)] - | I_callvirt (_,mspec,varargs) -> [I_callvirt (Normalcall,mspec,varargs)] - | I_callconstraint (_,ty,mspec,varargs) -> [I_callconstraint (Normalcall,ty,mspec,varargs)] - | I_calli (_,csig,varargs) -> [I_calli (Normalcall,csig,varargs)] + | I_call (_, mspec, varargs) -> [I_call (Normalcall, mspec, varargs)] + | I_callvirt (_, mspec, varargs) -> [I_callvirt (Normalcall, mspec, varargs)] + | I_callconstraint (_, ty, mspec, varargs) -> [I_callconstraint (Normalcall, ty, mspec, varargs)] + | I_calli (_, csig, varargs) -> [I_calli (Normalcall, csig, varargs)] | _ -> [instr] -let convILMethodBody (thisClo,boxReturnTy) (il: ILMethodBody) = +let convILMethodBody (thisClo, boxReturnTy) (il: ILMethodBody) = // This increase in maxstack is historical, though it's harmless let newMax = match thisClo with @@ -313,7 +310,7 @@ let convILMethodBody (thisClo,boxReturnTy) (il: ILMethodBody) = {il with MaxStack=newMax; IsZeroInit=true; Code= code } let convMethodBody thisClo = function - | MethodBody.IL il -> MethodBody.IL (convILMethodBody (thisClo,None) il) + | MethodBody.IL il -> MethodBody.IL (convILMethodBody (thisClo, None) il) | x -> x let convMethodDef thisClo (md: ILMethodDef) = @@ -327,18 +324,18 @@ let convMethodDef thisClo (md: ILMethodDef) = let mkILFreeVarForParam (p : ILParameter) = let nm = (match p.Name with Some x -> x | None -> failwith "closure parameters must be given names") - mkILFreeVar(nm, false,p.Type) + mkILFreeVar(nm, false, p.Type) let mkILLocalForFreeVar (p: IlxClosureFreeVar) = mkILLocal p.fvType None let mkILCloFldSpecs _cenv flds = - flds |> Array.map (fun fv -> (fv.fvName,fv.fvType)) |> Array.toList + flds |> Array.map (fun fv -> (fv.fvName, fv.fvType)) |> Array.toList let mkILCloFldDefs cenv flds = flds |> Array.toList |> List.map (fun fv -> - let fdef = mkILInstanceField (fv.fvName,fv.fvType,None,ILMemberAccess.Public) + let fdef = mkILInstanceField (fv.fvName, fv.fvType, None, ILMemberAccess.Public) if fv.fvCompilerGenerated then fdef |> cenv.addFieldNeverAttrs |> cenv.addFieldGeneratedAttrs @@ -346,7 +343,7 @@ let mkILCloFldDefs cenv flds = fdef) // -------------------------------------------------------------------- -// Convert a closure. Split and chop if there are too many arguments, +// Convert a closure. Split and chop if there are too many arguments, // otherwise build the appropriate kind of thing depending on whether // it's a type abstraction or a term abstraction. // -------------------------------------------------------------------- @@ -358,11 +355,11 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let nowFields = clo.cloFreeVars let nowTypeRef = mkILNestedTyRef (ILScopeRef.Local, encl, td.Name) let nowTy = mkILFormalBoxedTy nowTypeRef td.GenericParams - let nowCloRef = IlxClosureRef(nowTypeRef,clo.cloStructure,nowFields) + let nowCloRef = IlxClosureRef(nowTypeRef, clo.cloStructure, nowFields) let nowCloSpec = mkILFormalCloRef td.GenericParams nowCloRef let tagApp = (Lazy.force clo.cloCode).SourceMarker - let tyargsl,tmargsl,laterStruct = stripSupportedAbstraction clo.cloStructure + let tyargsl, tmargsl, laterStruct = stripSupportedAbstraction clo.cloStructure let laterAccess = td.Access // Adjust all the argument and environment accesses @@ -373,7 +370,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let fixupArg mkEnv mkArg n = let rec findMatchingArg l c = match l with - | ((m,_)::t) -> + | ((m, _)::t) -> if n = m then mkEnv c else findMatchingArg t (c+1) | [] -> mkArg (n - argToFreeVarMap.Length + 1) @@ -396,19 +393,19 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = (int n) | i -> [i] let mainCode = morphILInstrsInILCode rewriteInstrToAccessArgsFromEnv il.Code - let ldenvCode = argToFreeVarMap |> List.mapi (fun n (_,fv) -> mkLdFreeVar laterCloSpec fv @ [mkStloc (uint16 (n+numLocals)) ]) |> List.concat + let ldenvCode = argToFreeVarMap |> List.mapi (fun n (_, fv) -> mkLdFreeVar laterCloSpec fv @ [mkStloc (uint16 (n+numLocals)) ]) |> List.concat let code = prependInstrsToCode ldenvCode mainCode {il with - Code=code; + Code=code Locals= il.Locals @ (List.map (snd >> mkILLocalForFreeVar) argToFreeVarMap) - (* maxstack may increase by 1 due to environment loads *) + // maxstack may increase by 1 due to environment loads MaxStack=il.MaxStack+1 } - match tyargsl,tmargsl,laterStruct with + match tyargsl, tmargsl, laterStruct with // CASE 1 - Type abstraction - | (_ :: _), [],_ -> + | (_ :: _), [], _ -> let addedGenParams = tyargsl let nowReturnTy = (mkTyOfLambdas cenv laterStruct) @@ -420,23 +417,23 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = // application. if (match laterStruct with Lambdas_return _ -> false | _ -> true) then - let nowStruct = List.foldBack (fun x y -> Lambdas_forall(x,y)) tyargsl (Lambdas_return nowReturnTy) + let nowStruct = List.foldBack (fun x y -> Lambdas_forall(x, y)) tyargsl (Lambdas_return nowReturnTy) let laterTypeName = td.Name+"T" - let laterTypeRef = mkILNestedTyRef (ILScopeRef.Local,encl,laterTypeName) + let laterTypeRef = mkILNestedTyRef (ILScopeRef.Local, encl, laterTypeName) let laterGenericParams = td.GenericParams @ addedGenParams - let selfFreeVar = mkILFreeVar(CompilerGeneratedName ("self"+string nowFields.Length),true,nowCloSpec.ILType) + let selfFreeVar = mkILFreeVar(CompilerGeneratedName ("self"+string nowFields.Length), true, nowCloSpec.ILType) let laterFields = Array.append nowFields [| selfFreeVar |] - let laterCloRef = IlxClosureRef(laterTypeRef,laterStruct,laterFields) + let laterCloRef = IlxClosureRef(laterTypeRef, laterStruct, laterFields) let laterCloSpec = mkILFormalCloRef laterGenericParams laterCloRef let laterCode = rewriteCodeToAccessArgsFromEnv laterCloSpec [(0, selfFreeVar)] let laterTypeDefs = convIlxClosureDef cenv encl - {td with GenericParams=laterGenericParams; - Access=laterAccess; - Name=laterTypeName} - {clo with cloStructure=laterStruct; - cloFreeVars=laterFields; + {td with GenericParams=laterGenericParams + Access=laterAccess + Name=laterTypeName} + {clo with cloStructure=laterStruct + cloFreeVars=laterFields cloCode=notlazy laterCode} // This is the code which will get called when then "now" @@ -444,7 +441,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = // that it is the code for a closure... let nowCode = mkILMethodBody - (false,[],nowFields.Length + 1, + (false, [], nowFields.Length + 1, nonBranchingInstrsToCode begin // Load up the environment, including self... @@ -453,11 +450,11 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = // Make the instance of the delegated closure && return it. // This passes the method type params. as class type params. [ I_newobj (laterCloSpec.Constructor, None) ] - end, + end, tagApp) let nowTypeDefs = - convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct; + convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct cloCode=notlazy nowCode} let nowTypeDefs = nowTypeDefs |> List.map (addMethodGeneratedAttrsToTypeDef cenv) @@ -468,93 +465,93 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let boxReturnTy = Some nowReturnTy (* box prior to all I_ret *) let nowApplyMethDef = mkILGenericVirtualMethod - ("Specialize", - ILMemberAccess.Public, + ("Specialize", + ILMemberAccess.Public, addedGenParams, (* method is generic over added ILGenericParameterDefs *) - [], - mkILReturn(cenv.ilg.typ_Object), - MethodBody.IL (convILMethodBody (Some nowCloSpec,boxReturnTy) (Lazy.force clo.cloCode))) + [], + mkILReturn(cenv.ilg.typ_Object), + MethodBody.IL (convILMethodBody (Some nowCloSpec, boxReturnTy) (Lazy.force clo.cloCode))) let ctorMethodDef = mkILStorageCtor - (None, - [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (cenv.mkILTyFuncTy, [])) ], - nowTy, - mkILCloFldSpecs cenv nowFields, + (None, + [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (cenv.mkILTyFuncTy, [])) ], + nowTy, + mkILCloFldSpecs cenv nowFields, ILMemberAccess.Assembly) |> cenv.addMethodGeneratedAttrs let cloTypeDef = - { Name = td.Name; - GenericParams= td.GenericParams; - Access=td.Access; - Implements = List.empty; - IsAbstract = false; - NestedTypes = emptyILTypeDefs; - IsSealed = true; - IsSerializable=td.IsSerializable; - IsComInterop=false; - IsSpecialName=false; - Layout=ILTypeDefLayout.Auto; - Encoding=ILDefaultPInvokeEncoding.Ansi; - InitSemantics=ILTypeInit.BeforeField; - Extends= Some cenv.mkILTyFuncTy; - Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]); - Fields= mkILFields (mkILCloFldDefs cenv nowFields); - CustomAttrs=emptyILCustomAttrs; - MethodImpls=emptyILMethodImpls; - Properties=emptyILProperties; - Events=emptyILEvents; - HasSecurity=false; - SecurityDecls=emptyILSecurityDecls; - tdKind = ILTypeDefKind.Class;} + { Name = td.Name + GenericParams= td.GenericParams + Access=td.Access + Implements = List.empty + IsAbstract = false + NestedTypes = emptyILTypeDefs + IsSealed = true + IsSerializable=td.IsSerializable + IsComInterop=false + IsSpecialName=false + Layout=ILTypeDefLayout.Auto + Encoding=ILDefaultPInvokeEncoding.Ansi + InitSemantics=ILTypeInit.BeforeField + Extends= Some cenv.mkILTyFuncTy + Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]) + Fields= mkILFields (mkILCloFldDefs cenv nowFields) + CustomAttrs=emptyILCustomAttrs + MethodImpls=emptyILMethodImpls + Properties=emptyILProperties + Events=emptyILEvents + HasSecurity=false + SecurityDecls=emptyILSecurityDecls + tdKind = ILTypeDefKind.Class} [ cloTypeDef] // CASE 2 - Term Application - | [], (_ :: _ as nowParams),_ -> + | [], (_ :: _ as nowParams), _ -> let nowReturnTy = mkTyOfLambdas cenv laterStruct // CASE 2a - Too Many Term Arguments or Remaining Type arguments - Split the Closure Class in Two if (match laterStruct with Lambdas_return _ -> false | _ -> true) then - let nowStruct = List.foldBack (fun l r -> Lambdas_lambda(l,r)) nowParams (Lambdas_return nowReturnTy) + let nowStruct = List.foldBack (fun l r -> Lambdas_lambda(l, r)) nowParams (Lambdas_return nowReturnTy) let laterTypeName = td.Name+"D" - let laterTypeRef = mkILNestedTyRef (ILScopeRef.Local,encl,laterTypeName) + let laterTypeRef = mkILNestedTyRef (ILScopeRef.Local, encl, laterTypeName) let laterGenericParams = td.GenericParams // Number each argument left-to-right, adding one to account for the "this" pointer - let selfFreeVar = mkILFreeVar(CompilerGeneratedName "self",true,nowCloSpec.ILType) + let selfFreeVar = mkILFreeVar(CompilerGeneratedName "self", true, nowCloSpec.ILType) let argToFreeVarMap = (0, selfFreeVar) :: (nowParams |> List.mapi (fun i p -> i+1, mkILFreeVarForParam p)) let laterFreeVars = argToFreeVarMap |> List.map snd |> List.toArray let laterFields = Array.append nowFields laterFreeVars - let laterCloRef = IlxClosureRef(laterTypeRef,laterStruct,laterFields) + let laterCloRef = IlxClosureRef(laterTypeRef, laterStruct, laterFields) let laterCloSpec = mkILFormalCloRef laterGenericParams laterCloRef // This is the code which will first get called. let nowCode = mkILMethodBody - (false,[],argToFreeVarMap.Length + nowFields.Length, + (false, [], argToFreeVarMap.Length + nowFields.Length, nonBranchingInstrsToCode begin // Load up the environment (nowFields |> Array.toList |> List.collect (mkLdFreeVar nowCloSpec)) @ // Load up all the arguments (including self), which become free variables in the delegated closure - (argToFreeVarMap |> List.map (fun (n,_) -> mkLdarg (uint16 n))) @ + (argToFreeVarMap |> List.map (fun (n, _) -> mkLdarg (uint16 n))) @ // Make the instance of the delegated closure && return it. [ I_newobj (laterCloSpec.Constructor, None) ] - end, + end, tagApp) let nowTypeDefs = - convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct; + convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct cloCode=notlazy nowCode} let laterCode = rewriteCodeToAccessArgsFromEnv laterCloSpec argToFreeVarMap let laterTypeDefs = convIlxClosureDef cenv encl - {td with GenericParams=laterGenericParams; - Access=laterAccess; + {td with GenericParams=laterGenericParams + Access=laterAccess Name=laterTypeName} - {clo with cloStructure=laterStruct; - cloFreeVars=laterFields; + {clo with cloStructure=laterStruct + cloFreeVars=laterFields cloCode=notlazy laterCode} // add 'compiler generated' to all the methods in the 'now' classes @@ -571,84 +568,84 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let cloTypeDef = let nowApplyMethDef = mkILNonGenericVirtualMethod - ("Invoke",ILMemberAccess.Public, + ("Invoke", ILMemberAccess.Public, nowParams, - mkILReturn nowReturnTy, - MethodBody.IL (convILMethodBody (Some nowCloSpec,None) (Lazy.force clo.cloCode))) + mkILReturn nowReturnTy, + MethodBody.IL (convILMethodBody (Some nowCloSpec, None) (Lazy.force clo.cloCode))) let ctorMethodDef = mkILStorageCtor - (None, - [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (nowEnvParentClass,[])) ], - nowTy, - mkILCloFldSpecs cenv nowFields, + (None, + [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (nowEnvParentClass, [])) ], + nowTy, + mkILCloFldSpecs cenv nowFields, ILMemberAccess.Assembly) |> cenv.addMethodGeneratedAttrs - { Name = td.Name; - GenericParams= td.GenericParams; - Access = td.Access; + { Name = td.Name + GenericParams= td.GenericParams + Access = td.Access Implements = [] - IsAbstract = false; - IsSealed = true; - IsSerializable=td.IsSerializable; - IsComInterop=false; - IsSpecialName=false; - Layout=ILTypeDefLayout.Auto; - Encoding=ILDefaultPInvokeEncoding.Ansi; - InitSemantics=ILTypeInit.BeforeField; - NestedTypes = emptyILTypeDefs; - Extends= Some nowEnvParentClass; - Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]); - Fields= mkILFields (mkILCloFldDefs cenv nowFields); - CustomAttrs=emptyILCustomAttrs; - MethodImpls=emptyILMethodImpls; - Properties=emptyILProperties; - Events=emptyILEvents; - HasSecurity=false; - SecurityDecls=emptyILSecurityDecls; - tdKind = ILTypeDefKind.Class; } + IsAbstract = false + IsSealed = true + IsSerializable=td.IsSerializable + IsComInterop=false + IsSpecialName=false + Layout=ILTypeDefLayout.Auto + Encoding=ILDefaultPInvokeEncoding.Ansi + InitSemantics=ILTypeInit.BeforeField + NestedTypes = emptyILTypeDefs + Extends= Some nowEnvParentClass + Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]) + Fields= mkILFields (mkILCloFldDefs cenv nowFields) + CustomAttrs=emptyILCustomAttrs + MethodImpls=emptyILMethodImpls + Properties=emptyILProperties + Events=emptyILEvents + HasSecurity=false + SecurityDecls=emptyILSecurityDecls + tdKind = ILTypeDefKind.Class } [cloTypeDef] - | [],[],Lambdas_return _ -> + | [], [], Lambdas_return _ -> // No code is being declared: just bake a (mutable) environment let cloCode' = match td.Extends with | None -> (mkILNonGenericEmptyCtor None cenv.ilg.typ_Object).MethodBody - | Some _ -> convILMethodBody (Some nowCloSpec,None) (Lazy.force clo.cloCode) + | Some _ -> convILMethodBody (Some nowCloSpec, None) (Lazy.force clo.cloCode) let ctorMethodDef = let flds = (mkILCloFldSpecs cenv nowFields) - mkILCtor(ILMemberAccess.Public, - List.map mkILParamNamed flds, + mkILCtor(ILMemberAccess.Public, + List.map mkILParamNamed flds, mkMethodBody - (cloCode'.IsZeroInit, - cloCode'.Locals, - cloCode'.MaxStack, + (cloCode'.IsZeroInit, + cloCode'.Locals, + cloCode'.MaxStack, prependInstrsToCode - (List.concat (List.mapi (fun n (nm,ty) -> - [ mkLdarg0; - mkLdarg (uint16 (n+1)); - mkNormalStfld (mkILFieldSpecInTy (nowTy,nm,ty)); + (List.concat (List.mapi (fun n (nm, ty) -> + [ mkLdarg0 + mkLdarg (uint16 (n+1)) + mkNormalStfld (mkILFieldSpecInTy (nowTy, nm, ty)) ]) flds)) - cloCode'.Code, + cloCode'.Code, None)) let cloTypeDef = { td with - Implements= td.Implements; - Extends= (match td.Extends with None -> Some cenv.ilg.typ_Object | Some x -> Some(x)); - Name = td.Name; - GenericParams= td.GenericParams; - Methods= mkILMethods (ctorMethodDef :: List.map (convMethodDef (Some nowCloSpec)) td.Methods.AsList); - Fields= mkILFields (mkILCloFldDefs cenv nowFields @ td.Fields.AsList); - tdKind = ILTypeDefKind.Class; } + Implements= td.Implements + Extends= (match td.Extends with None -> Some cenv.ilg.typ_Object | Some x -> Some(x)) + Name = td.Name + GenericParams= td.GenericParams + Methods= mkILMethods (ctorMethodDef :: List.map (convMethodDef (Some nowCloSpec)) td.Methods.AsList) + Fields= mkILFields (mkILCloFldDefs cenv nowFields @ td.Fields.AsList) + tdKind = ILTypeDefKind.Class } [cloTypeDef] - | a,b,_ -> + | a, b, _ -> failwith ("Unexpected unsupported abstraction sequence, #tyabs = "+string a.Length + ", #tmabs = "+string b.Length) newTypeDefs From bfa290a640f018d30b3f6216a40c1f420d5d7709 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 3 Oct 2017 22:04:02 +0100 Subject: [PATCH 4/4] whitespace and comments --- src/fsharp/LexFilter.fs | 2 -- src/fsharp/ast.fs | 3 --- src/fsharp/lexhelp.fs | 24 +++++++++++++----------- src/ilx/EraseClosures.fs | 1 - src/ilx/EraseUnions.fs | 6 ++---- 5 files changed, 15 insertions(+), 21 deletions(-) diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index f37d6535edf..5b9deaf832e 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -4,7 +4,6 @@ /// Implements the offside rule and a copule of other lexical transformations. module internal Microsoft.FSharp.Compiler.LexFilter -open Internal.Utilities open Internal.Utilities.Text.Lexing open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL @@ -13,7 +12,6 @@ open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger -open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Parser open Microsoft.FSharp.Compiler.Lexhelp diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index aa7b962a83c..1c1cbc5f1a7 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -7,7 +7,6 @@ module internal Microsoft.FSharp.Compiler.Ast #endif open System.Collections.Generic -open Internal.Utilities open Internal.Utilities.Text.Lexing open Internal.Utilities.Text.Parsing open Microsoft.FSharp.Compiler.AbstractIL @@ -18,8 +17,6 @@ open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.UnicodeLexing open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.PrettyNaming -open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics -open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Range /// The prefix of the names used for the fake namespace path added to all dynamic code entries in FSI.EXE diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index 97b10d618d8..6f0c26c2f7b 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -4,10 +4,12 @@ module internal Microsoft.FSharp.Compiler.Lexhelp open System open System.Text + open Internal.Utilities open Internal.Utilities.Collections open Internal.Utilities.Text open Internal.Utilities.Text.Lexing + open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal @@ -41,10 +43,10 @@ type LightSyntaxStatus(initial:bool,warn:bool) = /// Manage lexer resources (string interning) [] type LexResourceManager() = - let strings = new System.Collections.Generic.Dictionary(100) + let strings = new System.Collections.Generic.Dictionary(100) member x.InternIdentifierToken(s) = let mutable res = Unchecked.defaultof<_> - let ok = strings.TryGetValue(s,&res) + let ok = strings.TryGetValue(s, &res) if ok then res else let res = IDENT s (strings.[s] <- res; res) @@ -64,7 +66,7 @@ type LongUnicodeLexResult = | SingleChar of uint16 | Invalid -let mkLexargs (_filename,defines,lightSyntaxStatus,resourceManager,ifdefStack,errorLogger) = +let mkLexargs (_filename, defines, lightSyntaxStatus, resourceManager, ifdefStack, errorLogger) = { defines = defines ifdefStack= ifdefStack lightSyntaxStatus=lightSyntaxStatus @@ -79,13 +81,13 @@ let reusingLexbufForParsing lexbuf f = try f () with e -> - raise (WrappedError(e,(try lexbuf.LexemeRange with _ -> range0))) + raise (WrappedError(e, (try lexbuf.LexemeRange with _ -> range0))) let resetLexbufPos filename (lexbuf: UnicodeLexing.Lexbuf) = lexbuf.EndPos <- Position.FirstLine (fileIndexOfFile filename) /// Reset the lexbuf, configure the initial position with the given filename and call the given function -let usingLexbufForParsing (lexbuf:UnicodeLexing.Lexbuf,filename) f = +let usingLexbufForParsing (lexbuf:UnicodeLexing.Lexbuf, filename) f = resetLexbufPos filename lexbuf reusingLexbufForParsing lexbuf (fun () -> f lexbuf) @@ -93,7 +95,7 @@ let usingLexbufForParsing (lexbuf:UnicodeLexing.Lexbuf,filename) f = // Functions to manipulate lexer transient state //----------------------------------------------------------------------- -let defaultStringFinisher = (fun _endm _b s -> STRING (Encoding.Unicode.GetString(s,0,s.Length))) +let defaultStringFinisher = (fun _endm _b s -> STRING (Encoding.Unicode.GetString(s, 0, s.Length))) let callStringFinisher fin (buf: ByteBuffer) endm b = fin endm b (buf.Close()) @@ -291,7 +293,7 @@ module Keywords = "sealed"; "trait"; "tailcall"; "virtual"; ] let private unreserveWords = - keywordList |> List.choose (function (mode,keyword,_) -> if mode = FSHARP then Some keyword else None) + keywordList |> List.choose (function (mode, keyword, _) -> if mode = FSHARP then Some keyword else None) //------------------------------------------------------------------------ // Keywords @@ -301,9 +303,9 @@ module Keywords = keywordList |> List.map (fun (_, w, _) -> w) let keywordTable = - let tab = System.Collections.Generic.Dictionary(100) - for _,keyword,token in keywordList do - tab.Add(keyword,token) + let tab = System.Collections.Generic.Dictionary(100) + for _, keyword, token in keywordList do + tab.Add(keyword, token) tab let KeywordToken s = keywordTable.[s] @@ -315,7 +317,7 @@ module Keywords = let KeywordOrIdentifierToken args (lexbuf:UnicodeLexing.Lexbuf) s = match keywordTable.TryGetValue s with - | true,v -> + | true, v -> match v with | RESERVED -> warning(ReservedKeyword(FSComp.SR.lexhlpIdentifierReserved(s), lexbuf.LexemeRange)) diff --git a/src/ilx/EraseClosures.fs b/src/ilx/EraseClosures.fs index 8a789a74408..80329249c38 100644 --- a/src/ilx/EraseClosures.fs +++ b/src/ilx/EraseClosures.fs @@ -11,7 +11,6 @@ open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.IlxSettings open Microsoft.FSharp.Compiler.AbstractIL.Morphs -open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.PrettyNaming diff --git a/src/ilx/EraseUnions.fs b/src/ilx/EraseUnions.fs index 07fb17b033a..c75ab90f05f 100644 --- a/src/ilx/EraseUnions.fs +++ b/src/ilx/EraseUnions.fs @@ -8,14 +8,12 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseUnions open System.Collections.Generic -open Internal.Utilities + open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL -open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types -open Microsoft.FSharp.Compiler.AbstractIL.Morphs [] @@ -584,7 +582,7 @@ let emitDataSwitch ilg (cg: ICodeGen<'Mark>) (avoidHelpers, cuspec, cases) = | [] -> cg.EmitInstrs [ AI_pop ] | _ -> // Use a dictionary to avoid quadratic lookup in case list - let dict = System.Collections.Generic.Dictionary() + let dict = Dictionary() for (i,case) in cases do dict.[i] <- case let failLab = cg.GenerateDelayMark () let emitCase i _ =